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