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         r: LongBool;
 110 begin
 111         Result := False;
 112         case Message of
 113                 WM_MOUSEMOVE: begin
 114                         if FBeginGesture then begin
 115                                 //\8d¡\83}\83E\83X\82ð\83L\83\83\83v\83`\83\83\81[\82µ\82Ä\82¢\82é\82Ì\82ð\93¾\82é
 116                                 hwnd := GetCapture;
 117                                 //\83}\83E\83X\83W\83F\83X\83`\83\83\81[\82Ì\91Î\8fÛ\82Æ\88á\82¤\82Æ\82«\82Í\81A\8aJ\95ú\82·\82é
 118                                 if (hwnd <> 0) and (hwnd <> FHandle) then begin
 119                                         ReleaseCapture;
 120                                 end;
 121                                 SetCapture(FHandle);
 122                                 dp := Point(x - FLastPoint.X, y - FLastPoint.Y);
 123                                 sp := Point(Sign(dp.X), Sign(dp.Y));
 124                                 if (dp.X * dp.X + dp.Y * dp.Y) > (FMargin * FMargin) then begin
 125                                         dp := Point(Abs(dp.X), Abs(dp.Y));
 126                                         if dp.X > dp.Y div 3 then
 127                                                 sp.Y := 0;
 128                                         if dp.Y > dp.X div 3 then
 129                                                 sp.X := 0;
 130                                         AddAction(sp.X, sp.Y);
 131                                         FLastTime := GetTickCount;
 132                                         FLastPoint := Point(x, y);
 133                                 end;
 134                                 Result := True;
 135                         end;
 136                 end;
 137                 WM_RBUTTONDOWN: begin
 138                         if not FCancelMode then begin
 139                                 FBeginGesture := True;
 140                                 FLastTime := 0;
 141                                 FLastPoint := Point(x, y);
 142                                 FStartPoint := Point(x, y);
 143                                 Result := True;
 144                                 SetCapture(FHandle);
 145                         end;
 146                 end;
 147                 WM_RBUTTONUP: begin
 148                         if FCancelMode then
 149                                 FCancelMode := False
 150                         else if (FBeginGesture) then begin
 151                                 FBeginGesture := False;
 152                                 ReleaseCapture;
 153                                 if FGestureItemList.Count <> 0 then begin
 154                                         if Assigned(FOnGestureEnd) then
 155                                                 FOnGestureEnd(Self);
 156                                         ClearGesture;
 157                                 end else begin
 158                                         FCancelMode := True;
 159                                         //\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
 160                                         mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTDOWN, FStartPoint.X, FStartPoint.Y, 0, 0);
 161                                         mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTUP, x, y, 0, 0);
 162                                 end;
 163                         end;
 164                 end;
 165         end;
 166 end;
 167
 168 //\93®\8dì\82Ì\92Ç\89Á
 169 procedure TMouseGesture.AddAction(sx, sy: Integer);
 170 var
 171         Direction: string;
 172 begin
 173         Direction := '';
 174         if (sx > 0) and (sy = 0) then
 175                 Direction := '\81¨'
 176         else if (sx < 0) and (sy = 0) then
 177                 Direction := '\81©'
 178         else if sy > 0 then
 179                 Direction := '\81«'
 180         else if sy < 0 then
 181                 Direction := '\81ª'
 182         else
 183                 Exit;
 184         if FGestureItemList.Count > 0 then begin
 185                 if Items[FGestureItemList.Count - 1] = Direction then
 186                         Exit;
 187         end else begin
 188                 //\83W\83F\83X\83`\83\83\81[\8aJ\8en
 189                 if Assigned(FOnGestureStart) then
 190                         FOnGestureStart(Self);
 191         end;
 192         AddGesture(Direction);
 193         if Assigned(FOnGestureMove) then
 194                 FOnGestureMove(Self);
 195 end;
 196
 197 //\8c»\8dÝ\82Ì\83W\83F\83X\83`\83\83\81[\82É\90V\82µ\82¢\95û\8cü\82ð\92Ç\89Á
 198 function TMouseGesture.AddGesture(Item: string): Integer;
 199 begin
 200         Result := FGestureItemList.Add(Item);
 201 end;
 202
 203 //\8ew\92è\82³\82ê\82½index\82Ì\93®\82«\82ð\95Ô\82·
 204 function TMouseGesture.Get(Index: Integer): string;
 205 begin
 206         Result := FGestureItemList[Index];
 207 end;
 208
 209 //\8ew\92è\82³\82ê\82½index\82Ì\93®\82«\82ð\90Ý\92è\82·\82é
 210 procedure TMouseGesture.Put(Index: Integer; Item: string);
 211 begin
 212         FGestureItemList[Index] := Item;
 213 end;
 214
 215 //\83W\83F\83X\83`\83\83\81[\95¶\8e\9a\97ñ\82ð\95Ô\82·
 216 function TMouseGesture.GetGestureStr: string;
 217 var
 218         i: Integer;
 219 begin
 220         Result := '';
 221         for i := 0 to FGestureItemList.Count - 1 do
 222                 Result := Result + Items[i];
 223 end;
 224
 225 //\83W\83F\83X\83`\83\83\81[\82Ì\92·\82³\82ð\95Ô\82·
 226 function TMouseGesture.GetGestureCount: Integer;
 227 begin
 228         Result := FGestureItemList.Count;
 229 end;
 230
 231 //\83W\83F\83X\83`\83\83\81[\82ð\83N\83\8a\83A\82·\82é
 232 procedure TMouseGesture.ClearGesture;
 233 begin
 234         FGestureItemList.Clear;
 235 end;
 236
 237 end.