Recent

Author Topic: [SOLVED] Posible Bug  (Read 5938 times)

critter

  • New Member
  • *
  • Posts: 20
[SOLVED] Posible Bug
« on: July 04, 2018, 11:01:01 am »
I have created the following component, and I find that at run time I do not change the color assigned at design time if I do not indicate it by code.

Code: Pascal  [Select][+][-]
  1. unit TestPanel;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, ExtCtrls, Graphics;
  9.  
  10. type
  11.  
  12.   { TTestColor }
  13.  
  14.   TTestColor = class(TPersistent)
  15.   private
  16.     FColor: TColor;
  17.     procedure SetColor(AValue: TColor);
  18.   published
  19.     property Color: TColor read FColor write SetColor;
  20.   end;
  21.  
  22.   { TTestPanel }
  23.  
  24.   TTestPanel = class(TCustomPanel)
  25.   private
  26.     FPanelColor: TTestColor;
  27.   protected
  28.     procedure Paint; override;
  29.   public
  30.      constructor Create(AOwner: TComponent); override;
  31.      destructor Destroy; override;
  32.   published
  33.      property PanelColor:  TTestColor read FPanelColor;
  34.      property Caption;
  35.   end;
  36.  
  37. procedure Register;
  38.  
  39. implementation
  40.  
  41. procedure Register;
  42. begin
  43.   RegisterComponents('Misc',[TTestPanel]);
  44. end;
  45.  
  46. { TTestPanel }
  47.  
  48. procedure TTestPanel.Paint;
  49. begin
  50.   inherited Paint;
  51.   with Canvas do
  52.   begin
  53.     Font.Color := FPanelColor.Color;
  54.     TextOut(10,10, Caption);
  55.   end;
  56. end;
  57.  
  58. constructor TTestPanel.Create(AOwner: TComponent);
  59. begin
  60.   inherited Create(AOwner);
  61.   FPanelColor := TTestColor.Create;
  62. end;
  63.  
  64. destructor TTestPanel.Destroy;
  65. begin
  66.   FPanelColor.Free;
  67.   inherited Destroy;
  68. end;
  69.  
  70. { TTestColor }
  71.  
  72. procedure TTestColor.SetColor(AValue: TColor);
  73. begin
  74.   if FColor=AValue then Exit;
  75.   FColor:=AValue;
  76.  
  77. end;
  78.  
  79. end.

Am I doing something wrong or is it a bug?
« Last Edit: July 04, 2018, 02:21:43 pm by critter »

Thaddy

  • Hero Member
  • *****
  • Posts: 14205
  • Probably until I exterminate Putin.
Re: Posible Bug
« Reply #1 on: July 04, 2018, 11:15:07 am »
First set {$M+} for RTTI information. On top of the unit.
Second maybe also declare the Color property as stored.
This should  force streaming of the property value.
Specialize a type, not a var.

marcov

  • Administrator
  • Hero Member
  • *
  • Posts: 11383
  • FPC developer.
Re: Posible Bug
« Reply #2 on: July 04, 2018, 11:54:12 am »
First set {$M+} for RTTI information. On top of the unit.

It should inherit that status from TPersistent which is declared $M+

Thaddy

  • Hero Member
  • *****
  • Posts: 14205
  • Probably until I exterminate Putin.
Re: Posible Bug
« Reply #3 on: July 04, 2018, 12:10:44 pm »
I know but I have seen this before. I could work around it like above. No clue why. It may indeed be a bug.
Specialize a type, not a var.

critter

  • New Member
  • *
  • Posts: 20
Re: Posible Bug
« Reply #4 on: July 04, 2018, 12:16:52 pm »
I do not know if I am doing something wrong, but I have included the clause {$ M +} and it does not do what it is supposed to do.

rvk

  • Hero Member
  • *****
  • Posts: 6111
Re: Posible Bug
« Reply #5 on: July 04, 2018, 12:25:25 pm »
I have created the following component, and I find that at run time I do not change the color assigned at design time if I do not indicate it by code.
This sentence doesn't quite flow correctly. I don't understand what your actual problem is. Is it when changing the color at design-time, that it doesn't change. Or doesn't it change during run-time?

Anyway... You change the FColor in SetColor(). But it might be that the panel isn't repainted immediately. Maybe you should put a invalidate in there to make sure the panel is repainted.

Code: Pascal  [Select][+][-]
  1. procedure TTestColor.SetColor(AValue: TColor);
  2. begin
  3.   if FColor=AValue then Exit;
  4.   FColor:=AValue;
  5.   Invalidate;
  6. end;

critter

  • New Member
  • *
  • Posts: 20
Re: Posible Bug
« Reply #6 on: July 04, 2018, 12:33:06 pm »
The problem is that I assign a color from the property editor at design time and when I execute it, it does not show me the selected color, but the default color.

rvk

  • Hero Member
  • *****
  • Posts: 6111
Re: Posible Bug
« Reply #7 on: July 04, 2018, 12:59:06 pm »
The problem is that I assign a color from the property editor at design time and when I execute it, it does not show me the selected color, but the default color.
I take it you mean the font color.

When I do this in design time the font color doesn't change directly. But if I move the panel the color did change. Try it...

So you need to repaint the panel on changing the color. Because you used a sub-property you can't use Invalidate directly but you need to reach TTestPanel from TTestColor. (not sure how other than giving an owner to TTestColor and using Owner.Invalidate)

Any reason you used a complete sub-property while you could have used a single FontColor property (in which you could call Invalidate). Are you planning to add more properties to TTestColor?
« Last Edit: July 04, 2018, 01:03:22 pm by rvk »

Blaazen

  • Hero Member
  • *****
  • Posts: 3237
  • POKE 54296,15
    • Eye-Candy Controls
Re: Posible Bug
« Reply #8 on: July 04, 2018, 01:13:00 pm »
Reason is that you declared it as a read-only property. It is not streamed to *.lfm. Add write part:
Code: Pascal  [Select][+][-]
  1.   property PanelColor: TTestColor read FPanelColor write FPanelColor;
  2. //or
  3.   property PanelColor: TTestColor read FPanelColor write SetPanelColor;
  4.  
Lazarus 2.3.0 (rev main-2_3-2863...) FPC 3.3.1 x86_64-linux-qt Chakra, Qt 4.8.7/5.13.2, Plasma 5.17.3
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

critter

  • New Member
  • *
  • Posts: 20
Re: Posible Bug
« Reply #9 on: July 04, 2018, 01:19:29 pm »
Reason is that you declared it as a read-only property. It is not streamed to *.lfm. Add write part:
Code: Pascal  [Select][+][-]
  1.   property PanelColor: TTestColor read FPanelColor write FPanelColor;
  2. //or
  3.   property PanelColor: TTestColor read FPanelColor write SetPanelColor;
  4.  

I tried it and it still does not save the color

critter

  • New Member
  • *
  • Posts: 20
Re: Posible Bug
« Reply #10 on: July 04, 2018, 01:21:31 pm »
The problem is that I assign a color from the property editor at design time and when I execute it, it does not show me the selected color, but the default color.
I take it you mean the font color.

When I do this in design time the font color doesn't change directly. But if I move the panel the color did change. Try it...

So you need to repaint the panel on changing the color. Because you used a sub-property you can't use Invalidate directly but you need to reach TTestPanel from TTestColor. (not sure how other than giving an owner to TTestColor and using Owner.Invalidate)

Any reason you used a complete sub-property while you could have used a single FontColor property (in which you could call Invalidate). Are you planning to add more properties to TTestColor?

The code is just a test. The purpose is a panel in which different objects are drawn, all inherited from TPersistent.

rvk

  • Hero Member
  • *****
  • Posts: 6111
Re: Posible Bug
« Reply #11 on: July 04, 2018, 01:31:47 pm »
This works for me.
It uses a single-property FontColor for changing the color of the caption-font.

If you want to add more properties for the caption-font (like size and face) you want to revert back to a sub-property but then you still need to invalidate when one of the properties change. Maybe using SetTestColor() works. Otherwise TTestColor needs to have a parent so you can reach the panel from the TTestColor-class.

Code: Pascal  [Select][+][-]
  1. unit TestPanel;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, ExtCtrls, Graphics;
  9.  
  10. type
  11.  
  12.   { TTestPanel }
  13.  
  14.   TTestPanel = class(TCustomPanel)
  15.   private
  16.     FFontColor: TColor;
  17.     procedure SetFontColor(AValue: TColor);
  18.   protected
  19.     procedure Paint; override;
  20.   public
  21.     constructor Create(AOwner: TComponent); override;
  22.     destructor Destroy; override;
  23.   published
  24.     property FontColor: TColor read FFontColor write SetFontColor;
  25.     property Caption;
  26.   end;
  27.  
  28. procedure Register;
  29.  
  30. implementation
  31.  
  32. procedure Register;
  33. begin
  34.   RegisterComponents('Misc', [TTestPanel]);
  35. end;
  36.  
  37. { TTestPanel }
  38.  
  39. procedure TTestPanel.Paint;
  40. begin
  41.   inherited Paint;
  42.   with Canvas do
  43.   begin
  44.     Font.Color := FFontColor;
  45.     TextOut(10, 10, Caption);
  46.   end;
  47. end;
  48.  
  49. constructor TTestPanel.Create(AOwner: TComponent);
  50. begin
  51.   inherited Create(AOwner);
  52.   FFontColor := clDefault;
  53. end;
  54.  
  55. destructor TTestPanel.Destroy;
  56. begin
  57.   inherited Destroy;
  58. end;
  59.  
  60. procedure TTestPanel.SetFontColor(AValue: TColor);
  61. begin
  62.   if FFontColor <> AValue then
  63.   begin
  64.     FFontColor := AValue;
  65.     Invalidate;
  66.   end;
  67. end;
  68.  
  69. end.

Blaazen

  • Hero Member
  • *****
  • Posts: 3237
  • POKE 54296,15
    • Eye-Candy Controls
Re: Posible Bug
« Reply #12 on: July 04, 2018, 01:33:53 pm »
Quote
I tried it and it still does not save the color

How did you test? Did you rebuild the IDE?
Lazarus 2.3.0 (rev main-2_3-2863...) FPC 3.3.1 x86_64-linux-qt Chakra, Qt 4.8.7/5.13.2, Plasma 5.17.3
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

critter

  • New Member
  • *
  • Posts: 20
Re: Posible Bug
« Reply #13 on: July 04, 2018, 01:39:44 pm »
Currently the component is like this:

Code: Pascal  [Select][+][-]
  1. unit TestPanel;
  2.  
  3.  {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, ExtCtrls, Graphics;
  9.  
  10. type
  11.  
  12.   TTestPanel = class;
  13.  
  14.   { TTestColor }
  15.  
  16.   TTestColor = class(TPersistent)
  17.   private
  18.     FColor: TColor;
  19.     FOwner: TTestPanel;
  20.     procedure SetColor(AValue: TColor);
  21.   published
  22.     constructor Create(AOwner: TComponent);
  23.     property Color: TColor read FColor write SetColor;
  24.   end;
  25.  
  26.   { TTestPanel }
  27.  
  28.   TTestPanel = class(TCustomPanel)
  29.   private
  30.     FPanelColor: TTestColor;
  31.   protected
  32.     procedure Paint; override;
  33.   public
  34.      constructor Create(AOwner: TComponent); override;
  35.      destructor Destroy; override;
  36.   published
  37.      property PanelColor:  TTestColor read FPanelColor write FPanelColor;
  38.      property Caption;
  39.      property Font;
  40.   end;
  41.  
  42. procedure Register;
  43.  
  44. implementation
  45.  
  46. procedure Register;
  47. begin
  48.   RegisterComponents('Samples',[TTestPanel]);
  49. end;
  50.  
  51. { TTestPanel }
  52.  
  53. procedure TTestPanel.Paint;
  54. begin
  55.   inherited Paint;
  56.   with Canvas do
  57.   begin
  58.     Brush.Style := bsClear;
  59.     Font.Color := FPanelColor.Color;
  60.     TextOut(10,10, Caption);
  61.   end;
  62. end;
  63.  
  64. constructor TTestPanel.Create(AOwner: TComponent);
  65. begin
  66.   inherited Create(AOwner);
  67.   FPanelColor := TTestColor.Create(Self);
  68. end;
  69.  
  70. destructor TTestPanel.Destroy;
  71. begin
  72.   FPanelColor.Free;
  73.   inherited Destroy;
  74. end;
  75.  
  76. { TTestColor }
  77.  
  78. procedure TTestColor.SetColor(AValue: TColor);
  79. begin
  80.   if FColor=AValue then Exit;
  81.   FColor:=AValue;
  82.   FOwner.Invalidate;
  83. end;
  84.  
  85. constructor TTestColor.Create(AOwner: TComponent);
  86. begin
  87.   inherited Create;
  88.   FOwner := AOwner as TTestPanel;
  89. end;
  90.  
  91. end.

Anyone can test if really in runtime changes the color assigned in design time?
« Last Edit: July 04, 2018, 01:44:52 pm by critter »

rvk

  • Hero Member
  • *****
  • Posts: 6111
Re: Posible Bug
« Reply #14 on: July 04, 2018, 01:46:28 pm »
Anyone can test if really in runtime changes the color assigned in design time?
Yes, I had to comment out // procedure SetOtherColor(AValue: TColor); because you haven't included it (are you sure you are recompiling the IDE?).

But when I drop a TestPanel on a form and change the PanelColor.Color in design-time to clRed, the caption turns red directly in the design-form. (I didn't need to move the panel this time for it to change)

« Last Edit: July 04, 2018, 01:48:03 pm by rvk »

 

TinyPortal © 2005-2018