1 { MouseInputIntf
2 
3   Copyright (C) 2008 Tom Gregorovic
4 
5   This source is free software; you can redistribute it and/or modify it under the terms of the
6   GNU General Public License as published by the Free Software Foundation; either version 2 of the
7   License, or (at your option) any later version.
8 
9   This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
10   even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11   General Public License for more details.
12 
13   A copy of the GNU General Public License is available on the World Wide Web at
14   <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
15   Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
16 }
17 unit MouseInputIntf;
18 
19 {$mode objfpc}{$H+}
20 
21 interface
22 
23 uses
24   Classes, SysUtils, Controls, Forms;
25 
26 type
27   { TMouseInput }
28 
29   TMouseInput = class
30   protected
31     procedure DoDown(Button: TMouseButton); dynamic; abstract;
32     procedure DoMove(ScreenX, ScreenY: Integer); dynamic; abstract;
33     procedure DoUp(Button: TMouseButton); dynamic; abstract;
34     procedure DoScrollUp; dynamic; abstract;
35     procedure DoScrollDown; dynamic; abstract;
36   public
37     procedure Down(Button: TMouseButton; Shift: TShiftState);
38     procedure Down(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
39     procedure Down(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
40 
41     procedure Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0);
42     procedure MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0);
43     procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer);
44     procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer);
45 
46     procedure ScrollUp(Shift: TShiftState);
47     procedure ScrollUp(Shift: TShiftState; Control: TControl; X, Y: Integer);
48     procedure ScrollUp(Shift: TShiftState; ScreenX, ScreenY: Integer);
49     procedure ScrollDown(Shift: TShiftState);
50     procedure ScrollDown(Shift: TShiftState; Control: TControl; X, Y: Integer);
51     procedure ScrollDown(Shift: TShiftState; ScreenX, ScreenY: Integer);
52 
53     procedure Up(Button: TMouseButton; Shift: TShiftState);
54     procedure Up(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
55     procedure Up(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
56 
57     procedure Click(Button: TMouseButton; Shift: TShiftState);
58     procedure Click(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
59     procedure Click(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
60 
61     procedure DblClick(Button: TMouseButton; Shift: TShiftState);
62     procedure DblClick(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
63     procedure DblClick(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
64   end;
65 
66 implementation
67 
68 uses
69   Math, MouseAndKeyInput;
70 
71 { TMouseInput }
72 
73 procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState);
74 begin
75   KeyInput.Apply(Shift);
76   try
77     DoDown(Button);
78   finally
79     KeyInput.Unapply(Shift);
80   end;
81   Application.ProcessMessages;
82 end;
83 
84 procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState;
85   Control: TControl; X, Y: Integer);
86 var
87   P: TPoint;
88 begin
89   P := Control.ClientToScreen(Point(X, Y));
90   Down(Button, Shift, P.X, P.Y);
91 end;
92 
93 procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState;
94   ScreenX, ScreenY: Integer);
95 begin
96   KeyInput.Apply(Shift);
97   try
98     DoMove(ScreenX, ScreenY);
99     DoDown(Button);
100   finally
101     KeyInput.Unapply(Shift);
102   end;
103 end;
104 
105 procedure TMouseInput.Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0);
106 var
107   P: TPoint;
108 begin
109   P := Control.ClientToScreen(Point(X, Y));
110   Move(Shift, P.X, P.Y, Duration);
111 end;
112 
113 procedure TMouseInput.MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0);
114 var
115   P: TPoint;
116 begin
117   P := Mouse.CursorPos;
118   Move(Shift, P.X + DX, P.Y + DY, Duration);
119 end;
120 
121 procedure TMouseInput.Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer);
122 const
123   Interval = 20; //ms
124 var
125   TimeStep: Integer;
126   X, Y: Integer;
127   Start: TPoint;
128   S: QWord;
129 begin
130   Start := Mouse.CursorPos;
131 
132   while Duration > 0 do
133   begin
134     TimeStep := Min(Interval, Duration);
135 
136     S := GetTickCount64;
137     while GetTickCount64 - S < TimeStep do
138       Application.ProcessMessages;
139 
140     X := Start.X + ((ScreenX - Start.X) * TimeStep) div Duration;
141     Y := Start.Y + ((ScreenY - Start.Y) * TimeStep) div Duration;
142     Move(Shift, X, Y);
143 
144     Duration := Duration - TimeStep;
145     Start := Point(X, Y);
146   end;
147 
148   Move(Shift, ScreenX, ScreenY);
149 end;
150 
151 procedure TMouseInput.Move(Shift: TShiftState; ScreenX, ScreenY: Integer);
152 begin
153   KeyInput.Apply(Shift);
154   try
155     DoMove(ScreenX, ScreenY);
156   finally
157     KeyInput.Unapply(Shift);
158   end;
159   Application.ProcessMessages;
160 end;
161 
162 procedure TMouseInput.ScrollUp(Shift: TShiftState);
163 begin
164   KeyInput.Apply(Shift);
165   try
166     DoScrollUp;
167   finally
168     KeyInput.Unapply(Shift);
169   end;
170   Application.ProcessMessages;
171 end;
172 
173 procedure TMouseInput.ScrollUp(Shift: TShiftState; Control: TControl;
174   X, Y: Integer);
175 var
176   P: TPoint;
177 begin
178   P := Control.ClientToScreen(Point(X, Y));
179   ScrollUp(Shift, P.X, P.Y);
180 end;
181 
182 procedure TMouseInput.ScrollUp(Shift: TShiftState; ScreenX, ScreenY: Integer);
183 begin
184   Move(Shift, ScreenX, ScreenY);
185   ScrollUp(Shift);
186 end;
187 
188 procedure TMouseInput.ScrollDown(Shift: TShiftState);
189 begin
190   KeyInput.Apply(Shift);
191   try
192     DoScrollDown;
193   finally
194     KeyInput.Unapply(Shift);
195   end;
196   Application.ProcessMessages;
197 end;
198 
199 procedure TMouseInput.ScrollDown(Shift: TShiftState; Control: TControl;
200   X, Y: Integer);
201 var
202   P: TPoint;
203 begin
204   P := Control.ClientToScreen(Point(X, Y));
205   ScrollDown(Shift, P.X, P.Y);
206 end;
207 
208 procedure TMouseInput.ScrollDown(Shift: TShiftState; ScreenX, ScreenY: Integer);
209 begin
210   Move(Shift, ScreenX, ScreenY);
211   ScrollDown(Shift);
212 end;
213 
214 procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState);
215 begin
216   KeyInput.Apply(Shift);
217   try
218     DoUp(Button);
219   finally
220     KeyInput.Unapply(Shift);
221   end;
222   Application.ProcessMessages;
223 end;
224 
225 procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState;
226   Control: TControl; X, Y: Integer);
227 var
228   P: TPoint;
229 begin
230   P := Control.ClientToScreen(Point(X, Y));
231   Up(Button, Shift, P.X, P.Y);
232 end;
233 
234 procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState;
235   ScreenX, ScreenY: Integer);
236 begin
237   Move(Shift, ScreenX, ScreenY);
238   Up(Button, Shift);
239 end;
240 
241 procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState);
242 begin
243   Down(Button, Shift);
244   Up(Button, Shift);
245 end;
246 
247 procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState;
248   Control: TControl; X, Y: Integer);
249 var
250   P: TPoint;
251 begin
252   P := Control.ClientToScreen(Point(X, Y));
253   Click(Button, Shift, P.X, P.Y);
254 end;
255 
256 procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState;
257   ScreenX, ScreenY: Integer);
258 begin
259   Move(Shift, ScreenX, ScreenY);
260   Click(Button, Shift);
261 end;
262 
263 procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState);
264 begin
265   Click(Button, Shift);
266   Click(Button, Shift);
267 end;
268 
269 procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState;
270   Control: TControl; X, Y: Integer);
271 var
272   P: TPoint;
273 begin
274   P := Control.ClientToScreen(Point(X, Y));
275   DblClick(Button, Shift, P.X, P.Y);
276 end;
277 
278 procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState;
279   ScreenX, ScreenY: Integer);
280 begin
281   Move(Shift, ScreenX, ScreenY);
282   DblClick(Button, Shift);
283 end;
284 
285 end.
286 
287