Oke. Ik ben al iets verder. Ik heb iets aangepast en werkt bijna zoals het moet.
Dit is de aangepaste code:
Delphi Code:
procedure TForm3.Button1Click(Sender: TObject);
var TmpImg : TImage;
Rect : TRect;
Textstyle : TTextFormat;
MySize : TSize;
TekstHoogte : integer;
begin
MyTekst := memo1.lines.Text;
TmpImg := TImage.Create(Self);
TmpImg.Parent := ScrollBox1;
TmpImg.Align := alTop;
Rect := TmpImg.ClientRect;
TekstHoogte := createballoon(MyTekst,Rect);
TmpImg.Height := TekstHoogte + 10;
Rect.Left := Rect.Left + 7;
Rect.Top := Rect.Top + 7;
Rect.Width := Rect.Width - 10;
TmpImg.Canvas.Brush.Color := clYellow;
TmpImg.Canvas.Rectangle(5,5,scrollbox1.ClientWidth - 5, Teksthoogte + 5);
Rect.Height := TekstHoogte;
TextStyle := [tfWordBreak];
TmpImg.Canvas.TextRect(Rect,MyTekst,TextStyle);
memo1.lines.clear;
end;
function TForm3.createballoon(var aTekst : string; var aRect : TRect) : integer;
var Img : TImage;
pxLengte, pxHoogte : integer;
aantallijnen : integer;
begin
Img := TImage.Create(nil);
try
Img.Top := 0;
Img.Left := 0;
Img.Width := aRect.Width;
Img.Height := 1000;
Img.Canvas.TextRect(aRect,aTekst,[tfWordBreak]);
pxLengte := Img.Canvas.TextWidth(aTekst);
pxHoogte := Img.Canvas.TextHeight(aTekst);
aantallijnen := pxlengte div aRect.Width + 1;
result := aantallijnen * pxHoogte + 20
finally
Img.free;
end;
end;
Maar het lijkt erop dat hier geen rekening wordt gehouden met de lengte van de regel als er eerder een return wordt gegeven.
Bookmarks