jvqmousegesture.pas

East make Tray Icon in delphi

    AddObject('D', TObject(JVMG_DOWN));
    AddObject('1', TObject(JVMG_LEFTLOWER));
    AddObject('3', TObject(JVMG_RIGHTLOWER));
    AddObject('7', TObject(JVMG_LEFTUPPER));
    AddObject('9', 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.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.AddGestureChar(AChar: Char);
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;

  FLastPushed := #0;
  FGesture := '';
  FTrailActive := True;
  FTrailLength := 0;
  FTrailX := AMouseX;
  FTrailY := AMouseY;
  FTrailStartTime := now;
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
      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 < 0) and (y_dir > 0) then
        begin
          AddGestureChar('1');
        end
        else
        begin
          if (x_dir > 0) and (y_dir > 0) then
            AddGestureChar('3')
          else
          begin
            if (x_dir < 0) and (y_dir < 0) then
              AddGestureChar('7')
            else
            begin
              if (x_dir > 0) and (y_dir < 0) then
                AddGestureChar('9');
            end;
          end;
        end;
      end // of diaognal
      else
      begin
        // horizontal movement:
        if locX > locY then
        begin
          if x_dir > 0 then
            AddGestureChar('R')
          else
          begin
            if x_dir < 0 then
              AddGestureChar('L');
          end;
        end
        else
        begin
          // vertical movement:
          if locX < locY then
          begin
            if y_dir > 0 then
              AddGestureChar('D')
            else
            begin
              if y_dir < 0 then
                AddGestureChar('U');
            end;
          end;
        end;
      end;
    end; // of half grid
  finally
    FTrailX := AMouseX;
    FTrailY := AMouseY;
  end;
end;

procedure TJvMouseGesture.EndMouseGesture;
var
  Index: Integer;
begin
  if not FActive then
    Exit;

  FTrailActive := False;

  if FGesture = '' then
  begin
    DoMouseGestureCancelled;
    Exit;
  end;

  // check for custom interpretation first
  if DoMouseGestureCustomInterpretation(FGesture) then
    Exit;

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

function TJvMouseGesture.DoMouseGestureCustomInterpretation(const AGesture: string): Boolean;
begin
   Result := Assigned(FOnMouseGestureCustomInterpretation);
   if Result then
     FOnMouseGestureCustomInterpretation(Self, FGesture);
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);
  CreateForThreadOrSystem(AOwner, MainThreadID); // hook for complete application
end;

destructor TJvMouseGestureHook.Destroy;
begin
  FreeAndNil(JvMouseGestureInterpreter);

  if JvMouseGestureHookAlreadyInstalled then  
  begin
    QApplication_hook_destroy(JvCurrentHook);
    JvMouseGestureHookAlreadyInstalled := False;
  end;
  inherited Destroy;
end;

procedure TJvMouseGestureHook.CreateForThreadOrSystem(AOwner: TComponent; ADwThreadID: Cardinal);

var
  Method: TMethod;

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;
  
  FCurrentHook := InstallApplicationEventHook(JvMouseGestureHook);
  JvMouseGestureHookAlreadyInstalled := True;
  FHookInstalled := True;
  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 := ButtonState_LeftButton;
        JvMouseButtonUp := ButtonState_LeftButton;
      end;
    mbMiddle:
      begin
        JvMouseButtonDown := ButtonState_MidButton;
        JvMouseButtonUp := ButtonState_MidButton;
      end;
    mbRight:
      begin
        JvMouseButtonDown := ButtonState_RightButton;
        JvMouseButtonUp := ButtonState_RightButton;
      end;
  end; 
end;

procedure TJvMouseGestureHook.SetMouseGestureCustomInterpretation(
  const Value: TOnMouseGestureCustomInterpretation);
begin
  FOnMouseGestureCustomInterpretation := Value;
  if Assigned(JvMouseGestureInterpreter) then
    JvMouseGestureInterpreter.OnMouseGestureCustomInterpretation := Value;
end;

function TJvMouseGestureHook.GetMouseGesture: TJvMouseGesture;
begin
  Result := JvMouseGestureInterpreter;
end;

//============================================================================




function TJvMouseGestureHook.JvMouseGestureHook(Sender: QObjectH; Event: QEventH): Boolean;
var
  locY: Integer;
  locX: Integer;
  etype: QEventType;
  Btn: ButtonState;
begin
  Result := False;
  if not JvMouseGestureHookActive then
    Exit;

  etype := QEvent_type(Event);
  case etype of
    QEventType_MouseButtonPress,
    QEventType_MouseButtonRelease,
    QEventType_MouseMove:
      begin
        locX := QMouseEvent_globalX(QMouseEventH(Event));
        locY := QMouseEvent_globalY(QMouseEventH(Event));
        Btn := QMouseEvent_button(QMouseEventH(Event));
        case etype of
          QEventType_MouseMove:
            JvMouseGestureInterpreter.TrailMouseGesture(locX, locY);
          QEventType_MouseButtonPress:
            begin
              if Btn = JvMouseButtonDown then
                JvMouseGestureInterpreter.StartMouseGesture(locX, locY);
            end;
          QEventType_MouseButtonRelease:
            begin
              if Btn = JvMouseButtonUp then
                JvMouseGestureInterpreter.EndMouseGesture;
            end;
        end;
        Result := True;
      end;
  end;
end;


{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQMouseGesture.pas,v $';
    Revision: '$Revision: 1.17 $';
    Date: '$Date: 2005/02/06 14:06:14 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.