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                         FBeginGesture := True;
 138                         FLastTime := 0;
 139                         FLastPoint := Point(x, y);
 140                         FStartPoint := Point(x, y);
 141                         SetCapture(FHandle);
 142                 end;
 143                 WM_RBUTTONUP: begin
 144                         FBeginGesture := False;
 145                         ReleaseCapture;
 146                         if FGestureItemList.Count <> 0 then begin
 147                                 if Assigned(FOnGestureEnd) then
 148                                         FOnGestureEnd(Self);
 149                                 ClearGesture;
 150                         end;
 151                 end;
 152         end;
 153 end;
 154
 155 //\93®\8dì\82Ì\92Ç\89Á
 156 procedure TMouseGesture.AddAction(sx, sy: Integer);
 157 var
 158         Direction: string;
 159 begin
 160         Direction := '';
 161         if (sx > 0) and (sy = 0) then
 162                 Direction := '\81¨'
 163         else if (sx < 0) and (sy = 0) then
 164                 Direction := '\81©'
 165         else if sy > 0 then
 166                 Direction := '\81«'
 167         else if sy < 0 then
 168                 Direction := '\81ª'
 169         else
 170                 Exit;
 171         if FGestureItemList.Count > 0 then begin
 172                 if Items[FGestureItemList.Count - 1] = Direction then
 173                         Exit;
 174         end else begin
 175                 //\83W\83F\83X\83`\83\83\81[\8aJ\8en
 176                 if Assigned(FOnGestureStart) then
 177                         FOnGestureStart(Self);
 178         end;
 179         AddGesture(Direction);
 180         if Assigned(FOnGestureMove) then
 181                 FOnGestureMove(Self);
 182 end;
 183
 184 //\8c»\8dÝ\82Ì\83W\83F\83X\83`\83\83\81[\82É\90V\82µ\82¢\95û\8cü\82ð\92Ç\89Á
 185 function TMouseGesture.AddGesture(Item: string): Integer;
 186 begin
 187         Result := FGestureItemList.Add(Item);
 188 end;
 189
 190 //\8ew\92è\82³\82ê\82½index\82Ì\93®\82«\82ð\95Ô\82·
 191 function TMouseGesture.Get(Index: Integer): string;
 192 begin
 193         Result := FGestureItemList[Index];
 194 end;
 195
 196 //\8ew\92è\82³\82ê\82½index\82Ì\93®\82«\82ð\90Ý\92è\82·\82é
 197 procedure TMouseGesture.Put(Index: Integer; Item: string);
 198 begin
 199         FGestureItemList[Index] := Item;
 200 end;
 201
 202 //\83W\83F\83X\83`\83\83\81[\95¶\8e\9a\97ñ\82ð\95Ô\82·
 203 function TMouseGesture.GetGestureStr: string;
 204 var
 205         i: Integer;
 206 begin
 207         Result := '';
 208         for i := 0 to FGestureItemList.Count - 1 do
 209                 Result := Result + Items[i];
 210 end;
 211
 212 //\83W\83F\83X\83`\83\83\81[\82Ì\92·\82³\82ð\95Ô\82·
 213 function TMouseGesture.GetGestureCount: Integer;
 214 begin
 215         Result := FGestureItemList.Count;
 216 end;
 217
 218 //\83W\83F\83X\83`\83\83\81[\82ð\83N\83\8a\83A\82·\82é
 219 procedure TMouseGesture.ClearGesture;
 220 begin
 221         FGestureItemList.Clear;
 222 end;
 223
 224 end.