1 | unit ButtonBase;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes,
|
---|
7 | {$IFDEF DPI}Dpi.Graphics, Dpi.Controls{$ELSE}
|
---|
8 | Graphics, Controls{$ENDIF};
|
---|
9 |
|
---|
10 | type
|
---|
11 |
|
---|
12 | { TButtonBase }
|
---|
13 |
|
---|
14 | TButtonBase = class(TGraphicControl)
|
---|
15 | protected
|
---|
16 | FDown: Boolean;
|
---|
17 | FPermanent: Boolean;
|
---|
18 | FGraphic: TBitmap;
|
---|
19 | // FDownSound, FUpSound: string;
|
---|
20 | ClickProc: TNotifyEvent;
|
---|
21 | DownChangedProc: TNotifyEvent;
|
---|
22 | procedure SetDown(X: Boolean);
|
---|
23 | // procedure PlayDownSound;
|
---|
24 | // procedure PlayUpSound;
|
---|
25 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
---|
26 | X, Y: Integer); override;
|
---|
27 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
---|
28 | X, Y: Integer); override;
|
---|
29 | procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
---|
30 | private
|
---|
31 | Active: Boolean;
|
---|
32 | procedure SetGraphic(AValue: TBitmap);
|
---|
33 | public
|
---|
34 | constructor Create(AOwner: TComponent); override;
|
---|
35 | property Graphic: TBitmap read FGraphic write SetGraphic;
|
---|
36 | // property DownSound: string read FDownSound write FDownSound;
|
---|
37 | // property UpSound: string read FUpSound write FUpSound;
|
---|
38 | published
|
---|
39 | property Visible;
|
---|
40 | property Down: Boolean read FDown write SetDown;
|
---|
41 | property Permanent: Boolean read FPermanent write FPermanent;
|
---|
42 | property OnClick: TNotifyEvent read ClickProc write ClickProc;
|
---|
43 | property OnDownChanged: TNotifyEvent read DownChangedProc
|
---|
44 | write DownChangedProc;
|
---|
45 | end;
|
---|
46 |
|
---|
47 | implementation
|
---|
48 |
|
---|
49 | // uses
|
---|
50 | // MMSystem;
|
---|
51 |
|
---|
52 | constructor TButtonBase.Create(AOwner: TComponent);
|
---|
53 | begin
|
---|
54 | inherited;
|
---|
55 | // FDownSound:='';
|
---|
56 | // FUpSound:='';
|
---|
57 | FGraphic := nil;
|
---|
58 | Active := False;
|
---|
59 | FDown := False;
|
---|
60 | FPermanent := False;
|
---|
61 | ClickProc := nil;
|
---|
62 | end;
|
---|
63 |
|
---|
64 | procedure TButtonBase.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
---|
65 | X, Y: Integer);
|
---|
66 | begin
|
---|
67 | Active := True;
|
---|
68 | MouseMove(Shift, X, Y);
|
---|
69 | end;
|
---|
70 |
|
---|
71 | procedure TButtonBase.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
---|
72 | X, Y: Integer);
|
---|
73 | begin
|
---|
74 | if ssLeft in Shift then
|
---|
75 | Exit;
|
---|
76 | MouseMove(Shift, X, Y);
|
---|
77 | if Active and FDown then
|
---|
78 | begin
|
---|
79 | // PlayUpSound;
|
---|
80 | Active := False;
|
---|
81 | if FDown <> FPermanent then
|
---|
82 | begin
|
---|
83 | FDown := FPermanent;
|
---|
84 | Invalidate;
|
---|
85 | if @DownChangedProc <> nil then
|
---|
86 | DownChangedProc(Self);
|
---|
87 | end;
|
---|
88 | if (Button = TMouseButton.mbLeft) and (@ClickProc <> nil) then
|
---|
89 | ClickProc(Self);
|
---|
90 | end
|
---|
91 | else
|
---|
92 | begin
|
---|
93 | // if FDown then PlayUpSound;
|
---|
94 | Active := False;
|
---|
95 | if FDown then
|
---|
96 | begin
|
---|
97 | FDown := False;
|
---|
98 | Invalidate;
|
---|
99 | if @DownChangedProc <> nil then
|
---|
100 | DownChangedProc(Self);
|
---|
101 | end;
|
---|
102 | end;
|
---|
103 | end;
|
---|
104 |
|
---|
105 | procedure TButtonBase.MouseMove(Shift: TShiftState; X, Y: Integer);
|
---|
106 | begin
|
---|
107 | if Active then
|
---|
108 | if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
|
---|
109 | if (ssLeft in Shift) and not FDown then
|
---|
110 | begin
|
---|
111 | { PlayDownSound; }
|
---|
112 | FDown := True;
|
---|
113 | Paint;
|
---|
114 | if @DownChangedProc <> nil then
|
---|
115 | DownChangedProc(Self);
|
---|
116 | end
|
---|
117 | else
|
---|
118 | else if FDown and not FPermanent then
|
---|
119 | begin
|
---|
120 | { PlayUpSound; }
|
---|
121 | FDown := False;
|
---|
122 | Paint;
|
---|
123 | if @DownChangedProc <> nil then
|
---|
124 | DownChangedProc(Self);
|
---|
125 | end;
|
---|
126 | end;
|
---|
127 |
|
---|
128 | procedure TButtonBase.SetGraphic(AValue: TBitmap);
|
---|
129 | begin
|
---|
130 | if FGraphic = AValue then Exit;
|
---|
131 | FGraphic := AValue;
|
---|
132 | end;
|
---|
133 |
|
---|
134 | procedure TButtonBase.SetDown(X: Boolean);
|
---|
135 | begin
|
---|
136 | FDown := X;
|
---|
137 | Invalidate;
|
---|
138 | end;
|
---|
139 |
|
---|
140 | // procedure TButtonBase.PlayDownSound;
|
---|
141 | // begin
|
---|
142 | // if DownSound<>'' then SndPlaySound(PChar(DownSound),SND_ASYNC)
|
---|
143 | // end;
|
---|
144 |
|
---|
145 | // procedure TButtonBase.PlayUpSound;
|
---|
146 | // begin
|
---|
147 | // if UpSound<>'' then SndPlaySound(PChar(UpSound),SND_ASYNC)
|
---|
148 | // end;
|
---|
149 |
|
---|
150 | end.
|
---|