一种居于JvMouseGesture.pas的鼠标手势系统

来源:转载

尽管高版本的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.

改造过的JvMouseGesture

增加了几个东西:

FForm: TForm:用于绘制显示手势规矩

FTrackWidth: Cardinal;手势轨迹宽度
FTrackColor: TColor;手势轨迹颜色

此外主要改造了以下几个过程、函数

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;


 

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.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;

StartMouseGesture

这个地方也改造了

 

此外还定义了一个新的组件,以方便用户自定义鼠标手势,其代码如下:

unit UWSGestureREC;

interface

uses

Windows,SysUtils, Messages ,Classes, Controls,Graphics,GraphUtil,

Generics.Collections,Math,Dialogs;

type

TGesturePoints = TList<TPoint>;

TOnMouseGestureCustomInterpretation = procedure(Sender: TObject;const AGesture: string) of object;

TCustomUWSGestureRecord = class(TCustomControl)

private

{ Private declarations }

FGesture:string;

FGestureLineColor: TColor;

FGesturePointColor: TColor;

FLastDrawnPoint: Integer;

FPoints: TGesturePointArray;

FRecordedPoints: TGesturePoints;

FRecording: Boolean;

FPlaying:Boolean ;

FCaption: string;

FLastPushed: String;

FTrailX: Integer;

FTrailY: Integer;

FTrailLength: Integer;

FTrailActive: Boolean;

FTrailStartTime: TDateTime;

FdTolerance: Integer;

FTrailLimit: Integer;

FGridHalf: Integer;

FStandardGestures:TStringList;

FBasicGestures:TStringList;

FGestureFileName:string;

FOnMouseGestureCustomInterpretation: TOnMouseGestureCustomInterpretation;

FOnTrailingGesture: TOnMouseGestureCustomInterpretation;

procedure AddGesturePoint(const LastPoint, NextPoint: TPoint);

function PointsToArray(Source: TGesturePoints): TGesturePointArray;

procedure SetCaption(const Value: string);

procedure SetGestureLineColor(const Value: TColor);

procedure SetGesturePointColor(const Value: TColor);

procedure ShortGesture;

protected

{ Protected declarations }

procedure DrawPoint(const Point: TPoint); virtual;

procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;

procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

procedure Paint; override;

procedure WndProc(var Message: TMessage); override;

function DoMouseGestureCustomInterpretation(const AGesture: string): Boolean; virtual;

function DoTrailingGesture(const AGesture: string): Boolean; virtual;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

function NormalizePoints(const Points: array of TPoint): TGesturePointArray;

procedure AddGestureChar(AChar: String);

procedure StartMouseGesture(AMouseX, AMouseY: Integer);

procedure TrailMouseGesture(AMouseX, AMouseY: Integer);

procedure EndMouseGesture(AMouseX, AMouseY: Integer);

procedure Play;

procedure PlayStandard(aGesture:String);

procedure ReRestSize;

procedure PlayFromFile(aGestureFile:String);

procedure SaveGesturePointtoFile(aGPFile:String);

function IsStandardGesture(aGesture:String):Boolean;

function GesturetoGestureFileName(aGesture:String):string;

procedure ExpoertStandardGesture2List(Items:TStrings);

property RecordedPoints: TGesturePoints read FRecordedPoints write FRecordedPoints;

property Caption: string read FCaption write SetCaption;

property Gesture:string read FGesture write FGesture;

property GestureLineColor: TColor read FGestureLineColor

write SetGestureLineColor default clBlue;

property GesturePointColor: TColor read FGesturePointColor

write SetGesturePointColor default clBlue;

property GestureFileName:string read FGestureFileName;

property OnMouseGestureCustomInterpretation: TOnMouseGestureCustomInterpretation read

FOnMouseGestureCustomInterpretation write FOnMouseGestureCustomInterpretation;

property OnTrailingGesture: TOnMouseGestureCustomInterpretation read

FOnTrailingGesture write FOnTrailingGesture;

property StandardGestures:TStringList read FStandardGestures;

published

{ Published declarations }

end;

TUWSGestureRecord = class(TCustomUWSGestureRecord)

private

{ Private declarations }

protected

{ Protected declarations }

public

{ Public declarations }

published

{ Published declarations }

property Align;

property Anchors;

property BevelEdges;

property BevelInner;

property BevelOuter;

property BevelKind default bkNone;

property BevelWidth;

property BiDiMode;

property Caption;

property Color;

property Constraints;

property Ctl3D;

property DoubleBuffered default True;

property DragCursor;

property DragKind;

property DragMode;

property Enabled;

property Font;

property GestureLineColor;

property GesturePointColor;

property Height default 200;

property ParentBiDiMode;

property ParentColor;

property ParentDoubleBuffered default False;

property ParentFont;

property ParentShowHint;

property PopupMenu;

property ShowHint;

property Visible;

property Width default 200;

property OnClick;

property OnContextPopup;

property OnEndDock;

property OnEndDrag;

property OnGesture;

property OnDragDrop;

property OnDragOver;

property OnMouseActivate;

property OnMouseDown;

property OnMouseEnter;

property OnMouseLeave;

property OnMouseMove;

property OnMouseUp;

property OnResize;

property OnStartDock;

property OnStartDrag;

property OnMouseGestureCustomInterpretation;

property OnTrailingGesture;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('uws Used', [TUWSGestureRecord]);

end;

constructor TCustomUWSGestureRecord.Create(AOwner: TComponent);

begin

inherited;

AlignWithMargins:=True;

Margins.Top:=7;

Margins.Bottom:=7;

Margins.Left:=7;

Margins.Right:=7;

FGesture :='';

FGestureLineColor := clBlue;

FGesturePointColor := clBlue;

FRecordedPoints := TGesturePoints.Create;

FTrailLimit := 1000;

FGridHalf := 8;

FTrailActive := False;

FdTolerance := 75; // tol

FRecording := False;

Height := 200;

Width := 200;

ControlStyle := ControlStyle - [csGestures];

DoubleBuffered := True;

ParentDoubleBuffered := False;

FStandardGestures:=TStringList.Create;

FStandardGestures.Add('→向右');

FStandardGestures.Add('→向左');

FStandardGestures.Add('→向上');

FStandardGestures.Add('→向下');

FStandardGestures.Add('→向右斜上');

FStandardGestures.Add('→向右斜下');

FStandardGestures.Add('→向左斜上');

FStandardGestures.Add('→向左斜下');

FStandardGestures.Add('→向下→向右');

FStandardGestures.Add('→向下→向左');

FStandardGestures.Add('→向上→向右');

FStandardGestures.Add('→向上→向左');

FStandardGestures.Add('→向右→向下');

FStandardGestures.Add('→向左→向下');

FStandardGestures.Add('→向右→向上');

FStandardGestures.Add('→向左→向上');

FStandardGestures.Add('→向右→向左');

FStandardGestures.Add('→向左→向右');

FStandardGestures.Add('→向下→向上');

FStandardGestures.Add('→向上→向下');

FBasicGestures:=TStringList.Create;

FBasicGestures.Add('向右');

FBasicGestures.Add('向左');

FBasicGestures.Add('向上');

FBasicGestures.Add('向下');

FBasicGestures.Add('向右斜上');

FBasicGestures.Add('向右斜下');

FBasicGestures.Add('向左斜上');

FBasicGestures.Add('向左斜下');

end;

destructor TCustomUWSGestureRecord.Destroy;

begin

FreeAndNil(FRecordedPoints);

FreeAndNil(FStandardGestures);

FreeAndNil(FBasicGestures);

inherited;

end;

procedure TCustomUWSGestureRecord.ReRestSize;

begin

if Height<200 then

Height:=200;

if Width<200 then

Width:=200;

if Height<>width then

Height:=Width ;

end;

procedure TCustomUWSGestureRecord.Play;

var

I:Integer;

LRect: TRect;

begin

FPlaying:=True;

LRect := ClientRect;

Canvas.Brush.Color := Color;

Canvas.FillRect(LRect);

if FRecordedPoints.Count>0 then

begin

Canvas.MoveTo(FRecordedPoints[0].X, FRecordedPoints[0].Y);

for I := 0 to FRecordedPoints.Count - 1 do

begin

DrawPoint(FRecordedPoints[I]);

Sleep(10);

end;

end;

FPlaying:=False;

end;

procedure TCustomUWSGestureRecord.PlayStandard(aGesture:String);

var

I,K,CC:Integer;

LRect: TRect;

begin

if aGesture='' then Exit;

FPlaying:=True;

CC:=Min(Width,Height);

LRect := ClientRect;

Canvas.Brush.Color := Color;

Canvas.FillRect(LRect);

if aGesture='→向右' then

begin

Canvas.MoveTo(20, Height div 2);

for I := 20 to Width-20 do

begin

DrawPoint(Point(I,Height div 2));

Sleep(1);

end;

end

else if aGesture='→向左' then

begin

Canvas.MoveTo(Width-20, Height div 2);

for I := Width-20 downto 20 do

begin

DrawPoint(Point(I,Height div 2));

Sleep(1);

end;

end

else if aGesture='→向下' then

begin

Canvas.MoveTo(Width div 2, 20);

for I := 20 to Height-20 do

begin

DrawPoint(Point(Width div 2,I));

Sleep(1);

end;

end

else if aGesture='→向上' then

begin

Canvas.MoveTo(Width div 2, Height-20);

for I := Height-20 downto 20 do

begin

DrawPoint(Point(Width div 2,I));

Sleep(1);

end;

end

else if aGesture='→向右斜下' then

begin

Canvas.MoveTo(20, 20);

for I := 20 to CC-20 do

begin

DrawPoint(Point(I,I));

Sleep(1);

end;

end

else if aGesture='→向右斜上' then

begin

Canvas.MoveTo(20, Height-20);

for I := 20 to CC-20 do

begin

DrawPoint(Point(I,Height-I));

Sleep(1);

end;

end

else if aGesture='→向左斜下' then

begin

Canvas.MoveTo(Width-20, 20);

for I := 20 to CC-20 do

begin

DrawPoint(Point(Width-I,I));

Sleep(1);

end;

end

else if aGesture='→向左斜上' then

begin

Canvas.MoveTo(Width-20, Height-20);

for I := 20 to CC-20 do

begin

DrawPoint(Point(Width-I,Height-I));

Sleep(1);

end;

end

else if aGesture='→向下→向右' then

begin

Canvas.MoveTo(60, 60);

for I := 60 to CC-60 do

begin

DrawPoint(Point(60,I));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(I,Height-60));

Sleep(1);

end;

end

else if aGesture='→向下→向左' then

begin

Canvas.MoveTo(width-60,60);

for I := 60 to CC-60 do

begin

DrawPoint(Point(width-60,I));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(width-I,Height-60));

Sleep(1);

end;

end

else if aGesture='→向上→向右' then

begin

Canvas.MoveTo(60,Height-60);

for I := 60 to CC-60 do

begin

DrawPoint(Point(60,Height-I));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(I,60));

Sleep(1);

end;

end

else if aGesture='→向上→向左' then

begin

Canvas.MoveTo(Width-60,Height-60);

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width-60,Height-I));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width-I,60));

Sleep(1);

end;

end

else if aGesture='→向左→向上' then

begin

Canvas.MoveTo(Width-60,Height-60);

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width-I,Height-60));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(60,Height-I));

Sleep(1);

end;

end

else if aGesture='→向左→向下' then

begin

Canvas.MoveTo(Width-60,60);

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width-I,60));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(60,I));

Sleep(1);

end;

end

else if aGesture='→向右→向上' then

begin

Canvas.MoveTo(60,Height-60);

for I := 60 to CC-60 do

begin

DrawPoint(Point(I,Height-60));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width-60,Height-I));

Sleep(1);

end;

end

else if aGesture='→向右→向下' then

begin

Canvas.MoveTo(60,60);

for I := 60 to CC-60 do

begin

DrawPoint(Point(I,60));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width-60,I));

Sleep(1);

end;

end

else if aGesture='→向右→向左' then

begin

Canvas.MoveTo(60,Height div 2);

for I := 60 to CC-60 do

begin

DrawPoint(Point(I,Height div 2));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width-I,Height div 2));

Sleep(1);

end;

end

else if aGesture='→向左→向右' then

begin

Canvas.MoveTo(Width-60,Height div 2);

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width-I,Height div 2));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(I,Height div 2));

Sleep(1);

end;

end

else if aGesture='→向下→向上' then

begin

Canvas.MoveTo(Width div 2,60);

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width div 2,I));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width div 2,Height-I));

Sleep(1);

end;

end

else if aGesture='→向上→向下' then

begin

Canvas.MoveTo(Width div 2,Height-60);

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width div 2,Height-I));

Sleep(1);

end;

for I := 60 to CC-60 do

begin

DrawPoint(Point(Width div 2,I));

Sleep(1);

end;

end;

FPlaying:=False;

end;

function TCustomUWSGestureRecord.IsStandardGesture(aGesture:String):Boolean;

begin

Result:=False ;

if aGesture='' then Exit;

Result:=(FStandardGestures.IndexOf(aGesture)<>-1);

end;

function TCustomUWSGestureRecord.GesturetoGestureFileName(aGesture:String):string;

var

Temp:TStringList;

I,ID:Integer;

begin

Result:='';

if aGesture='' then Exit;

Temp:=TStringList.Create;

try

Temp.Delimiter:='';

Temp.DelimitedText:=aGesture;

for I := 0 to Temp.Count-1 do

begin

if Temp[I]<>'' then

begin

ID:=FBasicGestures.IndexOf(Temp[I]);

Result:=Result+InttoStr(ID);

end;

end;

finally

Temp.Free;

end;

Result:=Result+'.GPS';

end;

procedure TCustomUWSGestureRecord.ExpoertStandardGesture2List(Items:TStrings);

begin

Items.Assign(FStandardGestures);

end;

procedure TCustomUWSGestureRecord.SaveGesturePointtoFile(aGPFile:String);

var

I:Integer;

Temp:TStringList;

begin

if aGPFile='' then

aGPFile:='123.GPS';

if FRecordedPoints.Count<1 then Exit;

Temp:=TStringList.Create ;

try

for I := 0 to FRecordedPoints.Count-1 do

begin

Temp.Add(Format('X%d=%d',[I,FRecordedPoints[I].X]));

Temp.Add(Format('Y%d=%d',[I,FRecordedPoints[I].Y]));

end;

Temp.SaveToFile(aGPFile);

finally

Temp.Free;

end;

end;

procedure TCustomUWSGestureRecord.PlayFromFile(aGestureFile:String);

var

I,CC,X,Y:Integer ;

Temp:TStringList;

LRect: TRect;

begin

if aGestureFile='' then Exit;

if not FileExists(aGestureFile) then Exit;

LRect := ClientRect;

Canvas.Brush.Color := Color;

Canvas.FillRect(LRect);

Temp:=TStringList.Create;

try

try

Temp.LoadFromFile(aGestureFile);

except

end;

if Temp.Count>1 then

begin

CC:=Temp.Count div 2;

X:=0;

Y:=0;

try

X:=StrToInt(Temp.Values['X0']);

Y:=StrToInt(Temp.Values['Y0']);

except

end;

Canvas.MoveTo(X,Y);

for I := 0 to CC-1 do

begin

X:=0;

Y:=0;

try

X:=StrToInt(Temp.Values[Format('X%d',[I])]);

Y:=StrToInt(Temp.Values[Format('Y%d',[I])]);

except

end;

DrawPoint(Point(X,Y));

Sleep(10);

end;

end;

finally

Temp.Free;

end;

end;

procedure TCustomUWSGestureRecord.AddGestureChar(AChar: String);

begin

if AChar <> FLastPushed then

begin

FGesture := FGesture +''+ AChar;

FLastPushed := AChar;

end;

end;

procedure TCustomUWSGestureRecord.AddGesturePoint(const LastPoint, NextPoint: TPoint);

var

StepX, StepY: Single;

I, DeltaX, DeltaY: Integer;

CountX, CountY, Count: Integer;

begin

// Determine distance between points

DeltaX := Abs(NextPoint.X - LastPoint.X);

DeltaY := Abs(NextPoint.Y - LastPoint.Y);

// If points are too close together discard the new point

if (DeltaX < 4) and (DeltaY < 4) then

Exit;

// If points are too far apart insert intermediate points

if (DeltaX > 8) or (DeltaY > 8) then

begin

// Determine how many points to insert

CountX := DeltaX div 5;

if (DeltaX mod 5) = 0 then

Dec(CountX);

CountY := DeltaY div 5;

if (DeltaY mod 5) = 0 then

Dec(CountY);

Count := Max(CountX, CountY);

// Determine spacing between inserted points

StepX := (NextPoint.X - LastPoint.X) / Count;

StepY := (NextPoint.Y - LastPoint.Y) / Count;

// Insert points

for I := 1 to Count - 1 do

FRecordedPoints.Add(Point(LastPoint.X + Round(StepX * I),

LastPoint.Y + Round(StepY * I)));

end;

// Add captured point

FRecordedPoints.Add(NextPoint);

end;

function TCustomUWSGestureRecord.PointsToArray(Source: TGesturePoints): TGesturePointArray;

var

I: Integer;

begin

SetLength(Result, Source.Count);

for I := 0 to Source.Count - 1 do

Result[I] := Source[I];

end;

procedure TCustomUWSGestureRecord.SetCaption(const Value: string);

begin

if Value <> FCaption then

begin

FCaption := Value;

Invalidate;

end;

end;

procedure TCustomUWSGestureRecord.StartMouseGesture(AMouseX, AMouseY: Integer);

begin

// Set recording mode

FRecording := True;

Invalidate;

// Clear list of points

FRecordedPoints.Clear;

FRecordedPoints.Add(Point(AMouseX, AMouseY));

DrawPoint(FRecordedPoints[0]);

FLastDrawnPoint := 0;

FLastPushed := #0;

FGesture := '';

FTrailActive := True;

FTrailLength := 0;

FTrailX := AMouseX;

FTrailY := AMouseY;

FTrailStartTime := now;

end;

procedure TCustomUWSGestureRecord.ShortGesture;

var

TempStr:string;

Temp:TStringList;

I:Integer;

begin

Temp:=TStringList.Create;

try

Temp.Delimiter:='';

Temp.DelimitedText:=FGesture;

if Temp.Count>8 then

begin

for I := 1 to 8 do

TempStr:=TempStr+''+temp[I];

FGesture:=TempStr;

end;

finally

Temp.Free;

end;

end;

procedure TCustomUWSGestureRecord.EndMouseGesture(AMouseX, AMouseY: Integer);

var

Index: Integer;

begin

if not FRecording then

Exit;

FTrailActive := False;

FRecording := False;

// Add new gesture point

AddGesturePoint(FRecordedPoints[FRecordedPoints.Count - 1], Point(AMouseX, AMouseY));

// Normalize list of points

FPoints := NormalizePoints(PointsToArray(FRecordedPoints));

ShortGesture;

FCaption:=FGesture ;

// Trigger OnRecorded event if more than 1 point was recorded

if (Length(FPoints) > 1) then

begin

end;

FGestureFileName:=GesturetoGestureFileName(FGesture);

DoMouseGestureCustomInterpretation(FGesture);

// Force repaint

Invalidate;

end;

procedure TCustomUWSGestureRecord.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;

I:Integer;

function InBetween(AValue, AMin, AMax: Double): Boolean;

begin

Result := (AValue >= AMin) and (AValue <= AMax);

end;

begin

if not FRecording then

Exit;

// Add new gesture point

AddGesturePoint(FRecordedPoints[FRecordedPoints.Count - 1], Point(AMouseX, AMouseY));

for I := FLastDrawnPoint to FRecordedPoints.Count - 1 do

DrawPoint(FRecordedPoints[I]);

FLastDrawnPoint := FRecordedPoints.Count - 1;

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

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 < -6) and (y_dir > 6) then

begin

AddGestureChar('向左斜下');

end

else

begin

if (x_dir > 6) and (y_dir > 6) then

AddGestureChar('向右斜下')

else

begin

if (x_dir < -6) and (y_dir < -6) then

AddGestureChar('向左斜上')

else

begin

if (x_dir > 6) and (y_dir < -6) 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;

DoTrailingGesture(FGesture);

end;

procedure TCustomUWSGestureRecord.SetGestureLineColor(const Value: TColor);

begin

if Value <> FGestureLineColor then

begin

FGestureLineColor := Value;

Invalidate;

end;

end;

procedure TCustomUWSGestureRecord.SetGesturePointColor(const Value: TColor);

begin

if Value <> FGesturePointColor then

begin

FGesturePointColor := Value;

Invalidate;

end;

end;

procedure TCustomUWSGestureRecord.DrawPoint(const Point: TPoint);

begin

Canvas.Brush.Style := bsClear;

Canvas.Pen.Width:=17;

Canvas.Pen.Color := FGesturePointColor;

Canvas.Ellipse(Point.X - 2, Point.Y - 2, Point.X + 3, Point.Y + 3);

Canvas.Pen.Color := FGestureLineColor;

if FRecordedPoints.Count = 1 then

Canvas.MoveTo(Point.X, Point.Y)

else

Canvas.LineTo(Point.X, Point.Y);

end;

procedure TCustomUWSGestureRecord.MouseDown(Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if Button<>mbLeft then Exit;

StartMouseGesture(X,Y);

end;

procedure TCustomUWSGestureRecord.MouseMove(Shift: TShiftState; X, Y: Integer);

begin

TrailMouseGesture(X,Y);

end;

function TCustomUWSGestureRecord.NormalizePoints(

const Points: array of TPoint): TGesturePointArray;

var

Index, SmallestX, SmallestY: Integer;

begin

SetLength(Result, Length(Points));

// Find the delta.

SmallestX := MaxInt;

SmallestY := MaxInt;

for Index := 0 to Length(Points) - 1 do

begin

if SmallestX > Points[Index].X then

SmallestX := Points[Index].X;

if SmallestY > Points[Index].Y then

SmallestY := Points[Index].Y;

end;

// Apply the delta.

SetLength(Result, Length(Points));

for Index := 0 to Length(Points) - 1 do

Result[Index] := Point(Points[Index].X - SmallestX, Points[Index].Y - SmallestY);

end;

procedure TCustomUWSGestureRecord.MouseUp(Button: TMouseButton; Shift: TShiftState;

X, Y: Integer);

begin

EndMouseGesture(X,Y);

end;

procedure TCustomUWSGestureRecord.WndProc(var Message: TMessage);

begin

inherited WndProc(Message);

end;

procedure TCustomUWSGestureRecord.Paint;

var

LRect: TRect;

LText: string;

I, LTextHeight: Integer;

begin

LRect := ClientRect;

Canvas.Brush.Color := Color;

Canvas.FillRect(LRect);

if (not FRecording) and (not FPlaying) then

begin

// Draw instructions

Canvas.Font := Self.Font;

Canvas.Brush.Style := bsClear;

if FCaption='' then

FCaption:=FGesture ;

LText := FCaption;

if (csDesigning in ComponentState) and (LText = '') then

LText := Name;

InflateRect(LRect, -25, 0);

LRect.Top := 0;

LRect.Bottom := 0;

Canvas.TextRect(LRect, LText, [tfCalcRect, tfWordBreak]);

LRect.Right := Width - 25;

LTextHeight := LRect.Bottom - LRect.Top;

LRect.Top := (Height - LTextHeight) div 2;

Inc(LRect.Bottom, LRect.Top);

Canvas.TextRect(LRect, LText, [tfCenter, tfWordBreak]);

end

else

begin

// Draw points

for I := 0 to FRecordedPoints.Count - 1 do

DrawPoint(FRecordedPoints[I])

end;

end;

function TCustomUWSGestureRecord.DoMouseGestureCustomInterpretation(const AGesture: string): Boolean;

begin

Result := Assigned(FOnMouseGestureCustomInterpretation);

if Result then

begin

FOnMouseGestureCustomInterpretation(Self,FGesture);

end;

end;

function TCustomUWSGestureRecord.DoTrailingGesture(const AGesture: string): Boolean;

begin

Result := Assigned(FOnTrailingGesture);

if Result then

begin

FOnTrailingGesture(Self,FGesture);

end;

end;

end.

管理单元代码

 改造过的JvMouseGesture.pas和鼠标手势定义组件下载:

JvMouseGesture.pas

UWSGestureREC

 

效果图

 

暂时就记录到这里

 代码在Delphi XE中测试通过,其他版本未经测试


分享给朋友:
您可能感兴趣的文章:
随机阅读: