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
82
83
84
85
86
87
88
89
90
|
unit ButtonB;
// Replacement Buttons as original buttons
// do not work in QT5
// Need to avoid using Bitblt SCRAND & SCRPAINT
// PB Nov-20
interface uses Classes, Graphics, ButtonBase, LCLExceptionStackTrace;
type
TButtonB = class (TButtonBase)
constructor Create (aOwner: TComponent); override;
private
FMask: TBitmap;
procedure SetMask (Bmp: TBitmap);
protected
procedure SetGlyph; override;
public
procedure CheckGlyph; override;
published
property Mask: TBitmap read FMask write SetMask;
property Graphic: TBitmap read GetGraphic write SetGraphic;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents ('C-evo', [TButtonB]);
end;
const Sz = 25; { Square button }
Xg = 169; { Graphic offests }
Yg = 243;
Xm = 1; { Mask offsets }
Ym = 337;
constructor TButtonB.Create (aOwner: TComponent);
begin
inherited;
SetBounds(0, 0, Sz, Sz);
Glyph.Width := Sz;
Glyph.Height := Sz;
Fmask := nil;
end;
procedure TButtonB.SetGlyph;
var X ,Xpos, Y, Ypos : integer;
Dest, Src : TRect;
begin
Xpos := Xm + ButtonIndex mod 12 * (Sz+1);
Ypos := Ym + ButtonIndex div 12 * (Sz+1);
Dest := Rect (0, 0, Sz, Sz);
Src := Rect (Xg, Yg, Xg+Sz, Yg+Sz);
Glyph.BeginUpdate (True);
Glyph.Canvas.CopyRect (dest, GetGraphic.Canvas, src);
for X := 0 to (Sz-1) do
for Y := 0 to (Sz-1) do
if FMask.Canvas.Pixels [X+Xpos, Y+Ypos] = clBlack then
Glyph.Canvas.Pixels [X,Y] := clBlack;
Glyph.EndUpdate;
end;
procedure TButtonB.CheckGlyph;
begin
if (ButtonIndex >= 0) and (GetGraphic <> nil) and (FMask <> nil) then
SetGlyph;
end;
procedure TButtonB.SetMask (Bmp: TBitmap);
begin
FMask := Bmp;
CheckGlyph;
end;
end.
|
