362 lines
9.0 KiB
ObjectPascal
362 lines
9.0 KiB
ObjectPascal
// SPDX-License-Identifier: LGPL-3.0-linking-exception
|
|
{******************************* CONTRIBUTOR(S) ******************************
|
|
- Edivando S. Santos Brasil | mailedivando@gmail.com
|
|
(Compatibility with delphi VCL 11/2018)
|
|
|
|
***************************** END CONTRIBUTOR(S) *****************************}
|
|
unit BCNumericKeyboard;
|
|
|
|
{$I bgracontrols.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, {$IFDEF FPC}LCLType, LResources, LMessages,{$ENDIF}
|
|
Forms, Controls, Graphics, Dialogs, MouseAndKeyInput,
|
|
{$IFNDEF FPC}Types, Windows, BGRAGraphics, GraphType, FPImage, BCBaseCtrls, {$ENDIF}
|
|
BCPanel, BCButton, BCThemeManager;
|
|
|
|
type
|
|
|
|
{ TBCCustomNumericKeyboard }
|
|
|
|
TBCCustomNumericKeyboard = class(TComponent)
|
|
private
|
|
FBCThemeManager: TBCThemeManager;
|
|
procedure SetFThemeManager(AValue: TBCThemeManager);
|
|
protected
|
|
FOnChange: TNotifyEvent;
|
|
FOnUserChange: TNotifyEvent;
|
|
FPanel: TBCPanel;
|
|
FButton: TBCButton;
|
|
FBtn0, FBtn1, FBtn2, FBtn3, FBtn4, FBtn5, FBtn6, FBtn7, FBtn8,
|
|
FBtn9, FBtnDot, FBtnClr: TBCButton;
|
|
FValue: string;
|
|
FVisible: boolean;
|
|
procedure SetFButton(AValue: TBCButton);
|
|
procedure SetFPanel(AValue: TBCPanel);
|
|
procedure SetFValue(AValue: string);
|
|
protected
|
|
procedure OnButtonClick(Sender: TObject; {%H-}Button: TMouseButton;
|
|
{%H-}Shift: TShiftState; {%H-}X, {%H-}Y: integer); virtual;
|
|
protected
|
|
{ The input value }
|
|
property Value: string read FValue write SetFValue;
|
|
{ When value is changed by code or by the user }
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
{ When value is changed by the user }
|
|
property OnUserChange: TNotifyEvent read FOnUserChange write FOnUserChange;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
// Show in a custom form or panel
|
|
procedure Show(AControl: TWinControl); overload;
|
|
// Try to Show in the form where this component is placed
|
|
procedure Show(); overload;
|
|
// Hide the component
|
|
procedure Hide();
|
|
// Update buttons style
|
|
procedure UpdateButtonStyle;
|
|
public
|
|
{ The real panel that's used as container for all the numeric buttons }
|
|
property Panel: TBCPanel read FPanel write SetFPanel;
|
|
{ A fake button that's used as style base for all the numeric buttons }
|
|
property ButtonStyle: TBCButton read FButton write SetFButton;
|
|
{ If it's visible or not }
|
|
property Visible: boolean read FVisible;
|
|
published
|
|
property ThemeManager: TBCThemeManager read FBCThemeManager write SetFThemeManager;
|
|
end;
|
|
|
|
TBCNumericKeyboard = class(TBCCustomNumericKeyboard)
|
|
published
|
|
property Value;
|
|
property OnChange;
|
|
property OnUserChange;
|
|
property ThemeManager;
|
|
end;
|
|
|
|
{ TBCRealNumericKeyboard }
|
|
|
|
TBCRealNumericKeyboard = class(TBCCustomNumericKeyboard)
|
|
protected
|
|
procedure OnButtonClick(Sender: TObject; {%H-}Button: TMouseButton;
|
|
{%H-}Shift: TShiftState; {%H-}X, {%H-}Y: integer); override;
|
|
procedure PressVirtKey(p: longint);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
property OnUserChange;
|
|
property ThemeManager;
|
|
end;
|
|
|
|
{$IFDEF FPC}procedure Register;{$ENDIF}
|
|
|
|
implementation
|
|
|
|
{$IFDEF FPC}
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('BGRA Controls', [TBCNumericKeyboard]);
|
|
RegisterComponents('BGRA Controls', [TBCRealNumericKeyboard]);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TBCRealNumericKeyboard }
|
|
|
|
procedure TBCRealNumericKeyboard.OnButtonClick(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: integer);
|
|
const
|
|
{$IFDEF LINUX}
|
|
vk_DotNumPad = 110;
|
|
{$ELSE}
|
|
vk_DotNumPad = 190;
|
|
{$ENDIF}
|
|
var
|
|
btn: TBCButton;
|
|
num: string;
|
|
begin
|
|
btn := TBCButton(Sender);
|
|
num := btn.Caption;
|
|
|
|
if num = FBtnClr.Caption then
|
|
begin
|
|
{$IFDEF CPUX86_64}
|
|
Application.ProcessMessages;
|
|
KeyInput.Press(VK_BACK);
|
|
Application.ProcessMessages;
|
|
{$ELSE}
|
|
{$IFDEF FPC}
|
|
Application.QueueAsyncCall(@PressVirtKey, VK_BACK);
|
|
{$ELSE}
|
|
SendKey(VK_BACK);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end
|
|
else if num = FBtnDot.Caption then
|
|
begin
|
|
{$IFDEF CPUX86_64}
|
|
Application.ProcessMessages;
|
|
KeyInput.Press(vk_DotNumPad);
|
|
Application.ProcessMessages;
|
|
{$ELSE}
|
|
{$IFDEF FPC}
|
|
Application.QueueAsyncCall(@PressVirtKey, vk_DotNumPad);
|
|
{$ELSE}
|
|
SendKey(vk_DotNumPad);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
begin
|
|
{$IFDEF CPUX86_64}
|
|
Application.ProcessMessages;
|
|
KeyInput.Press(Ord(TBCButton(Sender).Caption[1]));
|
|
Application.ProcessMessages;
|
|
{$ELSE}
|
|
{$IFDEF FPC}
|
|
Application.QueueAsyncCall(@PressVirtKey, Ord(TBCButton(Sender).Caption[1]));
|
|
{$ELSE}
|
|
SendKey(Ord(TBCButton(Sender).Caption[1]));
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
if Assigned(FOnUserChange) then
|
|
FOnUserChange(Self);
|
|
end;
|
|
|
|
procedure TBCRealNumericKeyboard.PressVirtKey(p: longint);
|
|
begin
|
|
KeyInput.Down(p);
|
|
KeyInput.Up(p);
|
|
end;
|
|
|
|
constructor TBCRealNumericKeyboard.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FBtnClr.Caption := '<-';
|
|
end;
|
|
|
|
{ TBCCustomNumericKeyboard }
|
|
|
|
procedure TBCCustomNumericKeyboard.SetFPanel(AValue: TBCPanel);
|
|
begin
|
|
if FPanel = AValue then
|
|
Exit;
|
|
FPanel := AValue;
|
|
end;
|
|
|
|
procedure TBCCustomNumericKeyboard.SetFValue(AValue: string);
|
|
begin
|
|
if FValue = AValue then
|
|
Exit;
|
|
FValue := AValue;
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
procedure TBCCustomNumericKeyboard.OnButtonClick(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: integer);
|
|
var
|
|
btn: TBCButton;
|
|
num: string;
|
|
begin
|
|
btn := TBCButton(Sender);
|
|
num := btn.Caption;
|
|
|
|
if num = FBtnClr.Caption then
|
|
begin
|
|
Value := '';
|
|
end
|
|
else if num = FBtnDot.Caption then
|
|
begin
|
|
if Length(Value) = 0 then
|
|
Value := '0' + num;
|
|
if Pos(num, Value) = 0 then
|
|
Value := Value + num;
|
|
end
|
|
else
|
|
begin
|
|
Value := Value + num;
|
|
end;
|
|
|
|
if Assigned(FOnUserChange) then
|
|
FOnUserChange(Self);
|
|
end;
|
|
|
|
procedure TBCCustomNumericKeyboard.SetFThemeManager(AValue: TBCThemeManager);
|
|
begin
|
|
if FBCThemeManager = AValue then
|
|
Exit;
|
|
FBCThemeManager := AValue;
|
|
end;
|
|
|
|
procedure TBCCustomNumericKeyboard.SetFButton(AValue: TBCButton);
|
|
begin
|
|
if FButton = AValue then
|
|
Exit;
|
|
FButton := AValue;
|
|
end;
|
|
|
|
constructor TBCCustomNumericKeyboard.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FVisible := False;
|
|
|
|
FButton := TBCButton.Create(Self);
|
|
|
|
FPanel := TBCPanel.Create(Self);
|
|
FPanel.AutoSize := True;
|
|
FPanel.ChildSizing.ControlsPerLine := 3;
|
|
FPanel.ChildSizing.Layout := cclLeftToRightThenTopToBottom;
|
|
FPanel.Caption := '';
|
|
FPanel.BorderBCStyle := bpsBorder;
|
|
|
|
FBtn7 := TBCButton.Create(FPanel);
|
|
FBtn7.Parent := FPanel;
|
|
FBtn7.Caption := '7';
|
|
FBtn7.OnMouseDown := OnButtonClick;
|
|
|
|
FBtn8 := TBCButton.Create(FPanel);
|
|
FBtn8.Parent := FPanel;
|
|
FBtn8.Caption := '8';
|
|
FBtn8.OnMouseDown := OnButtonClick;
|
|
|
|
FBtn9 := TBCButton.Create(FPanel);
|
|
FBtn9.Caption := '9';
|
|
FBtn9.Parent := FPanel;
|
|
FBtn9.OnMouseDown := OnButtonClick;
|
|
|
|
FBtn4 := TBCButton.Create(FPanel);
|
|
FBtn4.Parent := FPanel;
|
|
FBtn4.Caption := '4';
|
|
FBtn4.OnMouseDown := OnButtonClick;
|
|
|
|
FBtn5 := TBCButton.Create(FPanel);
|
|
FBtn5.Parent := FPanel;
|
|
FBtn5.Caption := '5';
|
|
FBtn5.OnMouseDown := OnButtonClick;
|
|
|
|
FBtn6 := TBCButton.Create(FPanel);
|
|
FBtn6.Parent := FPanel;
|
|
FBtn6.Caption := '6';
|
|
FBtn6.OnMouseDown := OnButtonClick;
|
|
|
|
FBtn1 := TBCButton.Create(FPanel);
|
|
FBtn1.Parent := FPanel;
|
|
FBtn1.Caption := '1';
|
|
FBtn1.OnMouseDown := OnButtonClick;
|
|
|
|
FBtn2 := TBCButton.Create(FPanel);
|
|
FBtn2.Parent := FPanel;
|
|
FBtn2.Caption := '2';
|
|
FBtn2.OnMouseDown := OnButtonClick;
|
|
|
|
FBtn3 := TBCButton.Create(FPanel);
|
|
FBtn3.Parent := FPanel;
|
|
FBtn3.Caption := '3';
|
|
FBtn3.OnMouseDown := OnButtonClick;
|
|
|
|
FBtn0 := TBCButton.Create(FPanel);
|
|
FBtn0.Parent := FPanel;
|
|
FBtn0.Caption := '0';
|
|
FBtn0.OnMouseDown := OnButtonClick;
|
|
|
|
FBtnDot := TBCButton.Create(FPanel);
|
|
FBtnDot.Parent := FPanel;
|
|
FBtnDot.Caption := {$IFDEF FPC}DefaultFormatSettings{$ELSE}FormatSettings{$ENDIF}.DecimalSeparator;
|
|
FBtnDot.OnMouseDown := OnButtonClick;
|
|
|
|
FBtnClr := TBCButton.Create(FPanel);
|
|
FBtnClr.Parent := FPanel;
|
|
FBtnClr.Caption := 'C';
|
|
FBtnClr.OnMouseDown := OnButtonClick;
|
|
end;
|
|
|
|
destructor TBCCustomNumericKeyboard.Destroy;
|
|
begin
|
|
{ Everything inside the panel will be freed }
|
|
FPanel.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TBCCustomNumericKeyboard.Show(AControl: TWinControl);
|
|
begin
|
|
FPanel.Parent := AControl;
|
|
FVisible := True;
|
|
end;
|
|
|
|
procedure TBCCustomNumericKeyboard.Show;
|
|
begin
|
|
if Self.Owner is TWinControl then
|
|
Show(Self.Owner as TWinControl)
|
|
else
|
|
raise Exception.Create('The parent is not TWinControl descendant.');
|
|
end;
|
|
|
|
procedure TBCCustomNumericKeyboard.Hide;
|
|
begin
|
|
FPanel.Parent := nil;
|
|
FVisible := False;
|
|
end;
|
|
|
|
procedure TBCCustomNumericKeyboard.UpdateButtonStyle;
|
|
begin
|
|
FBtn0.Assign(FButton);
|
|
FBtn1.Assign(FButton);
|
|
FBtn2.Assign(FButton);
|
|
FBtn3.Assign(FButton);
|
|
FBtn4.Assign(FButton);
|
|
FBtn5.Assign(FButton);
|
|
FBtn6.Assign(FButton);
|
|
FBtn7.Assign(FButton);
|
|
FBtn8.Assign(FButton);
|
|
FBtn9.Assign(FButton);
|
|
FBtnDot.Assign(FButton);
|
|
FBtnClr.Assign(FButton);
|
|
end;
|
|
|
|
end.
|