Recent

Author Topic: [SOLVED] Setter not working  (Read 3317 times)

pcurtis

  • Hero Member
  • *****
  • Posts: 848
[SOLVED] Setter not working
« on: November 23, 2021, 04:35:45 am »
Why can't I set the image on this simple control?

Code: Pascal  [Select][+][-]
  1. unit mytestbtn;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, LResources, Forms, Controls, Graphics, ExtCtrls, Dialogs, Buttons,
  9.   lclintf;
  10.  
  11. type
  12.  
  13.   TMytestbtn = class(TCustomControl)
  14.   private
  15.     fbtnEXTRA : TBitBtn;
  16.     fImage : TBitmap;
  17.  
  18.     procedure SetImage(aValue : TBitmap);
  19.   protected
  20.  
  21.   public
  22.     constructor Create(AOwner : TComponent); override;
  23.     destructor Destroy; override;
  24.   published
  25.     property TheImage : TBitmap read fImage write SetImage;
  26.   end;
  27.  
  28. procedure Register;
  29.  
  30. implementation
  31.  
  32. constructor TMytestbtn.Create(AOwner : TComponent);
  33. begin
  34.   inherited Create(AOwner);
  35.  
  36.   fImage := TBitmap.Create;
  37.  
  38.   Color := clLime;
  39.  
  40.   fbtnEXTRA := TBitBtn.Create(self);
  41.   With fbtnEXTRA do
  42.   begin
  43.     Top := 10;
  44.     Left := 10;
  45.     Width := 80;
  46.     Height := 80;
  47.     Caption := '';
  48.     Layout := blGlyphTop;
  49.     Parent := Self;
  50.     Glyph.Assign(fImage);
  51.   end;
  52.  
  53.   SetInitialBounds(0, 0, 100, 100);
  54. end;
  55.  
  56. Destructor TMytestbtn.Destroy;
  57. begin
  58.   fImage.Free;
  59.   inherited Destroy;
  60. end;
  61.  
  62. procedure TMytestbtn.SetImage(aValue : TBitmap);
  63. begin
  64.   fImage.Assign(aValue);
  65.   if fbtnEXTRA <> nil then
  66.     fbtnEXTRA.Glyph.Assign(fImage);
  67.   Invalidate;
  68. end;
  69.  
  70. procedure Register;
  71. begin
  72.   RegisterComponents('Misc', [TMytestbtn]);
  73. end;
  74.  
  75. end.
« Last Edit: November 24, 2021, 08:15:42 am by pcurtis »
Windows 10 20H2
Laz 2.2.0
FPC 3.2.2

pcurtis

  • Hero Member
  • *****
  • Posts: 848
Re: Setter not working
« Reply #1 on: November 23, 2021, 08:42:05 am »
I tried this but the Bitbtn just flashes  (locked in a loop)

Code: Pascal  [Select][+][-]
  1. unit mytestbtn;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, LResources, Forms, Controls, Graphics, ExtCtrls, Dialogs, Buttons,
  9.   lclintf;
  10.  
  11. type
  12.   TMytestbtn = class(TCustomControl)
  13.     private
  14.       FGlyph: TBitmap;
  15.       fbtnEXTRA : TBitBtn;
  16.       procedure GlyphChanged(Sender: TObject);
  17.       function IsGlyphStored: Boolean;
  18.       procedure SetGlyph(AValue: TBitmap);
  19.     protected
  20.       procedure Paint; override;
  21.     public
  22.       constructor Create(AOwner: TComponent); override;
  23.       destructor Destroy; override;
  24.     published
  25.       property Glyph: TBitmap read FGlyph write SetGlyph stored IsGlyphStored;
  26.     end;
  27.  
  28.  
  29.  
  30. procedure Register;
  31.  
  32. implementation
  33.  
  34. constructor TMytestbtn.Create(AOwner : TComponent);
  35. begin
  36.   inherited Create(AOwner);
  37.  
  38.  
  39. FGlyph := TBitmap.Create;
  40. FGlyph.OnChange := @GlyphChanged;
  41.  
  42.   Color := clLime;
  43.  
  44.   fbtnEXTRA := TBitBtn.Create(self);
  45.   With fbtnEXTRA do
  46.   begin
  47.     Top := 10;
  48.     Left := 10;
  49.     Width := 80;
  50.     Height := 80;
  51.     Caption := '';
  52.     Layout := blGlyphTop;
  53.     Parent := Self;
  54.   end;
  55.  
  56.   SetInitialBounds(0, 0, 100, 100);
  57. end;
  58.  
  59. Destructor TMytestbtn.Destroy;
  60. begin
  61.   FGlyph.Free;
  62.   inherited Destroy;
  63. end;
  64.  
  65. procedure TMytestbtn.GlyphChanged(Sender: TObject);
  66. begin
  67.   Invalidate;
  68. end;
  69.  
  70. function TMytestbtn.IsGlyphStored: Boolean;
  71. begin
  72.   Result := not FGlyph.Empty;
  73. end;
  74.  
  75. procedure TMytestbtn.Paint;
  76. begin
  77.   inherited Paint;
  78.   fbtnEXTRA.Glyph.Assign(FGlyph);
  79. end;
  80.  
  81. procedure TMytestbtn.SetGlyph(AValue: TBitmap);
  82. begin
  83.   FGlyph.Assign(AValue);
  84. end;
  85.  
  86. procedure Register;
  87. begin
  88.   RegisterComponents('Misc', [TMytestbtn]);
  89. end;
  90.  
  91. end.
Windows 10 20H2
Laz 2.2.0
FPC 3.2.2

jamie

  • Hero Member
  • *****
  • Posts: 5140
Re: Setter not working
« Reply #2 on: November 23, 2021, 11:00:37 pm »
Setting the image of the child button is caching up another invalidate, you shouldn't be doing that within the Paint event.
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs,buttons, StdCtrls;
  9.  
  10. type
  11.  
  12.   TMytestbtn = class(TCustomControl)
  13.     private
  14.       FGlyph: TBitmap;
  15.       fbtnEXTRA : TBitBtn;
  16.       procedure GlyphChanged(Sender: TObject);
  17.       function IsGlyphStored: Boolean;
  18.       procedure SetGlyph(AValue: TBitmap);
  19.     protected
  20.       procedure Paint; override;
  21.     public
  22.       constructor Create(AOwner: TComponent); override;
  23.       destructor Destroy; override;
  24.     published
  25.       property Glyph: TBitmap read FGlyph write SetGlyph stored IsGlyphStored;
  26.     end;
  27.  
  28.  
  29.   { TForm1 }
  30.  
  31.   TForm1 = class(TForm)
  32.     Button1: TButton;
  33.     procedure Button1Click(Sender: TObject);
  34.     procedure FormCreate(Sender: TObject);
  35.   private
  36.  
  37.   public
  38.    Yup:TMyTestBtn;
  39.   end;
  40.  
  41. var
  42.   Form1: TForm1;
  43.  
  44. implementation
  45.  
  46. {$R *.lfm}
  47.  
  48. { TForm1 }
  49.  
  50. procedure TForm1.FormCreate(Sender: TObject);
  51. begin
  52.   Yup := TMyTestBtn.Create(Self);
  53.   Yup.Parent := self;
  54.   Yup.Visible := true;
  55. end;
  56.  
  57. procedure TForm1.Button1Click(Sender: TObject);
  58. var
  59.   B:TBitmap;
  60. begin
  61.   B:= TBitmap.Create;
  62.   B.SetSize(10,10);
  63.   Yup.Glyph := B;
  64.   B.Free;
  65. end;
  66.  
  67. constructor TMytestbtn.Create(AOwner : TComponent);
  68. begin
  69.   inherited Create(AOwner);
  70.  
  71.  
  72. FGlyph := TBitmap.Create;
  73. FGlyph.OnChange := @GlyphChanged;
  74.  
  75.   Color := clLime;
  76.  
  77.   fbtnEXTRA := TBitBtn.Create(self);
  78.   With fbtnEXTRA do
  79.   begin
  80.     Top := 10;
  81.     Left := 10;
  82.     Width := 80;
  83.     Height := 80;
  84.     Caption := '';
  85.     Layout := blGlyphTop;
  86.     Parent := Self;
  87.     visible := true;
  88.   end;
  89.  
  90.   SetInitialBounds(0, 0, 100, 100);
  91. end;
  92.  
  93. Destructor TMytestbtn.Destroy;
  94. begin
  95.   FGlyph.Free;
  96.   inherited Destroy;
  97. end;
  98.  
  99. procedure TMytestbtn.GlyphChanged(Sender: TObject);
  100. begin
  101.   Invalidate;
  102. end;
  103.  
  104. function TMytestbtn.IsGlyphStored: Boolean;
  105. begin
  106.   Result := not FGlyph.Empty;
  107. end;
  108.  
  109. procedure TMytestbtn.Paint;
  110. begin
  111.   inherited Paint;
  112.  // fbtnEXTRA.Glyph.Assign(FGlyph);
  113. end;
  114.  
  115. procedure TMytestbtn.SetGlyph(AValue: TBitmap);
  116. begin
  117.   FGlyph.Assign(AValue);
  118.   fbtnEXTRA.Glyph.Assign(FGlyph);
  119. end;
  120.  
  121. end.
  122.  
  123.  

That will just a simple local Test I did with the min changes..
I didn't use a real image, just a blank bitmap.
The only true wisdom is knowing you know nothing

pcurtis

  • Hero Member
  • *****
  • Posts: 848
Re: Setter not working
« Reply #3 on: November 24, 2021, 08:14:39 am »
Cheers.
Windows 10 20H2
Laz 2.2.0
FPC 3.2.2

 

TinyPortal © 2005-2018