Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/Gesture.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download) (as text)
Mon Oct 11 14:38:58 2004 UTC (19 years, 6 months ago) by yoffy
Branch: MAIN
CVS Tags: v1_50_0_581, v1_50_0_580, v1_50_0_587, v1_50_0_586, v1_50_0_572, v1_50_0_590, bv1_49_0_564, v1_50_0_593, bv1_49_0_563, v1_50_0_557, v1_50_0_585, v1_50_0_582, merged-remodeling, v1_50_0_577, v1_50_0_588, bv1_49_0_565, v1_50_0_574, v1_50_0_584, v_step1, v1_50_0_573, v1_50_0_571, v1_50_0_576, v1_50_0_578, v1_50_0_579, root-of-Bb50, root-of-remodel, v1_50_0_594, v1_50_0_561
Branch point for: remodeling, Bb50
File MIME type: text/x-pascal
・゙・ヲ・ケ・ク・ァ・ケ・チ・网ホトノイテ。」
build557

1 yoffy 1.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     //?ス}?スE?スX?スt?スb?スN
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     //?ス}?スE?スX?スt?スb?スN?ス?ス?ス?ス
81     procedure TMouseGesture.UnHook;
82     begin
83     if FHook = 0 then
84     Exit;
85     UnhookWindowsHookEx(FHook);
86     FHook := 0;
87     end;
88    
89     //?スt?スb?スN?スv?ス?ス?スV?スW?ス?ス
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     //?スW?スF?スX?ス`?ス?ス?ス[?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?スA?ス}?スE?スXDOWN,UP?ス?ス?スG?ス~?ス?ス?ス?ス?ス[?スg
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     //?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス
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 := '?ス?ス'
168     else if (sx < 0) and (sy = 0) then
169     Direction := '?ス?ス'
170     else if sy > 0 then
171     Direction := '?ス?ス'
172     else if sy < 0 then
173     Direction := '?ス?ス'
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     //?スW?スF?スX?ス`?ス?ス?ス[?スJ?スn
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     //?ス?ス?ス?ス?ス?ス?スW?スF?スX?ス`?ス?ス?ス[?ス?ス?スV?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス
190     function TMouseGesture.AddGesture(Item: string): Integer;
191     begin
192     Result := FGestureItemList.Add(Item);
193     end;
194    
195     //?スw?ス?ス?ス?ス?ス?ス?ス?スindex?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス
196     function TMouseGesture.Get(Index: Integer): string;
197     begin
198     Result := FGestureItemList[Index];
199     end;
200    
201     //?スw?ス?ス?ス?ス?ス?ス?ス?スindex?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス
202     procedure TMouseGesture.Put(Index: Integer; Item: string);
203     begin
204     FGestureItemList[Index] := Item;
205     end;
206    
207     //?スW?スF?スX?ス`?ス?ス?ス[?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス
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     //?スW?スF?スX?ス`?ス?ス?ス[?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス?ス
218     function TMouseGesture.GetGestureCount: Integer;
219     begin
220     Result := FGestureItemList.Count;
221     end;
222    
223     //?スW?スF?スX?ス`?ス?ス?ス[?ス?ス?スN?ス?ス?スA?ス?ス?ス?ス
224     procedure TMouseGesture.ClearGesture;
225     begin
226     FGestureItemList.Clear;
227     end;
228    
229     end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26