尽管高版本的Delphi已经提供强悍的手势功能，也非常好用，我还是没能用上，所以自己结合实际，参阅多个组件源码，改造了JvMouseGesture.pas单元，弄出一个实用的鼠标手势管理功能，记在这里，以免硬盘坏了，又要重来。
改造过的JvMouseGesture.pas单元代码：
unit JvMouseGesture; {$I jvcl.inc} interface uses {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} SysUtils, Classes, Controls, Windows, Messages,Forms,Graphics, JvComponentBase; type { Description Defines, whether or not the hook will be activated automatically or not. } TJvActivationMode = (amAppStart, amManual); { Description Defines a complex gesture (two or more letters event) } TOnMouseGestureCustomInterpretation = procedure(Sender: TObject;const AGesture: string) of object; { Description This class implements the basic interpreter. It can be used to enhance single components, too. E.g., if you want to enable a grid with gesture feature. For this purpose you have to do 4 steps: 1) Fill the "OnMouseDown" event with code like <CODE> if Button = mbRight then JvMouseGesture1.StartMouseGesture(x,y); </CODE> 2) Fill the OnMouseMove event with something like <CODE> if JvMouseGesture1.TrailActive then JvMouseGesture1.TrailMouseGesture(x,y); </CODE> 3) Now fill the OnMouseUp event <CODE> if JvMouseGesture1.TrailActive then JvMouseGesture1.EndMouseGesture; </CODE> 4) Last but not least fill components OnJvMouseGestureCustomInterpretation XOR OnJvMouseGesture\<xyz\> event Note: If CustomInterpreation is filled the other events are not fired! See Also TJvMouseGestureHook } {$IFDEF RTL230_UP} [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32)] {$ENDIF RTL230_UP} TJvMouseGesture = class(TJvComponent) private FForm: TForm; FActive: Boolean; FHided: Boolean; FTrailX: Integer; FTrailY: Integer; FTrailLength: Integer; FTrailActive: Boolean; FTrailStartTime: TDateTime; FdTolerance: Integer; FTrailLimit: Integer; FTrackWidth: Cardinal; FTrackColor: TColor; FDelay: Integer; FTrailInterval: Integer; FGrid: Integer; // tolerance for diagonal movement. See TrailMouseGesture FGridHalf: Integer; // half of grid, needed for performance FLastPushed: String; FGesture: string; FGestureList: TStringList; FLastWndProc: TWndMethod; FOnMouseGestureRight: TNotifyEvent; FOnMouseGestureLeft: TNotifyEvent; FOnMouseGestureUp: TNotifyEvent; FOnMouseGestureDown: TNotifyEvent; FOnMouseGestureLeftLowerEdge: TNotifyEvent; FOnMouseGestureRightUpperEdge: TNotifyEvent; FOnMouseGestureLeftUpperEdge: TNotifyEvent; FOnMouseGestureRightLowerEdge: TNotifyEvent; FOnMouseGestureCancelled: TNotifyEvent; FOnTrailingMouseGesture: TNotifyEvent; FOnMouseGestureCustomInterpretation: TOnMouseGestureCustomInterpretation; { Description Adds a detected sub gesture to gesture string } procedure AddGestureChar(AChar: String); procedure SetTrailLimit(const Value: Integer); procedure SetTrailInterval(const Value: Integer); procedure SetDelay(const Value: Integer); procedure SetGrid(const Value: Integer); procedure SetTrackColor(const Value: TColor); { Description Loads the known gestures for matching events Note: In this version only evaluation of simple mouse gestures are implemented } procedure LoadGestureTable; { Description Standard setter method for Active } procedure SetActive(const Value: Boolean); procedure Hide; // 内部函数，用来隐藏当前窗体(Internal function to hide the form) procedure AdjustSize; procedure WndProc(var Msg: TMessage); protected procedure DoMouseGestureRight; virtual; procedure DoMouseGestureLeft; virtual; procedure DoMouseGestureUp; virtual; procedure DoMouseGestureDown; virtual; procedure DoMouseGestureLeftLowerEdge; virtual; procedure DoMouseGestureRightUpperEdge; virtual; procedure DoMouseGestureLeftUpperEdge; virtual; procedure DoMouseGestureRightLowerEdge; virtual; procedure DoMouseGestureCancelled; virtual; procedure DoOnTrailingMouseGesture; virtual; function DoMouseGestureCustomInterpretation(const AGesture: string): Boolean; virtual; public { Description Standard constructor } constructor Create(AOwner: TComponent); override; { Description Standard destructor } destructor Destroy; override; { Description Starts the mouse gesture interpretation Parameters: AMouseX: X coordinate of mouse cursor AMouseY: Y coordinate of mouse cursor } procedure StartMouseGesture(AMouseX, AMouseY: Integer); { Description Continues the mouse gesture interpretation during mouse move Parameters: AMouseX: X coordinate of mouse cursor AMouseY: Y coordinate of mouse cursor } procedure TrailMouseGesture(AMouseX, AMouseY: Integer); { Description Ends the mouse gesture interpretation and fires an event if a gesture was found } procedure EndMouseGesture(AMouseX, AMouseY: Integer); { Description The actual length of trail (not of gesture string!!!) } procedure DrawGestureText(GText:String); property TrailLength: Integer read FTrailLength; { Description TRUE, if in detection, otherwise FALSE } property TrailActive: Boolean read FTrailActive; { Description The gesture string. For string content see description of unit. } property Gesture: string read FGesture; published { Description The maximum length of trail (not of gesture string!!!) Normally never been changed } property TrailLimit: Integer read FTrailLimit write SetTrailLimit; { Description Trail interval Normally never been changed } property TrailInterval: Integer read FTrailInterval write SetTrailInterval; { Description Grid size for detection Normally never been changed } property Grid: Integer read FGrid write SetGrid; { Description The maximum delay before cancelling a gesture Normally never been changed } property Delay: Integer read FDelay write SetDelay; { Description TRUE if component is active, otherwise FALSE } property Active: Boolean read FActive write SetActive; { Description Event for own evaluation of detected gesture. If this event is used all others will be ignored! } property TrackColor : TColor read FTrackColor write SetTrackColor default clRed; // 轨迹宽度，默认5px property TrackWidth: Cardinal read FTrackWidth write FTrackWidth default 5; property OnMouseGestureCustomInterpretation: TOnMouseGestureCustomInterpretation read FOnMouseGestureCustomInterpretation write FOnMouseGestureCustomInterpretation; { Description Event for a simple MOUSE UP gesture } property OnMouseGestureCancelled: TNotifyEvent read FOnMouseGestureCancelled write FOnMouseGestureCancelled; property OnMouseGestureUp: TNotifyEvent read FOnMouseGestureUp write FOnMouseGestureUp; { Description Event for a simple MOUSE DOWN gesture } property OnMouseGestureDown: TNotifyEvent read FOnMouseGestureDown write FOnMouseGestureDown; { Description Event for a simple MOUSE LEFT gesture } property OnMouseGestureLeft: TNotifyEvent read FOnMouseGestureLeft write FOnMouseGestureLeft; { Description Event for a simple MOUSE RIGHT gesture } property OnMouseGestureRight: TNotifyEvent read FOnMouseGestureRight write FOnMouseGestureRight; { Description Event for a simple diagonally MOUSE LEFT LOWER EDGE (point 1 in grid) gesture } property OnMouseGestureLeftLowerEdge: TNotifyEvent read FOnMouseGestureLeftLowerEdge write FOnMouseGestureLeftLowerEdge; { Description Event for a simple diagonally MOUSE RIGHT LOWER EDGE (point 3 in grid) gesture } property OnMouseGestureRightLowerEdge: TNotifyEvent read FOnMouseGestureRightLowerEdge write FOnMouseGestureRightLowerEdge; { Description Event for a simple diagonally MOUSE LEFT UPPER EDGE (point 7 in grid) gesture } property OnMouseGestureLeftUpperEdge: TNotifyEvent read FOnMouseGestureLeftUpperEdge write FOnMouseGestureLeftUpperEdge; { Description Event for a simple diagonally MOUSE RIGHT UPPER EDGE (point 9 in grid) gesture } property OnMouseGestureRightUpperEdge: TNotifyEvent read FOnMouseGestureRightUpperEdge write FOnMouseGestureRightUpperEdge; property OnTrailingMouseGesture: TNotifyEvent read FOnTrailingMouseGesture write FOnTrailingMouseGesture; end; { Description This class implements a application wide mouse hook for mouse gestures. Programmers get only one event for a detected mouse gesture: OnMouseGestureCustomInterpretation See Also TJvMouseGesture } {$IFDEF RTL230_UP} [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32)] {$ENDIF RTL230_UP} TJvMouseGestureHook = class(TJvComponent) private FTrailLimit: Integer; FTrackWidth: Cardinal; FTrackColor: TColor; FDelay: Integer; FTrailInterval: Integer; FGrid: Integer; { Description True if a hook is installed } FHookInstalled: Boolean; { Description Field for hook handle } FCurrentHook: HHook; { Description Field for method pointer } FOnMouseGestureCustomInterpretation: TOnMouseGestureCustomInterpretation; { Description Field for active state of component } FOnCustomTrailingMouseGesture: TNotifyEvent; FActive: Boolean; { Description Field for mouse key } FMouseButton: TMouseButton; { Description Field for activation mode } FActivationMode: TJvActivationMode; { Description Standard setter method for evaluation of detected gesture } { Description Standard setter method for Active } procedure SetActive(const Value: Boolean); { Description Standard setter method for MouseButton } procedure SetMouseButton(const Value: TMouseButton); { Description Standard setter method for ActivationMode } procedure SetTrailLimit(const Value: Integer); procedure SetTrailInterval(const Value: Integer); procedure SetDelay(const Value: Integer); procedure SetGrid(const Value: Integer); procedure SetTrackColor(const Value: TColor); procedure SetTrackWidth(const Value: Cardinal); procedure SetActivationMode(const Value: TJvActivationMode); procedure SetMouseGestureCustomInterpretation(const Value: TOnMouseGestureCustomInterpretation); procedure SetTrailingMouseGesture(const Value: TNotifyEvent); function GetMouseGesture: TJvMouseGesture; protected { Description Create the hook. Maybe used in a later version as a new constructor to enable system wide hooks ... } procedure CreateForThreadOrSystem(AOwner: TComponent; ADwThreadID: Cardinal); function DoMouseGestureCustomInterpretation(const AGesture: string): Boolean; virtual; public { Description Standard constructor } constructor Create(AOwner: TComponent); override; { Description Standard destructor } destructor Destroy; override; { Description TRUE if hook was installed successfully } property HookInstalled: Boolean read FHookInstalled; //True if a hook is installed { Description handle of hook } property CurrentHook: HHook read FCurrentHook; //contains the handle of the currently installed hook property MouseGesture: TJvMouseGesture read GetMouseGesture; published property TrailLimit:Integer read FTrailLimit write SetTrailLimit; property TrackWidth:Cardinal read FTrackWidth write SetTrackWidth; property TrackColor:TColor read FTrackColor write SetTrackColor; property Delay:Integer read FDelay write SetDelay; property TrailInterval:Integer read FTrailInterval write SetTrailInterval; property Grid:Integer read FGrid write SetGrid; { Description TRUE if component is active, otherwise FALSE. Can be changed during runtime } property Active: Boolean read FActive write SetActive; { Description If property is set to <code>JvOnAppStart</code> then component will be activated on start of application, with <code>JvManually</code> you have to activate detection on your own } property ActivationMode: TJvActivationMode read FActivationMode write SetActivationMode; { Description Set the mouse key to be used for start/stop gesture See Also TMouseButton } property MouseButton: TMouseButton read FMouseButton write SetMouseButton default mbRight; { Description Set the event to be executed if a gesture will be detected } property OnMouseGestureCustomInterpretation: TOnMouseGestureCustomInterpretation read FOnMouseGestureCustomInterpretation write SetMouseGestureCustomInterpretation; property OnCustomTrailingMouseGesture: TNotifyEvent read FOnCustomTrailingMouseGesture write SetTrailingMouseGesture; end; { Description Hook call back function. DO NOT USE EXTERN! } function JvMouseGestureHook(Code: Integer; wParam: Word; lParam: Longword): Longword; stdcall; {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_47_PREPARATION/run/JvMouseGesture.pas $'; Revision: '$Revision: 13104 $'; Date: '$Date: 2011-09-07 08:50:43 +0200 (mer. 07 sept. 2011) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} implementation uses JvResources, JvTypes; const JVMG_LEFT = 0; JVMG_RIGHT = 1; JVMG_UP = 2; JVMG_DOWN = 3; JVMG_LEFTUPPER = 4; JVMG_RIGHTUPPER = 5; JVMG_LEFTLOWER = 6; JVMG_RIGHTLOWER = 7; var { Description Object pointer to interpreter class used by hook } JvMouseGestureInterpreter: TJvMouseGesture; { Description Some global vars to be accessed by call back function ... } JvMouseGestureHookAlreadyInstalled: Boolean = False; //<combine JvMouseGestureHookAlreadyInstalled> JvMouseGestureHookActive: Boolean = False; //<combine JvMouseGestureHookAlreadyInstalled> JvMouseButtonDown: Cardinal = WM_RBUTTONDOWN; //<combine JvMouseGestureHookAlreadyInstalled> JvMouseButtonUp: Cardinal = WM_RBUTTONUP; JvCurrentHook: HHook = 0; //contains the handle of the currently installed hook //=== { TJvMouseGesture } ==================================================== constructor TJvMouseGesture.Create(AOwner: TComponent); begin inherited Create(AOwner); FGestureList := TStringList.Create; FGestureList.Sorted := True; FDelay := 500; FTrailLimit := 1000; FTrailInterval := 2; FGrid := 15; FTrackColor := clRed; FTrackWidth := 5; FGridHalf := FGrid div 2; FTrailActive := False; FdTolerance := 75; // tolerance for diagonal movement. see processCoordinates() begin FForm := TForm.Create(Self); FForm.TransparentColor := True; FForm.TransparentColorValue := clBlack; FForm.BorderStyle := bsNone; FForm.FormStyle := fsStayOnTop; FForm.DoubleBuffered := True; FForm.Color := clBlack; FLastWndProc := FForm.WindowProc; FForm.WindowProc := WndProc; AdjustSize; FForm.Canvas.Brush.Color := FForm.TransparentColorValue; FForm.Canvas.FillRect(FForm.ClientRect); ShowWindow(FForm.Handle,SW_SHOWNOACTIVATE); Hide; FHided := True; end; LoadGestureTable; FActive := not (csDesigning in ComponentState); end; destructor TJvMouseGesture.Destroy; begin FTrailActive := False; FreeAndNil(FGestureList); FForm.free; inherited Destroy; end; procedure TJvMouseGesture.LoadGestureTable; begin with FGestureList do begin AddObject('向左', TObject(JVMG_LEFT)); AddObject('向右', TObject(JVMG_RIGHT)); AddObject('向上', TObject(JVMG_UP)); AddObject('向下', TObject(JVMG_DOWN)); AddObject('向左斜下', TObject(JVMG_LEFTLOWER)); AddObject('向右斜下', TObject(JVMG_RIGHTLOWER)); AddObject('向左斜上', TObject(JVMG_LEFTUPPER)); AddObject('向右斜上', TObject(JVMG_RIGHTUPPER)); end; end; procedure TJvMouseGesture.SetActive(const Value: Boolean); begin if csDesigning in ComponentState then FActive := False else FActive := Value; end; procedure TJvMouseGesture.Hide; begin if not FHided then begin FForm.Canvas.Brush.Color := FForm.TransparentColorValue; FForm.Canvas.FillRect(FForm.ClientRect); FHided := True; end; end; procedure TJvMouseGesture.AdjustSize; begin if not (csDesigning in ComponentState) then FForm.SetBounds(Screen.DesktopLeft, Screen.DesktopTop, Screen.DesktopWidth, Screen.DesktopWidth) else FForm.SetBounds(Screen.DesktopLeft, Screen.DesktopTop, 0, 0); end; procedure TJvMouseGesture.WndProc(var Msg: TMessage); begin if Msg.Msg = WM_NCHITTEST then Msg.Result := HTTRANSPARENT else if Msg.Msg = (WM_APP + 1) then AdjustSize else if Msg.Msg = (WM_APP + 2) then begin end else begin FLastWndProc(Msg); if Msg.Msg = WM_DISPLAYCHANGE then PostMessage(FForm.Handle, WM_APP + 1, 0, 0) else if Msg.Msg = WM_WINDOWPOSCHANGED then //保持窗口在最前，以保证能够覆盖绘制轨迹， PostMessage(FForm.Handle, WM_APP + 2, 0, 0); end; end; procedure TJvMouseGesture.SetTrailLimit(const Value: Integer); begin FTrailLimit := Value; if (FTrailLimit < 100) or (FTrailLimit > 10000) then FTrailLimit := 1000; end; procedure TJvMouseGesture.SetTrailInterval(const Value: Integer); begin FTrailInterval := Value; if (FTrailInterval < 1) or (FTrailInterval > 100) then FTrailInterval := 2; end; procedure TJvMouseGesture.SetDelay(const Value: Integer); begin FDelay := Value; if FDelay < 500 then FDelay := 500; end; procedure TJvMouseGesture.SetGrid(const Value: Integer); begin FGrid := Value; if (FGrid < 10) or (FGrid > 500) then FGrid := 15; FGridHalf := FGrid div 2; end; procedure TJvMouseGesture.SetTrackColor(const Value: TColor); begin if FTrackColor <> Value then begin FTrackColor := Value; if FTrackColor = clBlack then FForm.Color := clWhite else FForm.Color := clBlack; FForm.TransparentColorValue := FForm.Color; end; end; procedure TJvMouseGesture.AddGestureChar(AChar: String); begin if AChar <> FLastPushed then begin FGesture := FGesture +'→'+ AChar; FLastPushed := AChar; end; end; procedure TJvMouseGesture.StartMouseGesture(AMouseX, AMouseY: Integer); begin if not FActive then Exit; FForm.Show; FForm.BringToFront; FForm.Canvas.MoveTo(AMouseX, AMouseY); FLastPushed := #0; FGesture := ''; FTrailActive := True; FTrailLength := 0; FTrailX := AMouseX; FTrailY := AMouseY; FTrailStartTime := now; FHided:=False; end; procedure TJvMouseGesture.TrailMouseGesture(AMouseX, AMouseY: Integer); var locX: Integer; locY: Integer; x_dir: Integer; y_dir: Integer; tolerancePercent: Double; x_divide_y: Double; y_divide_x: Double; function InBetween(AValue, AMin, AMax: Double): Boolean; begin Result := (AValue >= AMin) and (AValue <= AMax); end; begin if not FActive then Exit; if (not FTrailActive) or (FTrailLength > FTrailLimit) then begin FTrailActive := False; Exit; end; try x_dir := AMouseX - FTrailX; y_dir := AMouseY - FTrailY; locX := abs(x_dir); locY := abs(y_dir); // process each half-grid if (locX >= FGridHalf) or (locY >= FGridHalf) then begin // diagonal movement: // dTolerance = 75 means that a movement is recognized as diagonal when // x/y or y/x is between 0.25 and 1 if (GetTopWindow(0) <> FForm.Handle) and Application.Active then FForm.BringToFront; FForm.Canvas.Pen.Color := FTrackColor; FForm.Canvas.Pen.Width := FTrackWidth; FForm.Canvas.LineTo(AMouseX, AMouseY); tolerancePercent := 1 - FdTolerance / 100; if locY <> 0 then x_divide_y := locX / locY else x_divide_y := 0; if locX <> 0 then y_divide_x := locY / locX else y_divide_x := 0; if (FdTolerance <> 0) and (InBetween(x_divide_y, tolerancePercent, 1) or InBetween(y_divide_x, tolerancePercent, 1)) then begin if (x_dir < -9) and (y_dir > 9) then begin AddGestureChar('向左斜下'); end else begin if (x_dir > 9) and (y_dir > 9) then AddGestureChar('向右斜下') else begin if (x_dir < -9) and (y_dir < -9) then AddGestureChar('向左斜上') else begin if (x_dir > 9) and (y_dir < -9) then AddGestureChar('向右斜上'); end; end; end; end // of diaognal else begin // horizontal movement: if locX > locY then begin if x_dir > 0 then AddGestureChar('向右') else begin if x_dir < 0 then AddGestureChar('向左'); end; end else begin // vertical movement: if locX < locY then begin if y_dir > 0 then AddGestureChar('向下') else begin if y_dir < 0 then AddGestureChar('向上'); end; end; end; end; end; // of half grid finally FTrailX := AMouseX; FTrailY := AMouseY; end; DoOnTrailingMouseGesture; end; procedure TJvMouseGesture.DrawGestureText(GText:String); begin FForm.Canvas.TextOut(300,300,GText); end; procedure TJvMouseGesture.EndMouseGesture(AMouseX, AMouseY: Integer); var Index: Integer; begin Hide; if not FActive then Exit; FTrailActive := False; if FGesture = '' then begin DoMouseGestureCancelled; Exit; end; // check for custom interpretation first if DoMouseGestureCustomInterpretation(FGesture) then Exit else Hide; // if no custom interpretation is implemented we chaeck for known gestures // and matching events // CASE indexes are stored sequence independent. So we have to find gesture // first and get CASE INDEX stored as TObject in Object property. It's a // simple trick, but works fine ... Index := FGestureList.IndexOf(FGesture); if Index > -1 then Index := Integer(FGestureList.Objects[Index]); case Index of JVMG_LEFT: begin DoMouseGestureLeft; end; JVMG_RIGHT: begin DoMouseGestureRight; end; JVMG_UP: begin DoMouseGestureUp; end; JVMG_DOWN: begin DoMouseGestureDown; end; JVMG_LEFTLOWER: begin DoMouseGestureLeftLowerEdge; end; JVMG_RIGHTLOWER: begin DoMouseGestureRightLowerEdge; end; JVMG_LEFTUPPER: begin DoMouseGestureLeftUpperEdge; end; JVMG_RIGHTUPPER: begin DoMouseGestureRightUpperEdge; end; end; end; procedure TJvMouseGesture.DoMouseGestureCancelled; begin if Assigned(FOnMouseGestureCancelled) then FOnMouseGestureCancelled(Self); end; procedure TJvMouseGesture.DoOnTrailingMouseGesture; begin if Assigned(FOnTrailingMouseGesture) then FOnTrailingMouseGesture(Self); end; function TJvMouseGesture.DoMouseGestureCustomInterpretation(const AGesture: string): Boolean; begin Result := Assigned(FOnMouseGestureCustomInterpretation); if Result then begin FOnMouseGestureCustomInterpretation(Self,FGesture); end; Hide; end; procedure TJvMouseGesture.DoMouseGestureDown; begin if Assigned(FOnMouseGestureDown) then FOnMouseGestureDown(Self); end; procedure TJvMouseGesture.DoMouseGestureLeft; begin if Assigned(FOnMouseGestureLeft) then FOnMouseGestureLeft(Self); end; procedure TJvMouseGesture.DoMouseGestureLeftLowerEdge; begin if Assigned(FOnMouseGestureLeftLowerEdge) then FOnMouseGestureLeftLowerEdge(Self); end; procedure TJvMouseGesture.DoMouseGestureLeftUpperEdge; begin if Assigned(FOnMouseGestureLeftUpperEdge) then FOnMouseGestureLeftUpperEdge(Self); end; procedure TJvMouseGesture.DoMouseGestureRight; begin if Assigned(FOnMouseGestureRight) then FOnMouseGestureRight(Self); end; procedure TJvMouseGesture.DoMouseGestureRightLowerEdge; begin if Assigned(FOnMouseGestureRightLowerEdge) then FOnMouseGestureRightLowerEdge(Self); end; procedure TJvMouseGesture.DoMouseGestureRightUpperEdge; begin if Assigned(FOnMouseGestureRightUpperEdge) then FOnMouseGestureRightUpperEdge(Self); end; procedure TJvMouseGesture.DoMouseGestureUp; begin if Assigned(FOnMouseGestureUp) then FOnMouseGestureUp(Self); end; //=== { TJvMouseGestureHook } ================================================ constructor TJvMouseGestureHook.Create(AOwner: TComponent); begin inherited Create(AOwner); FDelay := 500; FTrailLimit := 1000; FTrailInterval := 2; FGrid := 15; FTrackColor := clRed; FTrackWidth := 5; CreateForThreadOrSystem(AOwner, MainThreadID); // hook for complete application JvMouseGestureInterpreter.Delay:=FDelay; JvMouseGestureInterpreter.Grid:=FGrid; JvMouseGestureInterpreter.TrackWidth:=FTrackWidth; JvMouseGestureInterpreter.TrackColor:=FTrackColor; JvMouseGestureInterpreter.TrailLimit:=FTrailLimit; JvMouseGestureInterpreter.TrailInterval:=FTrailInterval; end; destructor TJvMouseGestureHook.Destroy; begin FreeAndNil(JvMouseGestureInterpreter); if JvMouseGestureHookAlreadyInstalled then JvMouseGestureHookAlreadyInstalled := UnhookWindowsHookEx(JvCurrentHook); inherited Destroy; end; procedure TJvMouseGestureHook.SetTrailLimit(const Value: Integer); begin FTrailLimit := Value; if (FTrailLimit < 100) or (FTrailLimit > 10000) then FTrailLimit := 1000; JvMouseGestureInterpreter.TrailLimit:=FTrailLimit; end; procedure TJvMouseGestureHook.SetTrailInterval(const Value: Integer); begin FTrailInterval := Value; if (FTrailInterval < 1) or (FTrailInterval > 100) then FTrailInterval := 2; JvMouseGestureInterpreter.TrailInterval:=FTrailInterval; end; procedure TJvMouseGestureHook.SetDelay(const Value: Integer); begin FDelay := Value; if FDelay < 500 then FDelay := 500; JvMouseGestureInterpreter.Delay:=FDelay; end; procedure TJvMouseGestureHook.SetGrid(const Value: Integer); begin FGrid := Value; if (FGrid < 10) or (FGrid > 500) then FGrid := 15; JvMouseGestureInterpreter.Grid:=FGrid; end; procedure TJvMouseGestureHook.SetTrackColor(const Value: TColor); begin if FTrackColor <> Value then begin FTrackColor := Value; JvMouseGestureInterpreter.TrackColor:=FTrackColor; if FTrackColor = clBlack then JvMouseGestureInterpreter.FForm.Color := clWhite else JvMouseGestureInterpreter.FForm.Color := clBlack; JvMouseGestureInterpreter.FForm.TransparentColorValue := JvMouseGestureInterpreter.FForm.Color; end; end; procedure TJvMouseGestureHook.SetTrackWidth(const Value: Cardinal); begin FTrackWidth:=Value; JvMouseGestureInterpreter.TrackWidth:=FTrackWidth; end; procedure TJvMouseGestureHook.CreateForThreadOrSystem(AOwner: TComponent; ADwThreadID: Cardinal); begin if JvMouseGestureHookAlreadyInstalled then raise EJVCLException.CreateRes(@RsECannotHookTwice); JvMouseGestureInterpreter := TJvMouseGesture.Create(nil); FMouseButton := mbRight; if csDesigning in ComponentState then begin FActive := False; Exit; end; FActive := FActivationMode = amAppStart; //install hook FCurrentHook := SetWindowsHookEx(WH_MOUSE, @JvMouseGestureHook, 0, ADwThreadID); //return True if it worked (read only for user). User should never see a //global var like MouseGestureHookAlreadyInstalled FHookInstalled := FCurrentHook <> 0; // global remember, internal use only JvMouseGestureHookAlreadyInstalled := FHookInstalled; JvCurrentHook := FCurrentHook; // map event if Assigned(FOnMouseGestureCustomInterpretation) then JvMouseGestureInterpreter.OnMouseGestureCustomInterpretation := FOnMouseGestureCustomInterpretation else JvMouseGestureInterpreter.OnMouseGestureCustomInterpretation := nil; end; function TJvMouseGestureHook.DoMouseGestureCustomInterpretation(const AGesture: string): Boolean; begin Result := Assigned(FOnMouseGestureCustomInterpretation); if Result then FOnMouseGestureCustomInterpretation(Self, AGesture); end; procedure TJvMouseGestureHook.SetActivationMode(const Value: TJvActivationMode); begin FActivationMode := Value; end; procedure TJvMouseGestureHook.SetActive(const Value: Boolean); begin if csDesigning in ComponentState then FActive := False else FActive := Value; JvMouseGestureHookActive := FActive; end; procedure TJvMouseGestureHook.SetMouseButton(const Value: TMouseButton); begin FMouseButton := Value; case Value of mbLeft: begin JvMouseButtonDown := WM_LBUTTONDOWN; JvMouseButtonUp := WM_LBUTTONUP; end; mbMiddle: begin JvMouseButtonDown := WM_MBUTTONDOWN; JvMouseButtonUp := WM_MBUTTONUP; end; mbRight: begin JvMouseButtonDown := WM_RBUTTONDOWN; JvMouseButtonUp := WM_RBUTTONUP; end; end; end; procedure TJvMouseGestureHook.SetMouseGestureCustomInterpretation( const Value: TOnMouseGestureCustomInterpretation); begin FOnMouseGestureCustomInterpretation := Value; if Assigned(JvMouseGestureInterpreter) then JvMouseGestureInterpreter.OnMouseGestureCustomInterpretation := Value; end; procedure TJvMouseGestureHook.SetTrailingMouseGesture(const Value: TNotifyEvent); begin FOnCustomTrailingMouseGesture:=Value; if Assigned(JvMouseGestureInterpreter) then JvMouseGestureInterpreter.OnTrailingMouseGesture := Value; end; function TJvMouseGestureHook.GetMouseGesture: TJvMouseGesture; begin Result := JvMouseGestureInterpreter; end; //============================================================================ function JvMouseGestureHook(Code: Integer; wParam: Word; lParam: Longword): Longword; stdcall; var locY: Integer; locX: Integer; begin if (Code >= 0) and (JvMouseGestureHookActive) then begin with PMouseHookStruct(lParam)^ do begin locX := pt.X; locY := pt.Y; end; if wParam = WM_MOUSEMOVE then begin JvMouseGestureInterpreter.TrailMouseGesture(locX, locY); end; if wParam = JvMouseButtonDown then begin JvMouseGestureInterpreter.StartMouseGesture(locX, locY); end else if wParam = JvMouseButtonUp then begin JvMouseGestureInterpreter.EndMouseGesture(locX, locY); end; end; Result := CallNextHookEx(JvCurrentHook, Code, wParam, lParam); end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.