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.6 - (hide annotations) (download) (as text)
Wed Feb 22 17:21:22 2006 UTC (18 years, 1 month ago) by h677
Branch: MAIN
CVS Tags: v1_53_0_671, v1_54_0_677, v1_54_0_676, v1_54_0_678, v1_52_1_658, v1_54_0_684, v1_53_0_664, v1_52_0_647, v1_52_0_648, v1_53_0_661, v1_53_0_663, v1_53_0_662, v1_53_0_665, v1_53_0_667, v1_53_0_666, v1_53_0_669, v1_53_0_668, v1_52_0_651, v1_52_0_650, v1_52_0_652, v1_52_0_654, v1_53_0_672, v1_53_0_670, v1_54_0_680, v1_54_0_681, v1_54_0_682, v1_54_0_683, v1_54_0_679, v1_54_0_675, root-of-Bb53, v1_52_1_657, v1_54_0_674, v1_52_0_660, v1_52_0_655, v1_52_0_656, v1_52_0_649, v1_53_1_673
Branch point for: Bb53, Bb52
Changes since 1.5: +0 -1 lines
File MIME type: text/x-pascal
dat落ちスレの区別を追加したので、スレッド一覧をそれで絞り込めるようにした

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     //鐃?鐃?鐃?鐃?鐃?鐃?
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 h677 1.2 hwnd: THandle;
109 yoffy 1.1 begin
110     Result := False;
111     case Message of
112     WM_MOUSEMOVE: begin
113     if FBeginGesture then begin
114 h677 1.2 //鐃緒申鐃?鐃?鐃?鐃緒申鐃?鐃緒申鐃?鐃?鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申
115     hwnd := GetCapture;
116     //鐃?鐃?鐃?鐃?鐃?鐃?鐃?鐃緒申鐃?鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃緒申鐃?鐃?鐃緒申鐃緒申鐃緒申
117     if (hwnd <> 0) and (hwnd <> FHandle) then begin
118     ReleaseCapture;
119     end;
120 yoffy 1.1 SetCapture(FHandle);
121     dp := Point(x - FLastPoint.X, y - FLastPoint.Y);
122     sp := Point(Sign(dp.X), Sign(dp.Y));
123 h677 1.2 if (dp.X * dp.X + dp.Y * dp.Y) > (FMargin * FMargin) then begin
124 yoffy 1.1 dp := Point(Abs(dp.X), Abs(dp.Y));
125 h677 1.2 if dp.X > dp.Y div 3 then
126 yoffy 1.1 sp.Y := 0;
127 h677 1.2 if dp.Y > dp.X div 3 then
128 yoffy 1.1 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 h677 1.4 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 yoffy 1.1 end;
146     WM_RBUTTONUP: begin
147 h677 1.4 if FCancelMode then
148     FCancelMode := False
149 h677 1.5 else if (FBeginGesture) then begin
150 h677 1.4 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 yoffy 1.1 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