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