jvqmousegesture.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvMouseGesture.PAS, released on 2003-07-10.

The Initial Developers of the Original Code are: Christian Vogt (christian att fam-vogt dott de)
Copyright (c) 2003 by Christian Vogt
All Rights Reserved.

Portions of code based on an idea of Mozilla browser mouse gesture addon

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
  This unit implements mouse gestures. For this purpose
  actually two classes are available. one is the interpreter
  and can be used to enhance special components like a grid. In
  this case the programmer is responsible to fill matching
  OnMouseDown, OnMouseUp and OnMouseMove events of component.
  This works fine with MSWINDOWS and UNIX. The second component
  installs a hook for a specific application and fires an event
  after detecting a mouse gesture (Windows only in this version
  \:-( ).

  Programmers will get a string with the detected gesture from
  following matrix:
  <TABLE noborder>
  ==  ===  ==
  7   U    9
  L   \*   R
  1   D    3
  </TABLE>

  The asterix is the startpoint for the first vector. E.g. a
  gesture string "LU" means, user has first moved mouse to the
  left side and then up. There's no limit for complexity of a
  gesture ...

  Note
  See demo project for usage ...

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQMouseGesture.pas,v 1.17 2005/02/06 14:06:14 asnepvangers Exp $

unit JvQMouseGesture;

{$I jvcl.inc}

interface

uses
  SysUtils, Classes, QControls, QWindows, QMessages, 
  Qt, QForms, 
  JvQComponent;

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
  }
  TJvMouseGesture = class(TJvComponent)
  private
    FActive: Boolean;
    FTrailX: Integer;
    FTrailY: Integer;
    FTrailLength: Integer;
    FTrailLimit: Integer;
    FTrailActive: Boolean;
    FTrailStartTime: TDateTime;
    FdTolerance: Integer;
    FDelay: Integer;
    FTrailInterval: Integer;
    FGrid: Integer; // tolerance for diagonal movement. See TrailMouseGesture
    FGridHalf: Integer; // half of grid, needed for performance
    FLastPushed: Char;
    FGesture: string;
    FGestureList: TStringList;

    FOnMouseGestureRight: TNotifyEvent;
    FOnMouseGestureLeft: TNotifyEvent;
    FOnMouseGestureUp: TNotifyEvent;
    FOnMouseGestureDown: TNotifyEvent;
    FOnMouseGestureLeftLowerEdge: TNotifyEvent;
    FOnMouseGestureRightUpperEdge: TNotifyEvent;
    FOnMouseGestureLeftUpperEdge: TNotifyEvent;
    FOnMouseGestureRightLowerEdge: TNotifyEvent;
    FOnMouseGestureCancelled: TNotifyEvent;
    FOnMouseGestureCustomInterpretation: TOnMouseGestureCustomInterpretation;
    { Description
      Adds a detected sub gesture to gesture string
    }
    procedure AddGestureChar(AChar: Char);
    procedure SetTrailLimit(const Value: Integer);
    procedure SetTrailInterval(const Value: Integer);
    procedure SetDelay(const Value: Integer);
    procedure SetGrid(const Value: Integer);
    { 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);
  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;
    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;
    { Description
      The actual length of trail (not of gesture 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 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;
  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
  }
  TJvMouseGestureHook = class(TJvComponent)
  private
    { Description
      True if a hook is installed
    }
    FHookInstalled: Boolean;  
    FCurrentHook: QApplication_hookH; 

    FOnMouseGestureCustomInterpretation: TOnMouseGestureCustomInterpretation;
    { Description
      Field for active state of component
    }
    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 SetActivationMode(const Value: TJvActivationMode);
    procedure SetMouseGestureCustomInterpretation(const Value: TOnMouseGestureCustomInterpretation);
    function GetMouseGesture: TJvMouseGesture;
    function JvMouseGestureHook(Sender: QObjectH; Event: QEventH): Boolean; cdecl;
  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 MouseGesture: TJvMouseGesture read GetMouseGesture;
  published
    { 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;
  end;



//function JvMouseGestureHook(Sender: QObjectH; Event: QEventH): Boolean; cdecl;


implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  JvQResources, JvQTypes;

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: ButtonState = ButtonState_RightButton;
  //<combine JvMouseGestureHookAlreadyInstalled>
  JvMouseButtonUp: ButtonState = ButtonState_RightButton;

  JvCurrentHook: QApplication_hookH = nil; //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;
  FGridHalf := FGrid div 2;
  FTrailActive := False;
  FdTolerance := 75; // tolerance for diagonal movement. see processCoordinates()
  LoadGestureTable;

  FActive := not (csDesigning in ComponentState);
end;

destructor TJvMouseGesture.Destroy;
begin
  FTrailActive := False;
  FreeAndNil(FGestureList);
  inherited Destroy;
end;

procedure TJvMouseGesture.LoadGestureTable;
begin
  with FGestureList do
  begin
    AddObject('L', TObject(JVMG_LEFT));
    AddObject('R', TObject(JVMG_RIGHT));
    AddObject('U', TObject(JVMG_UP));