Gesture.pas

   1 unit Gesture;
   2
   3 interface
   4
   5 uses
   6         Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   7         Dialogs, Math, StrUtils;
   8
   9 type
  10         TMouseGesture = class(TObject)
  11         private
  12                 FHook: Cardinal;
  13                 FHandle: THandle;
  14                 FGestureItemList: TStringList;
  15                 FBeginGesture: Boolean;
  16                 FCancelMode: Boolean;
  17                 FLastTime: Cardinal;
  18                 FStartPoint: TPoint;
  19                 FLastPoint: TPoint;
  20                 FMargin: Integer;
  21                 FOnGestureStart: TNotifyEvent;
  22                 FOnGestureMove: TNotifyEvent;
  23                 FOnGestureEnd: TNotifyEvent;
  24                 function GetGestureCount: Integer;
  25                 function CheckAction(Message: Integer; x, y: Integer): Boolean;
  26                 procedure AddAction(sx, sy: Integer);
  27                 function AddGesture(Item: string): Integer;
  28                 function Get(Index: integer): string;
  29                 procedure Put(Index: integer; Item: string);
  30         public
  31                 constructor Create;
  32                 destructor Destroy; override;
  33                 procedure SetHook(hWnd: THandle);
  34                 procedure UnHook;
  35                 property Items[Index: Integer]: string read Get write Put; default;
  36                 property GestureCount: Integer read GetGestureCount;
  37                 property Margin: Integer read FMargin write FMargin;
  38                 function GetGestureStr: string;
  39                 procedure Clear;
  40                 property OnGestureStart: TNotifyEvent read FOnGestureStart write FOnGestureStart;
  41                 property OnGestureMove: TNotifyEvent read FOnGestureMove write FOnGestureMove;
  42                 property OnGestureEnd: TNotifyEvent read FOnGestureEnd write FOnGestureEnd;
  43         end;
  44
  45         function GestureProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  46
  47 var
  48         MouseGesture: TMouseGesture;
  49
  50 implementation
  51
  52 uses
  53         GikoSystem;
  54
  55 constructor TMouseGesture.Create;
  56 begin
  57         inherited;
  58         FHook := 0;
  59         FCancelMode := False;
  60         FBeginGesture := False;
  61         FMargin := 15;
  62         FGestureItemList := TStringList.Create;
  63 end;
  64
  65 destructor TMouseGesture.Destroy;
  66 begin
  67         UnHook;
  68         Clear;
  69         FGestureItemList.Free;
  70         inherited;
  71 end;
  72
  73 //\83}\83E\83X\83t\83b\83N
  74 procedure TMouseGesture.SetHook(hWnd: THandle);
  75 begin
  76         if FHook <> 0 then
  77                 Exit;
  78         FHandle := hWnd;
  79         UnHook;
  80         FHook := SetWindowsHookEx(WH_MOUSE, @GestureProc, 0{HInstance}, GetCurrentThreadId);
  81 end;
  82
  83 //\83}\83E\83X\83t\83b\83N\89ð\8f\9c
  84 procedure TMouseGesture.UnHook;
  85 begin
  86         if FHook = 0 then
  87                 Exit;
  88         UnhookWindowsHookEx(FHook);
  89         FHook := 0;
  90 end;
  91
  92 //\83t\83b\83N\83v\83\8d\83V\83W\83\83
  93 function GestureProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  94 var
  95         mhs: PMouseHookStruct;
  96 begin
  97         if nCode = HC_ACTION then begin
  98                 mhs := PMouseHookStruct(lParam);
  99                 if MouseGesture.CheckAction(wParam, mhs^.pt.X, mhs^.pt.Y) then begin
 100                         Result := 1;
 101                         Exit;
 102                 end;
 103         end;
 104         Result := CallNextHookEx(MouseGesture.FHook, nCode, wParam, lParam);
 105 end;
 106
 107 function TMouseGesture.CheckAction(Message: Integer; x, y: Integer): Boolean;
 108 var
 109         dp: TPoint;
 110         sp: TPoint;
 111         hwnd: THandle;
 112 begin
 113         Result := False;
 114         case Message of
 115                 WM_MOUSEMOVE: begin
 116                         if FBeginGesture then begin
 117                                 //\8d¡\83}\83E\83X\82ð\83L\83\83\83v\83`\83\83\81[\82µ\82Ä\82¢\82é\82Ì\82ð\93¾\82é
 118                                 hwnd := GetCapture;
 119                                 //\83}\83E\83X\83W\83F\83X\83`\83\83\81[\82Ì\91Î\8fÛ\82Æ\88á\82¤\82Æ\82«\82Í\81A\8aJ\95ú\82·\82é
 120                                 if (hwnd <> 0) and (hwnd <> FHandle) then begin
 121                                         ReleaseCapture;
 122                     SetCapture(FHandle);
 123                                 end;
 124                                 dp := Point(x - FLastPoint.X, y - FLastPoint.Y);
 125                                 sp := Point(Sign(dp.X), Sign(dp.Y));
 126                                 if (dp.X * dp.X + dp.Y * dp.Y) > (FMargin * FMargin) then begin
 127                                         dp := Point(Abs(dp.X), Abs(dp.Y));
 128                                         if dp.X > dp.Y div 3 then
 129                                                 sp.Y := 0;
 130                                         if dp.Y > dp.X div 3 then
 131                                                 sp.X := 0;
 132                                         AddAction(sp.X, sp.Y);
 133                                         FLastTime := GetTickCount;
 134                                         FLastPoint := Point(x, y);
 135                                 end;
 136                 Result := True;
 137                 end;
 138                 end;
 139                 WM_RBUTTONDOWN: begin
 140                         if (not FCancelMode)  then begin
 141                 if ( GikoSys.Setting.GestureIgnoreContext ) then begin
 142                                 //\8d¡\83}\83E\83X\82ð\83L\83\83\83v\83`\83\83\81[\82µ\82Ä\82¢\82é\82Ì\82ð\93¾\82é
 143                                 hwnd := GetCapture;
 144                                 //\83}\83E\83X\83W\83F\83X\83`\83\83\81[\82Ì\91Î\8fÛ\82Æ\88á\82¤\82Æ\82«\82Í\81A\8aJ\95ú\82·\82é
 145                                 if (hwnd <> 0) and (hwnd <> FHandle) then begin
 146                         Exit;
 147                     end;
 148                 end;
 149                                 FBeginGesture := True;
 150                                 FLastTime := 0;
 151                                 FLastPoint := Point(x, y);
 152                                 FStartPoint := Point(x, y);
 153                                 Result := True;
 154                                 SetCapture(FHandle);
 155                         end;
 156                 end;
 157                 WM_RBUTTONUP: begin
 158                         if FCancelMode then
 159                                 FCancelMode := False
 160                         else if (FBeginGesture) then begin
 161                                 FBeginGesture := False;
 162                                 ReleaseCapture;
 163                                 if FGestureItemList.Count <> 0 then begin
 164                                         if Assigned(FOnGestureEnd) then begin
 165                                                 FOnGestureEnd(Self);
 166                     end else begin
 167                         Clear;
 168                     end;
 169                                 end else begin
 170                                         FCancelMode := True;
 171                                         //\83W\83F\83X\83`\83\83\81[\82¶\82á\82È\82©\82Á\82½\8fê\8d\87\81A\83}\83E\83XDOWN,UP\82ð\83G\83~\83\85\83\8c\81[\83g
 172                                         mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTDOWN, FStartPoint.X, FStartPoint.Y, 0, 0);
 173                                         mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTUP, x, y, 0, 0);
 174                                 end;
 175                         end;
 176                 end;
 177         end;
 178 end;
 179
 180 //\93®\8dì\82Ì\92Ç\89Á
 181 procedure TMouseGesture.AddAction(sx, sy: Integer);
 182 var
 183         Direction: string;
 184 begin
 185         Direction := '';
 186         if (sx > 0) and (sy = 0) then
 187                 Direction := '\81¨'
 188         else if (sx < 0) and (sy = 0) then
 189                 Direction := '\81©'
 190         else if sy > 0 then
 191                 Direction := '\81«'
 192         else if sy < 0 then
 193                 Direction := '\81ª'
 194         else
 195                 Exit;
 196         if FGestureItemList.Count > 0 then begin
 197                 if Items[FGestureItemList.Count - 1] = Direction then
 198                         Exit;
 199         end else begin
 200                 //\83W\83F\83X\83`\83\83\81[\8aJ\8en
 201                 if Assigned(FOnGestureStart) then
 202                         FOnGestureStart(Self);
 203         end;
 204         AddGesture(Direction);
 205         if Assigned(FOnGestureMove) then
 206                 FOnGestureMove(Self);
 207 end;
 208
 209 //\8c»\8dÝ\82Ì\83W\83F\83X\83`\83\83\81[\82É\90V\82µ\82¢\95û\8cü\82ð\92Ç\89Á
 210 function TMouseGesture.AddGesture(Item: string): Integer;
 211 begin
 212         Result := FGestureItemList.Add(Item);
 213 end;
 214
 215 //\8ew\92è\82³\82ê\82½index\82Ì\93®\82«\82ð\95Ô\82·
 216 function TMouseGesture.Get(Index: Integer): string;
 217 begin
 218         Result := FGestureItemList[Index];
 219 end;
 220
 221 //\8ew\92è\82³\82ê\82½index\82Ì\93®\82«\82ð\90Ý\92è\82·\82é
 222 procedure TMouseGesture.Put(Index: Integer; Item: string);
 223 begin
 224         FGestureItemList[Index] := Item;
 225 end;
 226
 227 //\83W\83F\83X\83`\83\83\81[\95¶\8e\9a\97ñ\82ð\95Ô\82·
 228 function TMouseGesture.GetGestureStr: string;
 229 var
 230         i: Integer;
 231 begin
 232         Result := '';
 233         for i := 0 to FGestureItemList.Count - 1 do
 234                 Result := Result + Items[i];
 235 end;
 236
 237 //\83W\83F\83X\83`\83\83\81[\82Ì\92·\82³\82ð\95Ô\82·
 238 function TMouseGesture.GetGestureCount: Integer;
 239 begin
 240         Result := FGestureItemList.Count;
 241 end;
 242
 243 //\83W\83F\83X\83`\83\83\81[\82ð\83N\83\8a\83A\82·\82é
 244 procedure TMouseGesture.Clear;
 245 begin
 246         FGestureItemList.Clear;
 247 end;
 248
 249 end.