The following example has been posted in this forum.
procedure TForm1.Button1Click(Sender: TObject);
var
LFont: TFont;
LBmp: TBitmap;
w,h: integer;
begin
LFont := TFont.Create;
try
LBmp := TBitmap.Create;
try
LBmp.Width := Image1.Width;
LBmp.Height := Image1.Height;
LBmp.Canvas.Brush.Color := clWhite;
LBmp.Canvas.Brush.Style := bsSolid;
LBmp.Canvas.Rectangle(0, 0, LBmp.Width, LBmp.Height);
LFont.Name := 'Arial';
LFont.Size := 20;
LFont.Color := clRed;
LBmp.Canvas.Font := LFont;
w:=0;
h:=0;
h := LBmp.Canvas.TextHeight('Test');
w := LBmp.Canvas.TextWidth('Test');
LBmp.Canvas.TextOut(10, h, 'Test');
Image1.Picture.Bitmap.Assign(LBmp);
finally
LBmp.Free;
end;
finally
LFont.Free;
end;
end;
Using LCLWidgetType "customdrawn", the color used for writing the text "Test" is black, although we have the line "LFont.Color := clRed;".
The following patch fixes the problem. As you can see, original code uses a constant, colBlack.
diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi.inc b/lcl/interfaces/customdrawn/customdrawnwinapi.inc
index 4d3789ff39..3843bd1cef 100644
--- a/lcl/interfaces/customdrawn/customdrawnwinapi.inc
+++ b/lcl/interfaces/customdrawn/customdrawnwinapi.inc
@@ -2111,7 +2111,7 @@ begin
lFontSize := Round(ftFont.TextHeight(Str) * 0.75);// ToDo: Find out why this 75% factor works
RealX := X + lDestCanvas.WindowOrg.X + lDestCanvas.BaseWindowOrg.X;
RealY := Y + lDestCanvas.WindowOrg.Y + lDestCanvas.BaseWindowOrg.Y + lFontSize;
- FTDrawer.DrawText(Str, ftFont, RealX, RealY, colBlack, 255);
+ FTDrawer.DrawText(Str, ftFont, RealX, RealY, lDestCanvas.Font.FPColor, 255);
finally
if FreeFTFont then ftFont.Free;
FTDrawer.Free;
Recent
