1 // SPDX-License-Identifier: LGPL-3.0-only (modified to allow linking)
2 {******************************* CONTRIBUTOR(S) ******************************
3 - Edivando S. Santos Brasil | mailedivando@gmail.com
4   (Compatibility with delphi VCL 11/2018)
5 
6 ***************************** END CONTRIBUTOR(S) *****************************}
7 unit BCNumericKeyboard;
8 
9 {$I bgracontrols.inc}
10 
11 interface
12 
13 uses
14   Classes, SysUtils, {$IFDEF FPC}LCLType, LResources, LMessages,{$ENDIF}
15   Forms, Controls, Graphics, Dialogs, MouseAndKeyInput,
16   {$IFNDEF FPC}Types, Windows, BGRAGraphics, GraphType, FPImage, BCBaseCtrls, {$ENDIF}
17   BCPanel, BCButton, BCThemeManager;
18 
19 type
20 
21   { TBCCustomNumericKeyboard }
22 
23   TBCCustomNumericKeyboard = class(TComponent)
24   private
25     FBCThemeManager: TBCThemeManager;
26     procedure SetFThemeManager(AValue: TBCThemeManager);
27   protected
28     FOnChange: TNotifyEvent;
29     FOnUserChange: TNotifyEvent;
30     FPanel: TBCPanel;
31     FButton: TBCButton;
32     FBtn0, FBtn1, FBtn2, FBtn3, FBtn4, FBtn5, FBtn6, FBtn7, FBtn8,
33     FBtn9, FBtnDot, FBtnClr: TBCButton;
34     FValue: string;
35     FVisible: boolean;
36     procedure SetFButton(AValue: TBCButton);
37     procedure SetFPanel(AValue: TBCPanel);
38     procedure SetFValue(AValue: string);
39   protected
40     procedure OnButtonClick(Sender: TObject; {%H-}Button: TMouseButton;
41       {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: integer); virtual;
42   protected
43     { The input value }
44     property Value: string read FValue write SetFValue;
45     { When value is changed by code or by the user }
46     property OnChange: TNotifyEvent read FOnChange write FOnChange;
47     { When value is changed by the user }
48     property OnUserChange: TNotifyEvent read FOnUserChange write FOnUserChange;
49   public
50     constructor Create(AOwner: TComponent); override;
51     destructor Destroy; override;
52     // Show in a custom form or panel
53     procedure Show(AControl: TWinControl); overload;
54     // Try to Show in the form where this component is placed
55     procedure Show(); overload;
56     // Hide the component
57     procedure Hide();
58     // Update buttons style
59     procedure UpdateButtonStyle;
60   public
61     { The real panel that's used as container for all the numeric buttons }
62     property Panel: TBCPanel read FPanel write SetFPanel;
63     { A fake button that's used as style base for all the numeric buttons }
64     property ButtonStyle: TBCButton read FButton write SetFButton;
65     { If it's visible or not }
66     property Visible: boolean read FVisible;
67   published
68     property ThemeManager: TBCThemeManager read FBCThemeManager write SetFThemeManager;
69   end;
70 
71   TBCNumericKeyboard = class(TBCCustomNumericKeyboard)
72   published
73     property Value;
74     property OnChange;
75     property OnUserChange;
76     property ThemeManager;
77   end;
78 
79   { TBCRealNumericKeyboard }
80 
81   TBCRealNumericKeyboard = class(TBCCustomNumericKeyboard)
82   protected
83     procedure OnButtonClick(Sender: TObject; {%H-}Button: TMouseButton;
84       {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: integer); override;
85     procedure PressVirtKey(p: longint);
86   public
87     constructor Create(AOwner: TComponent); override;
88   published
89     property OnUserChange;
90     property ThemeManager;
91   end;
92 
93 {$IFDEF FPC}procedure Register;{$ENDIF}
94 
95 implementation
96 
97 {$IFDEF FPC}
98 procedure Register;
99 begin
100   RegisterComponents('BGRA Controls', [TBCNumericKeyboard]);
101   RegisterComponents('BGRA Controls', [TBCRealNumericKeyboard]);
102 end;
103 {$ENDIF}
104 
105 { TBCRealNumericKeyboard }
106 
107 procedure TBCRealNumericKeyboard.OnButtonClick(Sender: TObject;
108   Button: TMouseButton; Shift: TShiftState; X, Y: integer);
109 const
110 {$IFDEF LINUX}
111   vk_DotNumPad = 110;
112 {$ELSE}
113   vk_DotNumPad = 190;
114 {$ENDIF}
115 var
116   btn: TBCButton;
117   num: string;
118 begin
119   btn := TBCButton(Sender);
120   num := btn.Caption;
121 
122   if num = FBtnClr.Caption then
123   begin
124     {$IFDEF CPUX86_64}
125     Application.ProcessMessages;
126     KeyInput.Press(VK_BACK);
127     Application.ProcessMessages;
128     {$ELSE}
129       {$IFDEF FPC}
130       Application.QueueAsyncCall(@PressVirtKey, VK_BACK);
131       {$ELSE}
132       SendKey(VK_BACK);
133       {$ENDIF}
134     {$ENDIF}
135   end
136   else if num = FBtnDot.Caption then
137   begin
138     {$IFDEF CPUX86_64}
139     Application.ProcessMessages;
140     KeyInput.Press(vk_DotNumPad);
141     Application.ProcessMessages;
142     {$ELSE}
143       {$IFDEF FPC}
144       Application.QueueAsyncCall(@PressVirtKey, vk_DotNumPad);
145       {$ELSE}
146       SendKey(vk_DotNumPad);
147       {$ENDIF}
148     {$ENDIF}
149   end
150   else
151   begin
152     {$IFDEF CPUX86_64}
153     Application.ProcessMessages;
154     KeyInput.Press(Ord(TBCButton(Sender).Caption[1]));
155     Application.ProcessMessages;
156     {$ELSE}
157       {$IFDEF FPC}
158       Application.QueueAsyncCall(@PressVirtKey, Ord(TBCButton(Sender).Caption[1]));
159       {$ELSE}
160       SendKey(Ord(TBCButton(Sender).Caption[1]));
161       {$ENDIF}
162     {$ENDIF}
163   end;
164 
165   if Assigned(FOnUserChange) then
166     FOnUserChange(Self);
167 end;
168 
169 procedure TBCRealNumericKeyboard.PressVirtKey(p: longint);
170 begin
171   KeyInput.Down(p);
172   KeyInput.Up(p);
173 end;
174 
175 constructor TBCRealNumericKeyboard.Create(AOwner: TComponent);
176 begin
177   inherited Create(AOwner);
178   FBtnClr.Caption := '<-';
179 end;
180 
181 { TBCCustomNumericKeyboard }
182 
183 procedure TBCCustomNumericKeyboard.SetFPanel(AValue: TBCPanel);
184 begin
185   if FPanel = AValue then
186     Exit;
187   FPanel := AValue;
188 end;
189 
190 procedure TBCCustomNumericKeyboard.SetFValue(AValue: string);
191 begin
192   if FValue = AValue then
193     Exit;
194   FValue := AValue;
195   if Assigned(FOnChange) then
196     FOnChange(Self);
197 end;
198 
199 procedure TBCCustomNumericKeyboard.OnButtonClick(Sender: TObject;
200   Button: TMouseButton; Shift: TShiftState; X, Y: integer);
201 var
202   btn: TBCButton;
203   num: string;
204 begin
205   btn := TBCButton(Sender);
206   num := btn.Caption;
207 
208   if num = FBtnClr.Caption then
209   begin
210     Value := '';
211   end
212   else if num = FBtnDot.Caption then
213   begin
214     if Length(Value) = 0 then
215       Value := '0' + num;
216     if Pos(num, Value) = 0 then
217       Value := Value + num;
218   end
219   else
220   begin
221     Value := Value + num;
222   end;
223 
224   if Assigned(FOnUserChange) then
225     FOnUserChange(Self);
226 end;
227 
228 procedure TBCCustomNumericKeyboard.SetFThemeManager(AValue: TBCThemeManager);
229 begin
230   if FBCThemeManager = AValue then
231     Exit;
232   FBCThemeManager := AValue;
233 end;
234 
235 procedure TBCCustomNumericKeyboard.SetFButton(AValue: TBCButton);
236 begin
237   if FButton = AValue then
238     Exit;
239   FButton := AValue;
240 end;
241 
242 constructor TBCCustomNumericKeyboard.Create(AOwner: TComponent);
243 begin
244   inherited Create(AOwner);
245 
246   FVisible := False;
247 
248   FButton := TBCButton.Create(Self);
249 
250   FPanel := TBCPanel.Create(Self);
251   FPanel.AutoSize := True;
252   FPanel.ChildSizing.ControlsPerLine := 3;
253   FPanel.ChildSizing.Layout := cclLeftToRightThenTopToBottom;
254   FPanel.Caption := '';
255   FPanel.BorderBCStyle := bpsBorder;
256 
257   FBtn7 := TBCButton.Create(FPanel);
258   FBtn7.Parent := FPanel;
259   FBtn7.Caption := '7';
260   FBtn7.OnMouseDown := OnButtonClick;
261 
262   FBtn8 := TBCButton.Create(FPanel);
263   FBtn8.Parent := FPanel;
264   FBtn8.Caption := '8';
265   FBtn8.OnMouseDown := OnButtonClick;
266 
267   FBtn9 := TBCButton.Create(FPanel);
268   FBtn9.Caption := '9';
269   FBtn9.Parent := FPanel;
270   FBtn9.OnMouseDown := OnButtonClick;
271 
272   FBtn4 := TBCButton.Create(FPanel);
273   FBtn4.Parent := FPanel;
274   FBtn4.Caption := '4';
275   FBtn4.OnMouseDown := OnButtonClick;
276 
277   FBtn5 := TBCButton.Create(FPanel);
278   FBtn5.Parent := FPanel;
279   FBtn5.Caption := '5';
280   FBtn5.OnMouseDown := OnButtonClick;
281 
282   FBtn6 := TBCButton.Create(FPanel);
283   FBtn6.Parent := FPanel;
284   FBtn6.Caption := '6';
285   FBtn6.OnMouseDown := OnButtonClick;
286 
287   FBtn1 := TBCButton.Create(FPanel);
288   FBtn1.Parent := FPanel;
289   FBtn1.Caption := '1';
290   FBtn1.OnMouseDown := OnButtonClick;
291 
292   FBtn2 := TBCButton.Create(FPanel);
293   FBtn2.Parent := FPanel;
294   FBtn2.Caption := '2';
295   FBtn2.OnMouseDown := OnButtonClick;
296 
297   FBtn3 := TBCButton.Create(FPanel);
298   FBtn3.Parent := FPanel;
299   FBtn3.Caption := '3';
300   FBtn3.OnMouseDown := OnButtonClick;
301 
302   FBtn0 := TBCButton.Create(FPanel);
303   FBtn0.Parent := FPanel;
304   FBtn0.Caption := '0';
305   FBtn0.OnMouseDown := OnButtonClick;
306 
307   FBtnDot := TBCButton.Create(FPanel);
308   FBtnDot.Parent := FPanel;
309   FBtnDot.Caption := {$IFDEF FPC}DefaultFormatSettings{$ELSE}FormatSettings{$ENDIF}.DecimalSeparator;
310   FBtnDot.OnMouseDown := OnButtonClick;
311 
312   FBtnClr := TBCButton.Create(FPanel);
313   FBtnClr.Parent := FPanel;
314   FBtnClr.Caption := 'C';
315   FBtnClr.OnMouseDown := OnButtonClick;
316 end;
317 
318 destructor TBCCustomNumericKeyboard.Destroy;
319 begin
320   { Everything inside the panel will be freed }
321   FPanel.Free;
322   inherited Destroy;
323 end;
324 
325 procedure TBCCustomNumericKeyboard.Show(AControl: TWinControl);
326 begin
327   FPanel.Parent := AControl;
328   FVisible := True;
329 end;
330 
331 procedure TBCCustomNumericKeyboard.Show;
332 begin
333   if Self.Owner is TWinControl then
334     Show(Self.Owner as TWinControl)
335   else
336     raise Exception.Create('The parent is not TWinControl descendant.');
337 end;
338 
339 procedure TBCCustomNumericKeyboard.Hide;
340 begin
341   FPanel.Parent := nil;
342   FVisible := False;
343 end;
344 
345 procedure TBCCustomNumericKeyboard.UpdateButtonStyle;
346 begin
347   FBtn0.Assign(FButton);
348   FBtn1.Assign(FButton);
349   FBtn2.Assign(FButton);
350   FBtn3.Assign(FButton);
351   FBtn4.Assign(FButton);
352   FBtn5.Assign(FButton);
353   FBtn6.Assign(FButton);
354   FBtn7.Assign(FButton);
355   FBtn8.Assign(FButton);
356   FBtn9.Assign(FButton);
357   FBtnDot.Assign(FButton);
358   FBtnClr.Assign(FButton);
359 end;
360 
361 end.
362