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.1 - (show 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 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