Recent

Author Topic: [SOLVED] Bug at TCDWidgetSet.SetTextColor  (Read 3039 times)

lagprogramming

  • Sr. Member
  • ****
  • Posts: 407
[SOLVED] Bug at TCDWidgetSet.SetTextColor
« on: March 06, 2023, 11:08:41 am »
The file lcl/interfaces/customdrawn/customdrawnwinapi.inc contains the following function:
Code: Pascal  [Select][+][-]
  1. function TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;  
  2.  
  3. The content of the function is:
  4. function TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
  5. var
  6.   lFont: TFPCustomFont;
  7.   LazDC: TLazCanvas;
  8. begin
  9.   {$ifdef VerboseCDDrawing}
  10.     DebugLn(Format('[TCDWidgetSet.SetTextColor]  DC: %x Color: %8x', [DC, Color]));
  11.   {$endif}
  12.  
  13.   Result := CLR_INVALID;
  14.   if not IsValidDC(DC) then Exit;
  15.   LazDC := TLazCanvas(DC);
  16.  
  17.   if LazDC.Font <> nil then
  18.     LazDC.Font.FPColor := TColorToFPColor(Color);
  19. end;

This function always returns CLR_INVALID. I think the following code is better.
Code: Pascal  [Select][+][-]
  1. function TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
  2. var
  3.   lFont: TFPCustomFont;
  4.   LazDC: TLazCanvas;
  5. begin
  6.   {$ifdef VerboseCDDrawing}
  7.     DebugLn(Format('[TCDWidgetSet.SetTextColor]  DC: %x Color: %8x', [DC, Color]));
  8.   {$endif}
  9.  
  10.   if IsValidDC(DC) then
  11.   begin
  12.     LazDC := TLazCanvas(DC);
  13.  
  14.     if LazDC.Font <> nil then
  15.     begin
  16.       LazDC.Font.FPColor := TColorToFPColor(Color);
  17.       Exit(Color);
  18.     end;
  19.   end;
  20.   Result := CLR_INVALID;
  21. end;

Somebody with lcl development experience might be interested in this.
« Last Edit: April 15, 2023, 10:46:33 am by lagprogramming »

zeljko

  • Hero Member
  • *****
  • Posts: 1670
    • http://wiki.lazarus.freepascal.org/User:Zeljan
Re: Probably a bug at TCDWidgetSet.SetTextColor
« Reply #1 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...

lagprogramming

  • Sr. Member
  • ****
  • Posts: 407
Re: Probably a bug at TCDWidgetSet.SetTextColor
« Reply #2 on: March 06, 2023, 06:38:06 pm »
Result is not good. It should be previous text color setted up via SetTextColor, not current one...

Indeed! I've updated the code.

Code: Pascal  [Select][+][-]
  1. //Existing code
  2. function TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
  3. var
  4.   lFont: TFPCustomFont;
  5.   LazDC: TLazCanvas;
  6. begin
  7.   {$ifdef VerboseCDDrawing}
  8.     DebugLn(Format('[TCDWidgetSet.SetTextColor]  DC: %x Color: %8x', [DC, Color]));
  9.   {$endif}
  10.  
  11.   Result := CLR_INVALID;
  12.   if not IsValidDC(DC) then Exit;
  13.   LazDC := TLazCanvas(DC);
  14.  
  15.   if LazDC.Font <> nil then
  16.     LazDC.Font.FPColor := TColorToFPColor(Color);
  17. end;
  18.  

 ::)

Code: Pascal  [Select][+][-]
  1. //Modified code
  2. function TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
  3. var
  4.   LazDC: TLazCanvas absolute DC;
  5. begin
  6.   {$ifdef VerboseCDDrawing}
  7.     DebugLn(Format('[TCDWidgetSet.SetTextColor]  DC: %x Color: %8x', [DC, Color]));
  8.   {$endif}
  9.  
  10.   Result := CLR_INVALID;
  11.   if not IsValidDC(DC) then exit;
  12.  
  13.   if LazDC.Font <> nil then
  14.   begin
  15.     Result := FPColorToTColorRef(LazDC.Font.FPColor);
  16.     LazDC.Font.FPColor := TColorToFPColor(Color);
  17.   end;
  18. end;
  19.  

Edit: I forgot the "not" at "if not IsValidDC(DC) then exit;"
« Last Edit: March 06, 2023, 06:51:35 pm by lagprogramming »

lagprogramming

  • Sr. Member
  • ****
  • Posts: 407
Re: Probably a bug at TCDWidgetSet.SetTextColor
« Reply #3 on: April 04, 2023, 01:10:16 pm »
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  [Select][+][-]
  1. diff --git a/lcl/interfaces/customdrawn/customdrawnwinapi.inc b/lcl/interfaces/customdrawn/customdrawnwinapi.inc
  2. index 0a12ac2d82..22fa18341f 100644
  3. --- a/lcl/interfaces/customdrawn/customdrawnwinapi.inc
  4. +++ b/lcl/interfaces/customdrawn/customdrawnwinapi.inc
  5. @@ -3901,7 +3901,6 @@ end;  *)
  6.   ------------------------------------------------------------------------------}
  7.  function TCDWidgetSet.GetTextColor(DC: HDC) : TColorRef;
  8.  var
  9. -  lFont: TFPCustomFont;
  10.    LazDC: TLazCanvas;
  11.  begin
  12.    {$ifdef VerboseCDDrawing}
  13. @@ -5818,24 +5817,26 @@ end;*)
  14.  
  15.  {------------------------------------------------------------------------------
  16.    Method:  SetTextColor
  17. -  Params:  Handle -
  18. -  Returns:
  19. +  Params:  DC    - Identifies the device context.
  20. +           Color - Specifies the color of the text.
  21. +  Returns: The previous color if succesful, CLR_INVALID otherwise
  22.   ------------------------------------------------------------------------------}
  23.  function TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
  24.  var
  25. -  lFont: TFPCustomFont;
  26. -  LazDC: TLazCanvas;
  27. +  LazDC: TLazCanvas absolute DC;
  28.  begin
  29.    {$ifdef VerboseCDDrawing}
  30.      DebugLn(Format('[TCDWidgetSet.SetTextColor]  DC: %x Color: %8x', [DC, Color]));
  31.    {$endif}
  32.  
  33.    Result := CLR_INVALID;
  34. -  if not IsValidDC(DC) then Exit;
  35. -  LazDC := TLazCanvas(DC);
  36. +  if not IsValidDC(DC) then exit;
  37.  
  38.    if LazDC.Font <> nil then
  39. +  begin
  40. +    Result := FPColorToTColorRef(LazDC.Font.FPColor);
  41.      LazDC.Font.FPColor := TColorToFPColor(Color);
  42. +  end;
  43.  end;
  44.  
  45.  (*{------------------------------------------------------------------------------

Bart

  • Hero Member
  • *****
  • Posts: 5469
    • Bart en Mariska's Webstek
Re: Bug at TCDWidgetSet.SetTextColor
« Reply #4 on: April 04, 2023, 04:08:08 pm »
Please, please, pretty please: I'm begging you: please submit your patches to the bugtracker.

Bart

lagprogramming

  • Sr. Member
  • ****
  • Posts: 407
Re: Bug at TCDWidgetSet.SetTextColor
« Reply #5 on: April 06, 2023, 02:03:19 pm »
Please, please, pretty please: I'm begging you: please submit your patches to the bugtracker.

Bart

I know you want what's best for the community but without realizing, instead of motivating me to work better you demotivate me from presenting bugs and patches.  :-\
For now, I don't want to be involved in using the bugtracker. It's complicated to explain.

Bart

  • Hero Member
  • *****
  • Posts: 5469
    • Bart en Mariska's Webstek
Re: Bug at TCDWidgetSet.SetTextColor
« Reply #6 on: April 06, 2023, 06:30:09 pm »
... but without realizing, instead of motivating me to work better you demotivate me from presenting bugs and patches.  :-\
Whic is certainly not my intention.

For now, I don't want to be involved in using the bugtracker. It's complicated to explain.
Sorry to hear that.
Feel free to explain in a PM.
We might work out a solution or a workaround (e.g. using an intermediate person as a relay to the bugtracker).

Bart

AlexTP

  • Hero Member
  • *****
  • Posts: 2489
    • UVviewsoft
Re: Bug at TCDWidgetSet.SetTextColor
« Reply #7 on: April 11, 2023, 01:46:59 pm »

 

TinyPortal © 2005-2018