1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
unit ButtonBase;
// Replacement ButtonBase as original buttons
// do not work in QT5
// Need to avoid using Bitblt SCRAND & SCRPAINT
// PB Nov-20
interface
uses
Classes, Graphics, Buttons, LCLExceptionStackTrace;
type
TButtonBase = class (TSpeedButton)
private
FDown,
FPermanent : boolean;
FIndex : integer;
FGraphic : TBitmap;
protected
DownChangedProc: TNotifyEvent;
procedure SetIndex (Ind: Integer);
procedure SetGraphic (Bmp: TBitmap);
function GetGraphic: TBitmap;
procedure SetGlyph; virtual; abstract;
procedure CheckGlyph; virtual; abstract;
public
constructor Create (aOwner: TComponent); override;
published
property OnDownChanged: TNotifyEvent read DownChangedProc write DownChangedProc;
property Down: boolean read FDown write FDown;
property Permanent: boolean read FPermanent write FPermanent; // used in *.lfm
property ButtonIndex: integer read FIndex write SetIndex;
property Graphic: TBitmap read GetGraphic write SetGraphic;
end;
implementation
constructor TButtonBase.Create (aOwner: TComponent);
begin
inherited;
FGraphic := nil;
FDown := False;
ShowHint := True;
Findex := -1;
// Lazarus Issue #41600
// Need lazarus >= v.5.0 or patch for commit c2c8fe7d
{$IFDEF WINDOWS}
DrawingEffectsEnabled := deeEnabled;
{$ENDIF}
end;
procedure TButtonBase.SetIndex (Ind: integer);
begin
if (FIndex <> Ind) then
begin
FIndex := Ind;
CheckGlyph;
end;
end;
procedure TButtonBase.SetGraphic (Bmp: TBitmap);
begin
FGraphic := Bmp;
CheckGlyph;
end;
function TButtonBase.GetGraphic: TBitmap;
begin
GetGraphic := FGraphic;
end;
end.
|
