paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 04:07:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL-CustomDrawn: Fix TCDWidgetSet.SetTextColor. Issue #40204.

Browse Source
This commit is contained in:
Juha 2023-04-15 11:24:46 +03:00
parent 63b6e913aa
commit 2ae1edf24e
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lcl/interfaces/customdrawn/customdrawnwinapi.inc
View File

@ -3901,7 +3901,6 @@ end; *)
------------------------------------------------------------------------------}
function TCDWidgetSet.GetTextColor(DC: HDC) : TColorRef;
var
lFont: TFPCustomFont;
LazDC: TLazCanvas;
begin
{$ifdef VerboseCDDrawing}
@ -5821,24 +5820,26 @@ end;*)
{------------------------------------------------------------------------------
Method: SetTextColor
Params: Handle -
Returns:
Params: DC - Identifies the device context.
Color - Specifies the color of the text.
Returns: The previous color if succesful, CLR_INVALID otherwise
------------------------------------------------------------------------------}
function TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
var
lFont: TFPCustomFont;
LazDC: TLazCanvas;
LazDC: TLazCanvas absolute DC;
begin
{$ifdef VerboseCDDrawing}
DebugLn(Format('[TCDWidgetSet.SetTextColor] DC: %x Color: %8x', [DC, Color]));
{$endif}
Result := CLR_INVALID;
if not IsValidDC(DC) then Exit;
LazDC := TLazCanvas(DC);
if not IsValidDC(DC) then exit;
if LazDC.Font <> nil then
begin
Result := FPColorToTColorRef(LazDC.Font.FPColor);
LazDC.Font.FPColor := TColorToFPColor(Color);
end;
end;
(*{------------------------------------------------------------------------------