Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
lazarus / usr / share / lazarus / 1.6 / components / mouseandkeyinput / mouseinputintf.pas
Size: Mime:
{ MouseInputIntf

  Copyright (C) 2008 Tom Gregorovic

  This source is free software; you can redistribute it and/or modify it under the terms of the
  GNU General Public License as published by the Free Software Foundation; either version 2 of the
  License, or (at your option) any later version.

  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
  even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  General Public License for more details.

  A copy of the GNU General Public License is available on the World Wide Web at
  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit MouseInputIntf;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Controls, Forms;
  
type
  { TMouseInput }

  TMouseInput = class
  protected
    procedure DoDown(Button: TMouseButton); dynamic; abstract;
    procedure DoMove(ScreenX, ScreenY: Integer); dynamic; abstract;
    procedure DoUp(Button: TMouseButton); dynamic; abstract;
  public
    procedure Down(Button: TMouseButton; Shift: TShiftState);
    procedure Down(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
    procedure Down(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
    
    procedure Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0);
    procedure MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0);
    procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer);
    procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer);


    procedure Up(Button: TMouseButton; Shift: TShiftState);
    procedure Up(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
    procedure Up(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
    
    procedure Click(Button: TMouseButton; Shift: TShiftState);
    procedure Click(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
    procedure Click(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
    
    procedure DblClick(Button: TMouseButton; Shift: TShiftState);
    procedure DblClick(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
    procedure DblClick(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
  end;

implementation

uses
  Math, MouseAndKeyInput, LCLIntf;

{ TMouseInput }

procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState);
begin
  KeyInput.Apply(Shift);
  try
    DoDown(Button);
  finally
    KeyInput.Unapply(Shift);
  end;
  Application.ProcessMessages;
end;

procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState;
  Control: TControl; X, Y: Integer);
var
  P: TPoint;
begin
  P := Control.ClientToScreen(Point(X, Y));
  Down(Button, Shift, P.X, P.Y);
end;

procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState;
  ScreenX, ScreenY: Integer);
begin
  KeyInput.Apply(Shift);
  try
    DoMove(ScreenX, ScreenY);
    DoDown(Button);
  finally
    KeyInput.Unapply(Shift);
  end;
end;

procedure TMouseInput.Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0);
var
  P: TPoint;
begin
  P := Control.ClientToScreen(Point(X, Y));
  Move(Shift, P.X, P.Y, Duration);
end;

procedure TMouseInput.MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0);
var
  P: TPoint;
begin
  P := Mouse.CursorPos;
  Move(Shift, P.X + DX, P.Y + DY, Duration);
end;

procedure TMouseInput.Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer);
const
  Interval = 20; //ms
var
  TimeStep: Integer;
  X, Y: Integer;
  Start: TPoint;
  S: LongWord;
begin
  Start := Mouse.CursorPos;
  
  while Duration > 0 do
  begin
    TimeStep := Min(Interval, Duration);

    S := GetTickCount;
    while GetTickCount - S < TimeStep do Application.ProcessMessages;
    
    X := Start.X + ((ScreenX - Start.X) * TimeStep) div Duration;
    Y := Start.Y + ((ScreenY - Start.Y) * TimeStep) div Duration;
    Move(Shift, X, Y);

    Duration := Duration - TimeStep;
    Start := Point(X, Y);
  end;
  
  Move(Shift, ScreenX, ScreenY);
end;

procedure TMouseInput.Move(Shift: TShiftState; ScreenX, ScreenY: Integer);
begin
  KeyInput.Apply(Shift);
  try
    DoMove(ScreenX, ScreenY);
  finally
    KeyInput.Unapply(Shift);
  end;
  Application.ProcessMessages;
end;

procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState);
begin
  KeyInput.Apply(Shift);
  try
    DoUp(Button);
  finally
    KeyInput.Unapply(Shift);
  end;
  Application.ProcessMessages;
end;

procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState;
  Control: TControl; X, Y: Integer);
var
  P: TPoint;
begin
  P := Control.ClientToScreen(Point(X, Y));
  Up(Button, Shift, P.X, P.Y);
end;

procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState;
  ScreenX, ScreenY: Integer);
begin
  Move(Shift, ScreenX, ScreenY);
  Up(Button, Shift);
end;

procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState);
begin
  Down(Button, Shift);
  Up(Button, Shift);
end;

procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState;
  Control: TControl; X, Y: Integer);
var
  P: TPoint;
begin
  P := Control.ClientToScreen(Point(X, Y));
  Click(Button, Shift, P.X, P.Y);
end;

procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState;
  ScreenX, ScreenY: Integer);
begin
  Move(Shift, ScreenX, ScreenY);
  Click(Button, Shift);
end;

procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState);
begin
  Click(Button, Shift);
  Click(Button, Shift);
end;

procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState;
  Control: TControl; X, Y: Integer);
var
  P: TPoint;
begin
  P := Control.ClientToScreen(Point(X, Y));
  DblClick(Button, Shift, P.X, P.Y);
end;

procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState;
  ScreenX, ScreenY: Integer);
begin
  Move(Shift, ScreenX, ScreenY);
  DblClick(Button, Shift);
end;



end.