Draw autosize text in rect in BGRABitmap

[aradeonas]

Hi,

I tried to do this and didnt find anything in BGRABitmap but with help of GetMem here is a demo.

Code: Pascal  [Select][+][-]

1. procedure SetBestFontSizeForBGRABitmap(bmp:TBGRABitmap;s:string;Rect:TRect;horizMargin,vertMargin:Integer);
2. var
3.   w, h,rw,rh: Integer;
4. begin
5.   w:=bmp.TextSize(s).cx;
6.  h:=bmp.TextSize(s).cy;
7.  rw:=Rect.Right-Rect.Left- (2*horizMargin);
8.   rh:=Rect.Bottom-Rect.Top- (2*vertMargin);
9.   while (w < rw) and (h < rh) do
10.   begin
11.     bmp.FontFullHeight := bmp.FontFullHeight + 1;
12.     w:=bmp.TextSize(s).cx;
13.    h:=bmp.TextSize(s).cy;
14.   end;
15. end;
16. procedure TForm1.FormPaint(Sender: TObject);
17. var
18.   Txt: string;
19.   bmp:TBGRABitmap;
20.   x,y:Integer ;
21.   const horizMargin = 10; vertMargin = 20;
22. begin
23.   Txt := 'This is a test';
24.   bmp:=TBGRABitmap.Create(Width,Height,BGRAWhite);
25.   SetBestFontSizeForBGRABitmap(bmp,Txt,bmp.ClipRect,horizMargin,vertMargin);
26.   x:=(Width-bmp.TextSize(Txt).cx) div 2 ;
27.   y:=(Height-bmp.TextSize(Txt).cy) div 2;
28.   bmp.TextOut(x,y,Txt,BGRABlack);
29.   bmp.Draw(Canvas,0,0);
30.   bmp.Free;
31. end;  
32.  

@Circular if there isn't one,can you add this or better one to BGRABitmap?

[CCRDude]

I've recently done the same with BGRABitmap, and before with VCL/LCL.

While this works, increasing the font by just 1 is hitting your performance massively. I would recommend to use bigger steps, then trying to get closer by reducing step size.

Didn't do that improvement myself yet though, instead I implemented a cache for optimal sizes, since my texts are mostly static.

[aradeonas]

Thanks for the point.
It is just a test version,as you said needs improvement.