Quellcode durchsuchen

Added bcrealnumerickeyboard and related units

lainz vor 9 Jahren
Ursprung
Commit
905f29c275

+ 105 - 25
bcnumerickeyboard.pas

@@ -6,14 +6,14 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
-  BCPanel, BCButton;
+  BCPanel, BCButton, MouseAndKeyInput, LCLType;
 
 type
 
-  { TBCNumericKeyboard }
+  { TBCCustomNumericKeyboard }
 
-  TBCNumericKeyboard = class(TComponent)
-  private
+  TBCCustomNumericKeyboard = class(TComponent)
+  protected
     FOnChange: TNotifyEvent;
     FOnUserChange: TNotifyEvent;
     FPanel: TBCPanel;
@@ -27,7 +27,14 @@ type
     procedure SetFValue(AValue: string);
   protected
     procedure OnButtonClick(Sender: TObject; Button: TMouseButton;
-      Shift: TShiftState; X, Y: integer);
+      Shift: TShiftState; X, 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;
@@ -46,13 +53,27 @@ type
     property ButtonStyle: TBCButton read FButton write SetFButton;
     { If it's visible or not }
     property Visible: boolean read FVisible;
+  end;
+
+  TBCNumericKeyboard = class(TBCCustomNumericKeyboard)
   published
-    { 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;
+    property Value;
+    property OnChange;
+    property OnUserChange;
+  end;
+
+  { TBCRealNumericKeyboard }
+
+  TBCRealNumericKeyboard = class(TBCCustomNumericKeyboard)
+  protected
+    procedure OnButtonClick(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: integer); override;
+    procedure PressVirtKey(p: longint);
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property OnChange;
+    property OnUserChange;
   end;
 
 procedure Register;
@@ -61,19 +82,78 @@ implementation
 
 procedure Register;
 begin
-  RegisterComponents('BGRA Controls', [TBCNumericKeyboard]);
+  RegisterComponents('BGRA Controls', [TBCCustomNumericKeyboard]);
+  RegisterComponents('BGRA Controls', [TBCRealNumericKeyboard]);
+end;
+
+{ TBCRealNumericKeyboard }
+
+procedure TBCRealNumericKeyboard.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
+    {$IFDEF CPUX86_64}
+    Application.ProcessMessages;
+    KeyInput.Press(VK_BACK);
+    Application.ProcessMessages;
+    {$ELSE}
+    Application.QueueAsyncCall(@PressVirtKey, VK_BACK);
+    {$ENDIF}
+  end
+  else if num = FBtnDot.Caption then
+  begin
+    {$IFDEF CPUX86_64}
+    Application.ProcessMessages;
+    KeyInput.Press(190);
+    Application.ProcessMessages;
+    {$ELSE}
+    Application.QueueAsyncCall(@PressVirtKey, 190);
+    {$ENDIF}
+  end
+  else
+  begin
+    {$IFDEF CPUX86_64}
+    Application.ProcessMessages;
+    KeyInput.Press(Ord(TBCButton(Sender).Caption[1]));
+    Application.ProcessMessages;
+    {$ELSE}
+    Application.QueueAsyncCall(@PressVirtKey, Ord(TBCButton(Sender).Caption[1]));
+    {$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;
 
-{ TBCNumericKeyboard }
+{ TBCCustomNumericKeyboard }
 
-procedure TBCNumericKeyboard.SetFPanel(AValue: TBCPanel);
+procedure TBCCustomNumericKeyboard.SetFPanel(AValue: TBCPanel);
 begin
   if FPanel = AValue then
     Exit;
   FPanel := AValue;
 end;
 
-procedure TBCNumericKeyboard.SetFValue(AValue: string);
+procedure TBCCustomNumericKeyboard.SetFValue(AValue: string);
 begin
   if FValue = AValue then
     Exit;
@@ -82,7 +162,7 @@ begin
     FOnChange(Self);
 end;
 
-procedure TBCNumericKeyboard.OnButtonClick(Sender: TObject;
+procedure TBCCustomNumericKeyboard.OnButtonClick(Sender: TObject;
   Button: TMouseButton; Shift: TShiftState; X, Y: integer);
 var
   btn: TBCButton;
@@ -91,11 +171,11 @@ begin
   btn := TBCButton(Sender);
   num := btn.Caption;
 
-  if num = 'C' then
+  if num = FBtnClr.Caption then
   begin
     Value := '';
   end
-  else if num = DefaultFormatSettings.DecimalSeparator then
+  else if num = FBtnDot.Caption then
   begin
     if Length(Value) = 0 then
       Value := '0' + num;
@@ -111,14 +191,14 @@ begin
     FOnUserChange(Self);
 end;
 
-procedure TBCNumericKeyboard.SetFButton(AValue: TBCButton);
+procedure TBCCustomNumericKeyboard.SetFButton(AValue: TBCButton);
 begin
   if FButton = AValue then
     Exit;
   FButton := AValue;
 end;
 
-constructor TBCNumericKeyboard.Create(AOwner: TComponent);
+constructor TBCCustomNumericKeyboard.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
 
@@ -193,20 +273,20 @@ begin
   FBtnClr.OnMouseDown := @OnButtonClick;
 end;
 
-destructor TBCNumericKeyboard.Destroy;
+destructor TBCCustomNumericKeyboard.Destroy;
 begin
   { Everything inside the panel will be freed }
   FPanel.Free;
   inherited Destroy;
 end;
 
-procedure TBCNumericKeyboard.Show(AControl: TWinControl);
+procedure TBCCustomNumericKeyboard.Show(AControl: TWinControl);
 begin
   FPanel.Parent := AControl;
   FVisible := True;
 end;
 
-procedure TBCNumericKeyboard.Show;
+procedure TBCCustomNumericKeyboard.Show;
 begin
   if Self.Owner is TWinControl then
     Show(Self.Owner as TWinControl)
@@ -214,13 +294,13 @@ begin
     raise Exception.Create('The parent is not TWinControl descendant.');
 end;
 
-procedure TBCNumericKeyboard.Hide;
+procedure TBCCustomNumericKeyboard.Hide;
 begin
   FPanel.Parent := nil;
   FVisible := False;
 end;
 
-procedure TBCNumericKeyboard.UpdateButtonStyle;
+procedure TBCCustomNumericKeyboard.UpdateButtonStyle;
 begin
   FBtn0.Assign(FButton);
   FBtn1.Assign(FButton);

+ 8 - 3
bgracontrols.lpk

@@ -6,6 +6,7 @@
     <CompilerOptions>
       <Version Value="11"/>
       <SearchPaths>
+        <OtherUnitFiles Value="mouseandkeyinput"/>
         <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/$(FPCVer)"/>
       </SearchPaths>
       <CodeGeneration>
@@ -22,7 +23,7 @@
       </Linking>
     </CompilerOptions>
     <Version Major="4" Minor="1"/>
-    <Files Count="37">
+    <Files Count="38">
       <Item1>
         <Filename Value="bcbasectrls.pas"/>
         <UnitName Value="BCBaseCtrls"/>
@@ -64,7 +65,7 @@
       <Item9>
         <Filename Value="bcmaterialdesignbutton.pas"/>
         <HasRegisterProc Value="True"/>
-        <UnitName Value="bcmaterialdesignbutton"/>
+        <UnitName Value="BCMaterialDesignButton"/>
       </Item9>
       <Item10>
         <Filename Value="bcpanel.pas"/>
@@ -106,7 +107,7 @@
       <Item18>
         <Filename Value="bgracustomdrawn.pas"/>
         <HasRegisterProc Value="True"/>
-        <UnitName Value="bgracustomdrawn"/>
+        <UnitName Value="BGRACustomDrawn"/>
       </Item18>
       <Item19>
         <Filename Value="bgraflashprogressbar.pas"/>
@@ -200,6 +201,10 @@
         <HasRegisterProc Value="True"/>
         <UnitName Value="BCNumericKeyboard"/>
       </Item37>
+      <Item38>
+        <Filename Value="mouseandkeyinput/mouseandkeyinput.pas"/>
+        <UnitName Value="MouseAndKeyInput"/>
+      </Item38>
     </Files>
     <RequiredPkgs Count="4">
       <Item1>

+ 1 - 1
bgracontrols.pas

@@ -16,7 +16,7 @@ uses
   BGRAResizeSpeedButton, BGRAScript, BGRAShape, BGRASpeedButton, 
   BGRASpriteAnimation, BGRAVirtualScreen, DTAnalogClock, DTAnalogCommon, 
   DTAnalogGauge, dtthemedclock, dtthemedgauge, uPSI_BGRAPascalScript, 
-  BCNumericKeyboard, LazarusPackageIntf;
+  BCNumericKeyboard, MouseAndKeyInput, LazarusPackageIntf;
 
 implementation
 

+ 80 - 0
mouseandkeyinput/carbonkeyinput.pas

@@ -0,0 +1,80 @@
+{ CarbonKeyInput
+
+  Copyright (C) 2008 Tom Gregorovic
+
+  This source is free software; you can redistribute it and/or modify it under the terms of the
+  GNU General Public License as published by the Free Software Foundation; either version 2 of the
+  License, or (at your option) any later version.
+
+  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+  General Public License for more details.
+
+  A copy of the GNU General Public License is available on the World Wide Web at
+  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
+  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit CarbonKeyInput;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Forms,
+  MacOSAll, CarbonProc,
+  KeyInputIntf;
+  
+type
+
+  { TCarbonKeyInput }
+
+  TCarbonKeyInput = class(TKeyInput)
+  protected
+    procedure DoDown(Key: Word); override;
+    procedure DoUp(Key: Word); override;
+  end;
+  
+function InitializeKeyInput: TKeyInput;
+
+implementation
+
+uses
+  LCLType;
+
+function InitializeKeyInput: TKeyInput;
+begin
+  Result := TCarbonKeyInput.Create;
+end;
+
+procedure SendKeyInput(Key: Word; Down: Boolean);
+var
+  Char: Word;
+begin
+  Char := 0;
+  if Key in [VK_A .. VK_Z] then
+  begin
+    Char := Ord('A') + Key - VK_A;
+    Key := 0;
+  end;
+  if Key in [VK_0 .. VK_9] then
+  begin
+    Key := VK_NUMPAD0 + Key - VK_0;
+  end;
+  CGPostKeyboardEvent(Char, VirtualKeyCodeToMac(Key), Integer(Down));
+end;
+
+{ TCarbonKeyInput }
+
+procedure TCarbonKeyInput.DoDown(Key: Word);
+begin
+  SendKeyInput(Key, True);
+end;
+
+procedure TCarbonKeyInput.DoUp(Key: Word);
+begin
+  SendKeyInput(Key, False);
+end;
+
+end.
+

+ 72 - 0
mouseandkeyinput/carbonmouseinput.pas

@@ -0,0 +1,72 @@
+{ CarbonMouseInput
+
+  Copyright (C) 2008 Tom Gregorovic
+
+  This source is free software; you can redistribute it and/or modify it under the terms of the
+  GNU General Public License as published by the Free Software Foundation; either version 2 of the
+  License, or (at your option) any later version.
+
+  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+  General Public License for more details.
+
+  A copy of the GNU General Public License is available on the World Wide Web at
+  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
+  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit CarbonMouseInput;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Forms,
+  MacOSAll, CarbonProc,
+  MouseInputIntf;
+  
+type
+
+  { TCarbonMouseInput }
+
+  TCarbonMouseInput = class(TMouseInput)
+  protected
+    procedure DoDown(Button: TMouseButton); override;
+    procedure DoMove(ScreenX, ScreenY: Integer); override;
+    procedure DoUp(Button: TMouseButton); override;
+  end;
+  
+function InitializeMouseInput: TMouseInput;
+
+
+implementation
+
+function InitializeMouseInput: TMouseInput;
+begin
+  Result := TCarbonMouseInput.Create;
+end;
+
+const
+  MouseButtonToCarbonButton: array [TMouseButton] of Integer =
+    (kCGMouseButtonLeft, kCGMouseButtonRight, kCGMouseButtonCenter,kCGMouseButtonLeft,kCGMouseButtonLeft);
+  
+
+{ TCarbonMouseInput }
+
+procedure TCarbonMouseInput.DoDown(Button: TMouseButton);
+begin
+  CGPostMouseEvent(PointToHIPoint(Mouse.CursorPos), 0, 1, 1, MouseButtonToCarbonButton[Button]);
+end;
+
+procedure TCarbonMouseInput.DoMove(ScreenX, ScreenY: Integer);
+begin
+  CGPostMouseEvent(GetHIPoint(ScreenX, ScreenY), 1, 1, 0, 0);
+end;
+
+procedure TCarbonMouseInput.DoUp(Button: TMouseButton);
+begin
+  CGPostMouseEvent(PointToHIPoint(Mouse.CursorPos), 0, 1, 0, MouseButtonToCarbonButton[Button]);
+end;
+
+end.
+

+ 94 - 0
mouseandkeyinput/keyinputintf.pas

@@ -0,0 +1,94 @@
+{ KeyInputIntf
+
+  Copyright (C) 2008 Tom Gregorovic
+
+  This source is free software; you can redistribute it and/or modify it under the terms of the
+  GNU General Public License as published by the Free Software Foundation; either version 2 of the
+  License, or (at your option) any later version.
+
+  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+  General Public License for more details.
+
+  A copy of the GNU General Public License is available on the World Wide Web at
+  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
+  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit KeyInputIntf;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms;
+  
+type
+  { TKeyInput }
+
+  TKeyInput = class
+  protected
+    procedure DoDown(Key: Word); dynamic; abstract;
+    procedure DoUp(Key: Word); dynamic; abstract;
+  public
+    procedure Down(Key: Word);
+    procedure Up(Key: Word);
+    
+    procedure Press(Key: Word);
+    procedure Press(StringValue : String);
+    
+    procedure Apply(Shift: TShiftState);
+    procedure Unapply(Shift: TShiftState);
+  end;
+
+implementation
+
+uses LCLType;
+
+{ TKeyInput }
+
+procedure TKeyInput.Down(Key: Word);
+begin  DoDown(Key);
+  Application.ProcessMessages;
+end;
+
+procedure TKeyInput.Up(Key: Word);
+begin
+  DoUp(Key);
+  Application.ProcessMessages;
+end;
+
+procedure TKeyInput.Press(Key: Word);
+begin
+  Down(Key);
+  Up(Key);
+end;
+
+procedure TKeyInput.Press(StringValue: String);
+var
+  i : Integer;
+begin
+  i :=1;
+  while (i <= Length(StringValue)) do
+    begin
+      Press(Ord(StringValue[i]));
+      Inc(i);
+    end;
+end;
+
+procedure TKeyInput.Apply(Shift: TShiftState);
+begin
+  if ssCtrl in Shift then Down(VK_CONTROL);
+  if ssAlt in Shift then Down(VK_MENU);
+  if ssShift in Shift then Down(VK_SHIFT);
+end;
+
+procedure TKeyInput.Unapply(Shift: TShiftState);
+begin
+  if ssShift in Shift then Up(VK_SHIFT);
+  if ssCtrl in Shift then Up(VK_CONTROL);
+  if ssAlt in Shift then Up(VK_MENU);
+end;
+
+end.
+

+ 88 - 0
mouseandkeyinput/lazmouseandkeyinput.lpk

@@ -0,0 +1,88 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="3">
+    <PathDelim Value="\"/>
+    <Name Value="LazMouseAndKeyInput"/>
+    <Author Value="Tom Gregorovic"/>
+    <CompilerOptions>
+      <Version Value="5"/>
+      <PathDelim Value="\"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <CodeGeneration>
+        <Generate Value="Faster"/>
+      </CodeGeneration>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Description Value="Tool for cross-platform manipulation with mouse and key input.
+"/>
+    <License Value="GPL
+"/>
+    <Version Minor="1"/>
+    <Files Count="9">
+      <Item1>
+        <Filename Value="carbonkeyinput.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="CarbonKeyInput"/>
+      </Item1>
+      <Item2>
+        <Filename Value="carbonmouseinput.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="CarbonMouseInput"/>
+      </Item2>
+      <Item3>
+        <Filename Value="keyinputintf.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="KeyInputIntf"/>
+      </Item3>
+      <Item4>
+        <Filename Value="mouseandkeyinput.pas"/>
+        <UnitName Value="MouseAndKeyInput"/>
+      </Item4>
+      <Item5>
+        <Filename Value="mouseinputintf.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="MouseInputIntf"/>
+      </Item5>
+      <Item6>
+        <Filename Value="winkeyinput.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="WinKeyInput"/>
+      </Item6>
+      <Item7>
+        <Filename Value="winmouseinput.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="WinMouseInput"/>
+      </Item7>
+      <Item8>
+        <Filename Value="xkeyinput.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="XKeyInput"/>
+      </Item8>
+      <Item9>
+        <Filename Value="xmouseinput.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="XMouseInput"/>
+      </Item9>
+    </Files>
+    <RequiredPkgs Count="2">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item2>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)\"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

+ 15 - 0
mouseandkeyinput/lazmouseandkeyinput.pas

@@ -0,0 +1,15 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit LazMouseAndKeyInput;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+  MouseAndKeyInput;
+
+implementation
+
+end.

+ 61 - 0
mouseandkeyinput/mouseandkeyinput.pas

@@ -0,0 +1,61 @@
+{ MouseAndKeyInput
+
+  Copyright (C) 2008 Tom Gregorovic
+
+  This source is free software; you can redistribute it and/or modify it under the terms of the
+  GNU General Public License as published by the Free Software Foundation; either version 2 of the
+  License, or (at your option) any later version.
+
+  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+  General Public License for more details.
+
+  A copy of the GNU General Public License is available on the World Wide Web at
+  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
+  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit MouseAndKeyInput;
+
+interface
+
+uses
+  MouseInputIntf,
+  KeyInputIntf,
+  {$IFDEF WINDOWS}
+  WinMouseInput,
+  WinKeyInput,
+  {$ENDIF}
+  {$IFDEF UNIX}
+    {$IFDEF LCLcarbon}
+    CarbonMouseInput,
+    CarbonKeyInput,
+    {$ELSE}
+    XMouseInput,
+    XKeyInput,
+    {$ENDIF}
+  {$ENDIF}
+  Classes, SysUtils;
+
+var
+  MouseInput: TMouseInput;
+  KeyInput: TKeyInput;
+
+implementation
+
+
+
+initialization
+
+  // Create platform specific object for mouse input
+  MouseInput := InitializeMouseInput;
+
+  // Create platform specific object for key input
+  KeyInput := InitializeKeyInput;
+
+finalization
+
+  FreeAndNil(MouseInput);
+  FreeAndNil(KeyInput);
+
+
+end.

+ 285 - 0
mouseandkeyinput/mouseinputintf.pas

@@ -0,0 +1,285 @@
+{ MouseInputIntf
+
+  Copyright (C) 2008 Tom Gregorovic
+
+  This source is free software; you can redistribute it and/or modify it under the terms of the
+  GNU General Public License as published by the Free Software Foundation; either version 2 of the
+  License, or (at your option) any later version.
+
+  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+  General Public License for more details.
+
+  A copy of the GNU General Public License is available on the World Wide Web at
+  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
+  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit MouseInputIntf;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Forms;
+  
+type
+  { TMouseInput }
+
+  TMouseInput = class
+  protected
+    procedure DoDown(Button: TMouseButton); dynamic; abstract;
+    procedure DoMove(ScreenX, ScreenY: Integer); dynamic; abstract;
+    procedure DoUp(Button: TMouseButton); dynamic; abstract;
+    procedure DoScrollUp; dynamic; abstract;
+    procedure DoScrollDown; dynamic; abstract;
+  public
+    procedure Down(Button: TMouseButton; Shift: TShiftState);
+    procedure Down(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
+    procedure Down(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
+    
+    procedure Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0);
+    procedure MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0);
+    procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer);
+    procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer);
+
+    procedure ScrollUp(Shift: TShiftState);
+    procedure ScrollUp(Shift: TShiftState; Control: TControl; X, Y: Integer);
+    procedure ScrollUp(Shift: TShiftState; ScreenX, ScreenY: Integer);
+    procedure ScrollDown(Shift: TShiftState);
+    procedure ScrollDown(Shift: TShiftState; Control: TControl; X, Y: Integer);
+    procedure ScrollDown(Shift: TShiftState; ScreenX, ScreenY: Integer);
+
+    procedure Up(Button: TMouseButton; Shift: TShiftState);
+    procedure Up(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
+    procedure Up(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
+    
+    procedure Click(Button: TMouseButton; Shift: TShiftState);
+    procedure Click(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
+    procedure Click(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
+    
+    procedure DblClick(Button: TMouseButton; Shift: TShiftState);
+    procedure DblClick(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
+    procedure DblClick(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
+  end;
+
+implementation
+
+uses
+  Math, MouseAndKeyInput;
+
+{ TMouseInput }
+
+procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState);
+begin
+  KeyInput.Apply(Shift);
+  try
+    DoDown(Button);
+  finally
+    KeyInput.Unapply(Shift);
+  end;
+  Application.ProcessMessages;
+end;
+
+procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState;
+  Control: TControl; X, Y: Integer);
+var
+  P: TPoint;
+begin
+  P := Control.ClientToScreen(Point(X, Y));
+  Down(Button, Shift, P.X, P.Y);
+end;
+
+procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState;
+  ScreenX, ScreenY: Integer);
+begin
+  KeyInput.Apply(Shift);
+  try
+    DoMove(ScreenX, ScreenY);
+    DoDown(Button);
+  finally
+    KeyInput.Unapply(Shift);
+  end;
+end;
+
+procedure TMouseInput.Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0);
+var
+  P: TPoint;
+begin
+  P := Control.ClientToScreen(Point(X, Y));
+  Move(Shift, P.X, P.Y, Duration);
+end;
+
+procedure TMouseInput.MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0);
+var
+  P: TPoint;
+begin
+  P := Mouse.CursorPos;
+  Move(Shift, P.X + DX, P.Y + DY, Duration);
+end;
+
+procedure TMouseInput.Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer);
+const
+  Interval = 20; //ms
+var
+  TimeStep: Integer;
+  X, Y: Integer;
+  Start: TPoint;
+  S: LongWord;
+begin
+  Start := Mouse.CursorPos;
+  
+  while Duration > 0 do
+  begin
+    TimeStep := Min(Interval, Duration);
+
+    S := GetTickCount;
+    while GetTickCount - S < TimeStep do Application.ProcessMessages;
+    
+    X := Start.X + ((ScreenX - Start.X) * TimeStep) div Duration;
+    Y := Start.Y + ((ScreenY - Start.Y) * TimeStep) div Duration;
+    Move(Shift, X, Y);
+
+    Duration := Duration - TimeStep;
+    Start := Point(X, Y);
+  end;
+  
+  Move(Shift, ScreenX, ScreenY);
+end;
+
+procedure TMouseInput.Move(Shift: TShiftState; ScreenX, ScreenY: Integer);
+begin
+  KeyInput.Apply(Shift);
+  try
+    DoMove(ScreenX, ScreenY);
+  finally
+    KeyInput.Unapply(Shift);
+  end;
+  Application.ProcessMessages;
+end;
+
+procedure TMouseInput.ScrollUp(Shift: TShiftState);
+begin
+  KeyInput.Apply(Shift);
+  try
+    DoScrollUp;
+  finally
+    KeyInput.Unapply(Shift);
+  end;
+  Application.ProcessMessages;
+end;
+
+procedure TMouseInput.ScrollUp(Shift: TShiftState; Control: TControl;
+  X, Y: Integer);
+var
+  P: TPoint;
+begin
+  P := Control.ClientToScreen(Point(X, Y));
+  ScrollUp(Shift, P.X, P.Y);
+end;
+
+procedure TMouseInput.ScrollUp(Shift: TShiftState; ScreenX, ScreenY: Integer);
+begin
+  Move(Shift, ScreenX, ScreenY);
+  ScrollUp(Shift);
+end;
+
+procedure TMouseInput.ScrollDown(Shift: TShiftState);
+begin
+  KeyInput.Apply(Shift);
+  try
+    DoScrollDown;
+  finally
+    KeyInput.Unapply(Shift);
+  end;
+  Application.ProcessMessages;
+end;
+
+procedure TMouseInput.ScrollDown(Shift: TShiftState; Control: TControl;
+  X, Y: Integer);
+var
+  P: TPoint;
+begin
+  P := Control.ClientToScreen(Point(X, Y));
+  ScrollDown(Shift, P.X, P.Y);
+end;
+
+procedure TMouseInput.ScrollDown(Shift: TShiftState; ScreenX, ScreenY: Integer);
+begin
+  Move(Shift, ScreenX, ScreenY);
+  ScrollDown(Shift);
+end;
+
+procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState);
+begin
+  KeyInput.Apply(Shift);
+  try
+    DoUp(Button);
+  finally
+    KeyInput.Unapply(Shift);
+  end;
+  Application.ProcessMessages;
+end;
+
+procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState;
+  Control: TControl; X, Y: Integer);
+var
+  P: TPoint;
+begin
+  P := Control.ClientToScreen(Point(X, Y));
+  Up(Button, Shift, P.X, P.Y);
+end;
+
+procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState;
+  ScreenX, ScreenY: Integer);
+begin
+  Move(Shift, ScreenX, ScreenY);
+  Up(Button, Shift);
+end;
+
+procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState);
+begin
+  Down(Button, Shift);
+  Up(Button, Shift);
+end;
+
+procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState;
+  Control: TControl; X, Y: Integer);
+var
+  P: TPoint;
+begin
+  P := Control.ClientToScreen(Point(X, Y));
+  Click(Button, Shift, P.X, P.Y);
+end;
+
+procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState;
+  ScreenX, ScreenY: Integer);
+begin
+  Move(Shift, ScreenX, ScreenY);
+  Click(Button, Shift);
+end;
+
+procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState);
+begin
+  Click(Button, Shift);
+  Click(Button, Shift);
+end;
+
+procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState;
+  Control: TControl; X, Y: Integer);
+var
+  P: TPoint;
+begin
+  P := Control.ClientToScreen(Point(X, Y));
+  DblClick(Button, Shift, P.X, P.Y);
+end;
+
+procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState;
+  ScreenX, ScreenY: Integer);
+begin
+  Move(Shift, ScreenX, ScreenY);
+  DblClick(Button, Shift);
+end;
+
+end.
+

+ 21 - 0
mouseandkeyinput/readme.txt

@@ -0,0 +1,21 @@
+MouseAndKeyInput package is a tool for cross-platform manipulation with mouse and key input. You can move mouse cursor to specified location, send clicks and do key presses. It is suitable for GUI testing or program control demonstration.
+
+Author
+Tom Gregorovic
+
+License
+GPL
+
+Change Log
+* Version 0.1 
+
+Restrictions
+* it is not recommended calling mouse and key input directly from events like OnClick, use Application.QueueAsyncCall instead
+* do not forget to set back mouse button and key state after Down method with Up method 
+
+ Carbon
+ * pressing alpha chars is not supported 
+
+ Gtk1/2
+ * needs Xtst library
+ * ALT key pressing is not supported 

+ 73 - 0
mouseandkeyinput/winkeyinput.pas

@@ -0,0 +1,73 @@
+{ WinKeyInput
+
+  Copyright (C) 2008 Tom Gregorovic
+
+  This source is free software; you can redistribute it and/or modify it under the terms of the
+  GNU General Public License as published by the Free Software Foundation; either version 2 of the
+  License, or (at your option) any later version.
+
+  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+  General Public License for more details.
+
+  A copy of the GNU General Public License is available on the World Wide Web at
+  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
+  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit WinKeyInput;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Forms,
+  Windows, JwaWinUser,
+  KeyInputIntf;
+  
+type
+
+  { TWinKeyInput }
+
+  TWinKeyInput = class(TKeyInput)
+  protected
+    procedure DoDown(Key: Word); override;
+    procedure DoUp(Key: Word); override;
+  end;
+  
+function InitializeKeyInput: TKeyInput;
+
+implementation
+
+function InitializeKeyInput: TKeyInput;
+begin
+  Result := TWinKeyInput.Create;
+end;
+
+procedure SendKeyInput(Flag: DWORD; Key: Word);
+var
+  Input: TInput;
+begin
+  FillChar(Input, SizeOf(Input), 0);
+  Input.type_ := INPUT_KEYBOARD;
+  Input.ki.dwFlags := Flag;
+  Input.ki.wVk := Key;
+
+  SendInput(1, @Input, SizeOf(Input));
+end;
+
+
+{ TWinKeyInput }
+
+procedure TWinKeyInput.DoDown(Key: Word);
+begin
+  SendKeyInput(0, Key);
+end;
+
+procedure TWinKeyInput.DoUp(Key: Word);
+begin
+  SendKeyInput(KEYEVENTF_KEYUP, Key);
+end;
+
+end.
+

+ 127 - 0
mouseandkeyinput/winmouseinput.pas

@@ -0,0 +1,127 @@
+{ WinMouseInput
+
+  Copyright (C) 2008 Tom Gregorovic
+
+  This source is free software; you can redistribute it and/or modify it under the terms of the
+  GNU General Public License as published by the Free Software Foundation; either version 2 of the
+  License, or (at your option) any later version.
+
+  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+  General Public License for more details.
+
+  A copy of the GNU General Public License is available on the World Wide Web at
+  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
+  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit WinMouseInput;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Forms,
+  Windows, JwaWinUser,
+  MouseInputIntf;
+  
+type
+
+  { TWinMouseInput }
+
+  TWinMouseInput = class(TMouseInput)
+  protected
+    procedure DoDown(Button: TMouseButton); override;
+    procedure DoMove(ScreenX, ScreenY: Integer); override;
+    procedure DoUp(Button: TMouseButton); override;
+    procedure DoScrollUp; override;
+    procedure DoScrollDown; override;
+  end;
+  
+function InitializeMouseInput: TMouseInput;
+
+implementation
+
+function InitializeMouseInput: TMouseInput;
+begin
+  Result := TWinMouseInput.Create;
+end;
+
+procedure SendMouseInput(Flag: DWORD; MouseData: DWORD = 0);
+var
+  Input: TInput;
+begin
+{$IFDEF VER2_6}
+  FillChar(Input, SizeOf(Input), 0);
+{$ELSE}
+  Input := Default(TInput);
+{$ENDIF}
+  Input.mi.mouseData := MouseData;
+  Input.type_ := INPUT_MOUSE;
+  Input.mi.dwFlags := Flag;
+
+  SendInput(1, @Input, SizeOf(Input));
+end;
+
+procedure SendMouseInput(Flag: DWORD; X, Y: Integer);
+var
+  Input: TInput;
+begin
+{$IFDEF VER2_6}
+  FillChar(Input, SizeOf(Input), 0);
+{$ELSE}
+  Input := Default(TInput);
+{$ENDIF}
+  Input.type_ := INPUT_MOUSE;
+  Input.mi.dx := MulDiv(X, 65535, Screen.Width - 1); // screen horizontal coordinates: 0 - 65535
+  Input.mi.dy := MulDiv(Y, 65535, Screen.Height - 1); // screen vertical coordinates: 0 - 65535
+  Input.mi.dwFlags := Flag or MOUSEEVENTF_ABSOLUTE;
+
+  SendInput(1, @Input, SizeOf(Input));
+end;
+
+{ TWinMouseInput }
+
+procedure TWinMouseInput.DoDown(Button: TMouseButton);
+var
+  Flag: DWORD;
+begin
+  case Button of
+    mbRight: Flag := MOUSEEVENTF_RIGHTDOWN;
+    mbMiddle: Flag := MOUSEEVENTF_MIDDLEDOWN;
+  else
+    Flag := MOUSEEVENTF_LEFTDOWN;
+  end;
+  SendMouseInput(Flag);
+end;
+
+procedure TWinMouseInput.DoMove(ScreenX, ScreenY: Integer);
+begin
+  SendMouseInput(MOUSEEVENTF_MOVE, ScreenX, ScreenY);
+end;
+
+procedure TWinMouseInput.DoUp(Button: TMouseButton);
+var
+  Flag: DWORD;
+begin
+  case Button of
+    mbRight: Flag := MOUSEEVENTF_RIGHTUP;
+    mbMiddle: Flag := MOUSEEVENTF_MIDDLEUP;
+  else
+    Flag := MOUSEEVENTF_LEFTUP;
+  end;
+  SendMouseInput(Flag);
+end;
+
+procedure TWinMouseInput.DoScrollUp;
+begin
+  SendMouseInput(MOUSEEVENTF_WHEEL, WHEEL_DELTA);
+end;
+
+procedure TWinMouseInput.DoScrollDown;
+begin
+  SendMouseInput(MOUSEEVENTF_WHEEL, DWORD(-WHEEL_DELTA));
+end;
+
+end.
+

+ 198 - 0
mouseandkeyinput/xkeyinput.pas

@@ -0,0 +1,198 @@
+{ XKeyInput
+
+  Copyright (C) 2008 Tom Gregorovic
+
+  This source is free software; you can redistribute it and/or modify it under the terms of the
+  GNU General Public License as published by the Free Software Foundation; either version 2 of the
+  License, or (at your option) any later version.
+
+  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+  General Public License for more details.
+
+  A copy of the GNU General Public License is available on the World Wide Web at
+  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
+  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit XKeyInput;
+
+{$mode objfpc}{$H+}
+{$linklib Xtst}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Forms,
+  X, XLib, KeySym,
+  KeyInputIntf;
+  
+type
+
+  { TXKeyInput }
+
+  TXKeyInput = class(TKeyInput)
+  protected
+    procedure DoDown(Key: Word); override;
+    procedure DoUp(Key: Word); override;
+  end;
+  
+function InitializeKeyInput: TKeyInput;
+
+function XTestFakeKeyEvent(dpy: PDisplay; keycode: dword; is_press: Boolean32;
+  delay: dword): longint; cdecl; external;
+
+implementation
+
+uses LCLType;
+
+function InitializeKeyInput: TKeyInput;
+begin
+  Result := TXKeyInput.Create;
+end;
+
+function VirtualKeyToXKeySym(Key: Word): TKeySym;
+begin
+  case Key of
+    VK_BACK: Result := XK_BackSpace;
+    VK_TAB: Result := XK_Tab;
+    VK_CLEAR: Result := XK_Clear;
+    VK_RETURN: Result := XK_Return;
+    VK_SHIFT: Result := XK_Shift_L;
+    VK_CONTROL: Result := XK_Control_L;
+    VK_MENU: Result := XK_VoidSymbol; // alt key crashes app, XK_Alt_R;
+    VK_CAPITAL: Result := XK_Caps_Lock;
+
+    VK_ESCAPE: Result := XK_Escape;
+    VK_SPACE: Result := XK_space;
+    VK_PRIOR: Result := XK_Prior;
+    VK_NEXT: Result := XK_Next;
+    VK_END: Result := XK_End;
+    VK_HOME: Result := XK_Home;
+    VK_LEFT: Result := XK_Left;
+    VK_UP: Result := XK_Up;
+    VK_RIGHT: Result := XK_Right;
+    VK_DOWN: Result := XK_Down;
+    VK_SELECT: Result := XK_Select;
+    VK_PRINT: Result := XK_Print;
+    VK_EXECUTE: Result := XK_Execute;
+
+    VK_INSERT: Result := XK_Insert;
+    VK_DELETE: Result := XK_Delete;
+    VK_HELP: Result := XK_Help;
+    VK_0: Result := XK_0;
+    VK_1: Result := XK_1;
+    VK_2: Result := XK_2;
+    VK_3: Result := XK_3;
+    VK_4: Result := XK_4;
+    VK_5: Result := XK_5;
+    VK_6: Result := XK_6;
+    VK_7: Result := XK_7;
+    VK_8: Result := XK_8;
+    VK_9: Result := XK_9;
+
+    VK_A: Result := XK_a;
+    VK_B: Result := XK_b;
+    VK_C: Result := XK_c;
+    VK_D: Result := XK_d;
+    VK_E: Result := XK_e;
+    VK_F: Result := XK_f;
+    VK_G: Result := XK_g;
+    VK_H: Result := XK_h;
+    VK_I: Result := XK_i;
+    VK_J: Result := XK_j;
+    VK_K: Result := XK_k;
+    VK_L: Result := XK_l;
+    VK_M: Result := XK_m;
+    VK_N: Result := XK_n;
+    VK_O: Result := XK_o;
+    VK_P: Result := XK_p;
+    VK_Q: Result := XK_q;
+    VK_R: Result := XK_r;
+    VK_S: Result := XK_s;
+    VK_T: Result := XK_t;
+    VK_U: Result := XK_u;
+    VK_V: Result := XK_v;
+    VK_W: Result := XK_w;
+    VK_X: Result := XK_x;
+    VK_Y: Result := XK_y;
+    VK_Z: Result := XK_z;
+
+    VK_NUMPAD0: Result := XK_KP_0;
+    VK_NUMPAD1: Result := XK_KP_1;
+    VK_NUMPAD2: Result := XK_KP_2;
+    VK_NUMPAD3: Result := XK_KP_3;
+    VK_NUMPAD4: Result := XK_KP_4;
+    VK_NUMPAD5: Result := XK_KP_5;
+    VK_NUMPAD6: Result := XK_KP_6;
+    VK_NUMPAD7: Result := XK_KP_7;
+    VK_NUMPAD8: Result := XK_KP_8;
+    VK_NUMPAD9: Result := XK_KP_9;
+    VK_MULTIPLY: Result := XK_KP_Multiply;
+    VK_ADD: Result := XK_KP_Add;
+    VK_SEPARATOR: Result := XK_KP_Separator;
+    VK_SUBTRACT: Result := XK_KP_Subtract;
+    VK_DECIMAL: Result := XK_KP_Decimal;
+    VK_DIVIDE: Result := XK_KP_Divide;
+    VK_F1: Result := XK_F1;
+    VK_F2: Result := XK_F2;
+    VK_F3: Result := XK_F3;
+    VK_F4: Result := XK_F4;
+    VK_F5: Result := XK_F5;
+    VK_F6: Result := XK_F6;
+    VK_F7: Result := XK_F7;
+    VK_F8: Result := XK_F8;
+    VK_F9: Result := XK_F9;
+    VK_F10: Result := XK_F10;
+    VK_F11: Result := XK_F11;
+    VK_F12: Result := XK_F12;
+    VK_F13: Result := XK_F13;
+    VK_F14: Result := XK_F14;
+    VK_F15: Result := XK_F15;
+    VK_F16: Result := XK_F16;
+    VK_F17: Result := XK_F17;
+    VK_F18: Result := XK_F18;
+    VK_F19: Result := XK_F19;
+    VK_F20: Result := XK_F20;
+    VK_F21: Result := XK_F21;
+    VK_F22: Result := XK_F22;
+    VK_F23: Result := XK_F23;
+    VK_F24: Result := XK_F24;
+    VK_NUMLOCK: Result := XK_Num_Lock;
+    VK_SCROLL: Result := XK_Scroll_Lock;
+  else
+    Result := XK_VoidSymbol;
+  end;
+end;
+
+{ TXKeyInput }
+
+procedure TXKeyInput.DoDown(Key: Word);
+var
+  Display: PDisplay;
+  KeySym: TKeySym;
+begin
+  KeySym := VirtualKeyToXKeySym(Key);
+  if KeySym = XK_VoidSymbol then Exit;
+  
+  Display := XOpenDisplay(nil);
+  XTestFakeKeyEvent(Display, XKeysymToKeycode(Display, KeySym), True, 0);
+  XFlush(Display);
+  XCloseDisplay(Display);
+end;
+
+procedure TXKeyInput.DoUp(Key: Word);
+var
+  Display: PDisplay;
+  KeySym: TKeySym;
+begin
+  KeySym := VirtualKeyToXKeySym(Key);
+  if KeySym = XK_VoidSymbol then Exit;
+  
+  Display := XOpenDisplay(nil);
+  XTestFakeKeyEvent(Display, XKeysymToKeycode(Display, KeySym), False, 0);
+  XFlush(Display);
+  XCloseDisplay(Display);
+end;
+
+end.
+

+ 114 - 0
mouseandkeyinput/xmouseinput.pas

@@ -0,0 +1,114 @@
+{ XMouseInput
+
+  Copyright (C) 2008 Tom Gregorovic
+
+  This source is free software; you can redistribute it and/or modify it under the terms of the
+  GNU General Public License as published by the Free Software Foundation; either version 2 of the
+  License, or (at your option) any later version.
+
+  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
+  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+  General Public License for more details.
+
+  A copy of the GNU General Public License is available on the World Wide Web at
+  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
+  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit XMouseInput;
+
+{$mode objfpc}{$H+}
+{$linklib Xtst}
+
+interface
+
+uses
+  Classes, SysUtils, Controls, Forms,
+  XLib, MouseInputIntf;
+  
+type
+
+  { TXMouseInput }
+
+  TXMouseInput = class(TMouseInput)
+  protected
+    procedure DoDown(Button: TMouseButton); override;
+    procedure DoMove(ScreenX, ScreenY: Integer); override;
+    procedure DoUp(Button: TMouseButton); override;
+    procedure DoScrollUp; override;
+    procedure DoScrollDown; override;
+  end;
+  
+function InitializeMouseInput: TMouseInput;
+
+function XTestFakeButtonEvent(dpy: PDisplay; button: dword; is_press: Boolean;
+  delay: dword): longint; cdecl; external;
+
+function XTestFakeMotionEvent(dpy: PDisplay; screen: longint; x: longint; y: longint;
+  delay: dword): longint; cdecl; external;
+
+implementation
+
+function InitializeMouseInput: TMouseInput;
+begin
+  Result := TXMouseInput.Create;
+end;
+
+const
+  MouseButtonToXButton: array [TMouseButton] of Integer = (1, 3, 2, 4, 5);
+
+{ TXMouseInput }
+
+procedure TXMouseInput.DoDown(Button: TMouseButton);
+var
+  Display: PDisplay;
+begin
+  Display := XOpenDisplay(nil);
+  XTestFakeButtonEvent(Display, MouseButtonToXButton[Button], True, 0);
+  XFlush(Display);
+  XCloseDisplay(Display);
+end;
+
+procedure TXMouseInput.DoMove(ScreenX, ScreenY: Integer);
+var
+  Display: PDisplay;
+begin
+  Display := XOpenDisplay(nil);
+  XTestFakeMotionEvent(Display, 0, ScreenX, ScreenY, 0);
+  XFlush(Display);
+  XCloseDisplay(Display);
+end;
+
+procedure TXMouseInput.DoUp(Button: TMouseButton);
+var
+  Display: PDisplay;
+begin
+  Display := XOpenDisplay(nil);
+  XTestFakeButtonEvent(Display, MouseButtonToXButton[Button], False, 0);
+  XFlush(Display);
+  XCloseDisplay(Display);
+end;
+
+procedure TXMouseInput.DoScrollUp;
+var
+  Display: PDisplay;
+begin
+  Display := XOpenDisplay(nil);
+  XTestFakeButtonEvent(Display, 4, True, 0);
+  XTestFakeButtonEvent(Display, 4, False, 0);
+  XFlush(Display);
+  XCloseDisplay(Display);
+end;
+
+procedure TXMouseInput.DoScrollDown;
+var
+  Display: PDisplay;
+begin
+  Display := XOpenDisplay(nil);
+  XTestFakeButtonEvent(Display, 5, True, 0);
+  XTestFakeButtonEvent(Display, 5, False, 0);
+  XFlush(Display);
+  XCloseDisplay(Display);
+end;
+
+end.
+

+ 150 - 0
test/test_bcrealnumerickeyboard/test_bcnumerickeyboard.lpi

@@ -0,0 +1,150 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="BC Numeric Keyboard"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+    </General>
+    <BuildModes Count="3">
+      <Item1 Name="Default" Default="True"/>
+      <Item2 Name="Debug">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="test_bcnumerickeyboard"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <IncludeAssertionCode Value="True"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <Checks>
+              <IOChecks Value="True"/>
+              <RangeChecks Value="True"/>
+              <OverflowChecks Value="True"/>
+              <StackChecks Value="True"/>
+            </Checks>
+            <VerifyObjMethodCallValidity Value="True"/>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <DebugInfoType Value="dsDwarf2Set"/>
+              <UseHeaptrc Value="True"/>
+              <TrashVariables Value="True"/>
+              <UseExternalDbgSyms Value="True"/>
+            </Debugging>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item2>
+      <Item3 Name="Release">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="test_bcnumerickeyboard"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item3>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="bgracontrols"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="test_bcnumerickeyboard.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="umain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="test_bcnumerickeyboard"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 22 - 0
test/test_bcrealnumerickeyboard/test_bcnumerickeyboard.lpr

@@ -0,0 +1,22 @@
+program test_bcnumerickeyboard;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, umain
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  Application.Title:='BC Numeric Keyboard';
+  RequireDerivedFormResource:=True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

+ 100 - 0
test/test_bcrealnumerickeyboard/umain.lfm

@@ -0,0 +1,100 @@
+object Form1: TForm1
+  Left = 442
+  Height = 240
+  Top = 143
+  Width = 516
+  Caption = 'BC Real Numeric Keyboard'
+  ClientHeight = 240
+  ClientWidth = 516
+  OnCreate = FormCreate
+  LCLVersion = '1.7'
+  object BCPanel1: TBCPanel
+    Left = 0
+    Height = 240
+    Top = 0
+    Width = 516
+    Align = alClient
+    Background.Color = clBtnFace
+    Background.ColorOpacity = 255
+    Background.Gradient1.StartColor = clWhite
+    Background.Gradient1.StartColorOpacity = 255
+    Background.Gradient1.DrawMode = dmSet
+    Background.Gradient1.EndColor = 16119285
+    Background.Gradient1.EndColorOpacity = 255
+    Background.Gradient1.ColorCorrection = True
+    Background.Gradient1.GradientType = gtLinear
+    Background.Gradient1.Point1XPercent = 0
+    Background.Gradient1.Point1YPercent = 0
+    Background.Gradient1.Point2XPercent = 0
+    Background.Gradient1.Point2YPercent = 100
+    Background.Gradient1.Sinus = False
+    Background.Gradient2.StartColor = 15722194
+    Background.Gradient2.StartColorOpacity = 255
+    Background.Gradient2.DrawMode = dmSet
+    Background.Gradient2.EndColor = 13137169
+    Background.Gradient2.EndColorOpacity = 255
+    Background.Gradient2.ColorCorrection = True
+    Background.Gradient2.GradientType = gtLinear
+    Background.Gradient2.Point1XPercent = 0
+    Background.Gradient2.Point1YPercent = 0
+    Background.Gradient2.Point2XPercent = 0
+    Background.Gradient2.Point2YPercent = 100
+    Background.Gradient2.Sinus = False
+    Background.Gradient1EndPercent = 100
+    Background.Style = bbsGradient
+    BevelInner = bvNone
+    BevelOuter = bvNone
+    BevelWidth = 1
+    Border.Color = clBlack
+    Border.ColorOpacity = 255
+    Border.LightColor = clWhite
+    Border.LightOpacity = 255
+    Border.LightWidth = 0
+    Border.Style = bboNone
+    Border.Width = 1
+    BorderBCStyle = bpsBorder
+    FontEx.Color = clDefault
+    FontEx.EndEllipsis = False
+    FontEx.FontQuality = fqSystemClearType
+    FontEx.Height = 0
+    FontEx.SingleLine = True
+    FontEx.Shadow = False
+    FontEx.ShadowColor = clBlack
+    FontEx.ShadowColorOpacity = 255
+    FontEx.ShadowRadius = 5
+    FontEx.ShadowOffsetX = 5
+    FontEx.ShadowOffsetY = 5
+    FontEx.Style = []
+    FontEx.TextAlignment = bcaCenter
+    FontEx.WordBreak = False
+    Rounding.RoundX = 1
+    Rounding.RoundY = 1
+    Rounding.RoundOptions = []
+    TabOrder = 0
+    OnClick = FormClick
+    object FloatSpinEdit1: TFloatSpinEdit
+      Left = 8
+      Height = 28
+      Top = 8
+      Width = 76
+      Increment = 1
+      MaxValue = 100000
+      MinValue = 0
+      OnClick = Button1Click
+      TabOrder = 0
+      Value = 0
+    end
+    object Edit1: TEdit
+      Left = 96
+      Height = 28
+      Top = 8
+      Width = 80
+      OnClick = Button1Click
+      TabOrder = 1
+    end
+  end
+  object BCRealNumericKeyboard1: TBCRealNumericKeyboard
+    left = 128
+    top = 136
+  end
+end

+ 131 - 0
test/test_bcrealnumerickeyboard/umain.pas

@@ -0,0 +1,131 @@
+unit umain;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  Spin, BCNumericKeyboard, BCButton, BCTypes, BCPanel, BGRABitmapTypes;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    BCPanel1: TBCPanel;
+    BCRealNumericKeyboard1: TBCRealNumericKeyboard;
+    Edit1: TEdit;
+    FloatSpinEdit1: TFloatSpinEdit;
+    procedure Button1Click(Sender: TObject);
+    procedure FormClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    NumericSender: TControl;
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+{ Button style }
+procedure BCButtonWindows8(AButton: TBCButton; cl1, cl2: TColor);
+begin
+  AButton.Rounding.RoundX := 1;
+  AButton.Rounding.RoundY := 1;
+  AButton.RoundingDropDown.Assign(AButton.Rounding);
+
+  with AButton.StateNormal do
+  begin
+    Background.Style := bbsColor;
+    Background.Color := cl1;
+    Border.Style := bboSolid;
+    Border.Width := 1;
+    Border.Color := cl1;
+    Border.LightWidth := 0;
+    Border.LightOpacity := 255;
+    Border.Style := bboSolid;
+    FontEx.Color := clWhite;
+    FontEx.Shadow := False;
+    FontEx.Style := [];
+  end;
+
+  AButton.StateHover.Assign(AButton.StateNormal);
+  AButton.StateClicked.Assign(AButton.StateNormal);
+
+  with AButton.StateHover do
+  begin
+    Background.Color := cl2;
+    Border.Color := cl2;
+  end;
+
+  with AButton.StateClicked do
+  begin
+    Background.Color := cl2;
+    Border.Color := cl2;
+  end;
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  if (NumericSender <> nil) and (NumericSender.Name = TControl(Sender).Name) and
+    (BCRealNumericKeyboard1.Visible) then
+  begin
+    BCRealNumericKeyboard1.Hide();
+  end
+  else
+  begin
+    NumericSender := Sender as TControl;
+    BCRealNumericKeyboard1.Panel.Left := NumericSender.Left;
+    BCRealNumericKeyboard1.Panel.Top := NumericSender.Top + NumericSender.Height;
+    BCRealNumericKeyboard1.Show();
+  end;
+end;
+
+procedure TForm1.FormClick(Sender: TObject);
+begin
+  Button1Click(NumericSender);
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  // Assign custom format settings
+  DefaultFormatSettings.CurrencyString := '$';
+  // DefaultFormatSettings.DecimalSeparator := '.';
+
+  // Assign a style
+  BCButtonWindows8(BCRealNumericKeyboard1.ButtonStyle, clGray, clSkyBlue);
+  // Custom extra size inside the button
+  BCRealNumericKeyboard1.ButtonStyle.SetSizeVariables(0, 0, 15, 25);
+  // Apply the style
+  BCRealNumericKeyboard1.UpdateButtonStyle;
+
+  with BCRealNumericKeyboard1.Panel do
+  begin
+    BevelInner := bvNone;
+    BevelOuter := bvNone;
+    Background.Gradient1.StartColor := clNavy;
+    Background.Gradient1.EndColor := clPurple;
+    Background.Gradient1.Point1XPercent := 0;
+    Background.Gradient1.Point1YPercent := 0;
+    Background.Gradient1.Point2XPercent := 0;
+    Background.Gradient1.Point2YPercent := 100;
+    Background.Gradient1EndPercent := 100;
+    Background.Style := bbsGradient;
+    // Spacing around
+    ChildSizing.TopBottomSpacing := 5;
+    ChildSizing.LeftRightSpacing := 5;
+    // Spacing between buttons
+    ChildSizing.VerticalSpacing := 10;
+    ChildSizing.HorizontalSpacing := 10;
+  end;
+end;
+
+end.