Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/Gesture.pas

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


Revision 1.4 - (show annotations) (download) (as text)
Wed Dec 14 17:04:56 2005 UTC (18 years, 4 months ago) by h677
Branch: MAIN
CVS Tags: v1_51_1_639, b51, v1_52_0_646, v1_52_0_644, v1_52_0_643, v1_51_0_634, v1_51_0_635, v1_51_0_636, v1_51_0_637, v1_51_0_632, v1_51_0_633, v1_51_0_638, v1_52_0_645, v1_52_0_642, v1_51_1_640, v1_51_0_630, v1_51_0_631, root-of-Bb51, v1_51_0_629, v1_51_1_641
Branch point for: Bb51
Changes since 1.3: +23 -11 lines
File MIME type: text/x-pascal
1.3の直し方だと、メインSフォームのポップアップがおかしくなるので、1.2相当に
ロールバック。

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 //鐃?鐃?鐃?鐃?鐃?鐃?
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 //鐃?鐃?鐃?鐃?鐃?鐃?鐃緒申鐃緒申
81 procedure TMouseGesture.UnHook;
82 begin
83 if FHook = 0 then
84 Exit;
85 UnhookWindowsHookEx(FHook);
86 FHook := 0;
87 end;
88
89 //鐃?鐃?鐃?鐃?鐃緒申鐃?鐃?鐃緒申
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 //鐃緒申鐃?鐃?鐃?鐃緒申鐃?鐃緒申鐃?鐃?鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
115 hwnd := GetCapture;
116 //鐃?鐃?鐃?鐃?鐃?鐃?鐃?鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃?鐃緒申鐃緒申鐃緒申
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 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 //鐃?鐃?鐃?鐃?鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃?鐃?鐃?DOWN,UP鐃緒申鐃?鐃?鐃緒申鐃緒申鐃?鐃?
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 //鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
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 := '鐃緒申'
175 else if (sx < 0) and (sy = 0) then
176 Direction := '鐃緒申'
177 else if sy > 0 then
178 Direction := '鐃緒申'
179 else if sy < 0 then
180 Direction := '鐃緒申'
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 //鐃?鐃?鐃?鐃?鐃緒申鐃?鐃?鐃?
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 //鐃緒申鐃緒申鐃緒申鐃?鐃?鐃?鐃?鐃緒申鐃?鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
197 function TMouseGesture.AddGesture(Item: string): Integer;
198 begin
199 Result := FGestureItemList.Add(Item);
200 end;
201
202 //鐃?鐃緒申鐃緒申鐃緒申鐃緒申index鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
203 function TMouseGesture.Get(Index: Integer): string;
204 begin
205 Result := FGestureItemList[Index];
206 end;
207
208 //鐃?鐃緒申鐃緒申鐃緒申鐃緒申index鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
209 procedure TMouseGesture.Put(Index: Integer; Item: string);
210 begin
211 FGestureItemList[Index] := Item;
212 end;
213
214 //鐃?鐃?鐃?鐃?鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
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 //鐃?鐃?鐃?鐃?鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
225 function TMouseGesture.GetGestureCount: Integer;
226 begin
227 Result := FGestureItemList.Count;
228 end;
229
230 //鐃?鐃?鐃?鐃?鐃緒申鐃?鐃緒申鐃?鐃緒申鐃?鐃緒申鐃緒申
231 procedure TMouseGesture.ClearGesture;
232 begin
233 FGestureItemList.Clear;
234 end;
235
236 end.

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