Lazarus

Programming => LCL => Topic started by: pcurtis on November 23, 2021, 04:35:45 am

Title: [SOLVED] Setter not working
Post by: pcurtis 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.

Title: Re: Setter not working
Post by: pcurtis 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.

Title: Re: Setter not working
Post by: pcurtis on November 24, 2021, 08:14:39 am

Cheers.