Recent

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

pcurtis

  • Hero Member
  • *****
  • Posts: 951
[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: 951
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

pcurtis

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

 

TinyPortal © 2005-2018