source: branches/AlphaChannel/Packages/CevoComponents/ButtonN.pas

Last change on this file was 188, checked in by chronos, 5 years ago
  • Modified: Simplified code by replacing BitBlt which uses always handles by BitBltCanvas which uses directly TCanvas objects. Used default ROP SRCCOPY.
File size: 3.2 KB
Line 
1unit ButtonN;
2
3interface
4
5uses
6 Classes, Graphics, Controls, LCLIntf, LCLType, ScreenTools;
7
8type
9 TButtonN = class(TGraphicControl)
10 constructor Create(aOwner: TComponent); override;
11 private
12 FPossible, FLit: boolean;
13 FGraphic, FMask, FBackGraphic: TBitmap;
14 FIndex, BackIndex: integer;
15 FSmartHint: string;
16 ChangeProc: TNotifyEvent;
17 procedure SetPossible(x: boolean);
18 procedure SetLit(x: boolean);
19 procedure SetIndex(x: integer);
20 procedure SetSmartHint(x: string);
21 published
22 property Possible: boolean read FPossible write SetPossible;
23 property Lit: boolean read FLit write SetLit;
24 property SmartHint: string read FSmartHint write SetSmartHint;
25 property Graphic: TBitmap read FGraphic write FGraphic;
26 property Mask: TBitmap read FMask write FMask;
27 property BackGraphic: TBitmap read FBackGraphic write FBackGraphic;
28 property ButtonIndex: integer read FIndex write SetIndex;
29 property OnClick: TNotifyEvent read ChangeProc write ChangeProc;
30 protected
31 procedure Paint; override;
32 procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
33 x, y: integer); override;
34 end;
35
36procedure Register;
37
38implementation
39
40procedure Register;
41begin
42 RegisterComponents('C-evo', [TButtonN]);
43end;
44
45constructor TButtonN.Create(aOwner: TComponent);
46begin
47 inherited Create(aOwner);
48 ShowHint := true;
49 FGraphic := nil;
50 FBackGraphic := nil;
51 FPossible := true;
52 FLit := false;
53 FIndex := -1;
54 ChangeProc := nil;
55 SetBounds(0, 0, 42, 42);
56end;
57
58procedure TButtonN.Paint;
59begin
60 with Canvas do
61 begin
62 if FGraphic <> nil then
63 begin
64 BitBltCanvas(Canvas, 1, 1, 40, 40, FBackGraphic.Canvas,
65 1 + 80 * BackIndex + 40 * byte(FPossible and FLit), 176);
66 if FPossible then
67 begin
68 BitBltCanvas(Canvas, 3, 3, 36, 36, FMask.Canvas,
69 195 + 37 * (FIndex mod 3), 21 + 37 * (FIndex div 3), SRCAND);
70 BitBltCanvas(Canvas, 3, 3, 36, 36, FGraphic.Canvas,
71 195 + 37 * (FIndex mod 3), 21 + 37 * (FIndex div 3), SRCPAINT);
72 end;
73 end;
74 MoveTo(0, 41);
75 Pen.Color := $B0B0B0;
76 LineTo(0, 0);
77 LineTo(41, 0);
78 Pen.Color := $FFFFFF;
79 LineTo(41, 41);
80 LineTo(0, 41);
81 end;
82end;
83
84procedure TButtonN.MouseDown(Button: TMouseButton; Shift: TShiftState;
85 x, y: integer);
86begin
87 if FPossible and (Button = mbLeft) and (@ChangeProc <> nil) then
88 ChangeProc(Self);
89end;
90
91procedure TButtonN.SetPossible(x: boolean);
92begin
93 if x <> FPossible then
94 begin
95 FPossible := x;
96 if x then
97 Hint := FSmartHint
98 else
99 Hint := '';
100 Invalidate;
101 end;
102end;
103
104procedure TButtonN.SetLit(x: boolean);
105begin
106 if x <> FLit then
107 begin
108 FLit := x;
109 Invalidate;
110 end;
111end;
112
113procedure TButtonN.SetIndex(x: integer);
114begin
115 if x <> FIndex then
116 begin
117 FIndex := x;
118 if x < 6 then
119 BackIndex := 1
120 else
121 BackIndex := 0;
122 Invalidate;
123 end;
124end;
125
126procedure TButtonN.SetSmartHint(x: string);
127begin
128 if x <> FSmartHint then
129 begin
130 FSmartHint := x;
131 if FPossible then
132 Hint := x;
133 end;
134end;
135
136end.
Note: See TracBrowser for help on using the repository browser.