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