Forum > CustomDrawn

[SOLVED] Bug at TCDWidgetSet.SetTextColor

(1/2) > >>

lagprogramming:
The file lcl/interfaces/customdrawn/customdrawnwinapi.inc contains the following function:

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---function TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;   The content of the function is:function TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;var  lFont: TFPCustomFont;  LazDC: TLazCanvas;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 LazDC.Font <> nil then    LazDC.Font.FPColor := TColorToFPColor(Color);end;
This function always returns CLR_INVALID. I think the following code is better.

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---function TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;var  lFont: TFPCustomFont;  LazDC: TLazCanvas;begin  {$ifdef VerboseCDDrawing}    DebugLn(Format('[TCDWidgetSet.SetTextColor]  DC: %x Color: %8x', [DC, Color]));  {$endif}   if IsValidDC(DC) then  begin    LazDC := TLazCanvas(DC);     if LazDC.Font <> nil then    begin      LazDC.Font.FPColor := TColorToFPColor(Color);      Exit(Color);    end;  end;  Result := CLR_INVALID;end;
Somebody with lcl development experience might be interested in this.

zeljko:
Result is not good. It should be previous text color setted up via SetTextColor, not current one...

lagprogramming:

--- Quote from: zeljko on March 06, 2023, 11:13:48 am ---Result is not good. It should be previous text color setted up via SetTextColor, not current one...

--- End quote ---

Indeed! I've updated the code.


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---//Existing codefunction TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;var  lFont: TFPCustomFont;  LazDC: TLazCanvas;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 LazDC.Font <> nil then    LazDC.Font.FPColor := TColorToFPColor(Color);end; 
 ::)


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---//Modified codefunction TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;var  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;   if LazDC.Font <> nil then  begin    Result := FPColorToTColorRef(LazDC.Font.FPColor);    LazDC.Font.FPColor := TColorToFPColor(Color);  end;end; 
Edit: I forgot the "not" at "if not IsValidDC(DC) then exit;"

lagprogramming:
The modified code returns the previous color if succesful, CLR_INVALID otherwise. This makes the function consistent with the results of similar functions in other interfaces. Also, has been noticed that variable "lFont: TFPCustomFont;" is not used not only in SetTextColor but also in GetTextColor.


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi.inc b/lcl/interfaces/customdrawn/customdrawnwinapi.incindex 0a12ac2d82..22fa18341f 100644--- a/lcl/interfaces/customdrawn/customdrawnwinapi.inc+++ b/lcl/interfaces/customdrawn/customdrawnwinapi.inc@@ -3901,7 +3901,6 @@ end;  *)  ------------------------------------------------------------------------------} function TCDWidgetSet.GetTextColor(DC: HDC) : TColorRef; var-  lFont: TFPCustomFont;   LazDC: TLazCanvas; begin   {$ifdef VerboseCDDrawing}@@ -5818,24 +5817,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;  (*{------------------------------------------------------------------------------

Bart:
Please, please, pretty please: I'm begging you: please submit your patches to the bugtracker.

Bart

Navigation

[0] Message Index

[#] Next page

Go to full version