paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 12:49:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

textextent test: Adds a arabic test

Browse Source 
git-svn-id: trunk@33565 -
This commit is contained in:
sekelsenmat 2011-11-16 13:06:06 +00:00
parent 1e32edd4db
commit ba4bd03d8d
1 changed files with 16 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
test/lclmanual/textextent/mainform.pas
View File

@ -75,6 +75,22 @@ begin
Image.Canvas.Brush.Style := bsClear; Image.Canvas.Brush.Style := bsClear;
Image.Canvas.TextOut(20, 75 + i *15, lStr); Image.Canvas.TextOut(20, 75 + i *15, lStr);
end; end;
// Now add something hard: Arabic
lStr := 'العرب';
LCLIntf.GetTextExtentExPoint(Image.Canvas.Handle, PChar(lStr),
Length(lStr), 50, @lMaxCount, @lPartialWidths[0], lSize);
lRes := Image.Canvas.TextFitInfo(lStr, 50);
Image.Canvas.Brush.Style := bsClear;
Image.Canvas.TextOut(20, 200, Format('GetTextExtentExPoint Arabic. Returned MaxCount=%d should be aprox. 5', [lMaxCount]));
Image.Canvas.Brush.Color := clBlue;
for i := 0 to 4 do
begin
Image.Canvas.Brush.Style := bsSolid;
Image.Canvas.Rectangle(20+lSize.cx-lPartialWidths[i], 225 + i * 15, 20+lSize.cx, 240 + i * 15);
Image.Canvas.Brush.Style := bsClear;
Image.Canvas.TextOut(20, 225 + i *15, lStr);
end;
end; end;
end. end.