bcnumerickeyboard.pas 8.2 KB

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