MouseMove verzögern

[Sir Rufo]

Ein Thread wird hier eigentlich nicht benötigt, es passiert doch eh alles im UI Thread.

Einfach eine Klasse, die diese Nachrichten aufnimmt und dann bei Bedarf wieder weitergibt.

Delphi-Quellcode:

unit Unit2;

interface

uses
  System.Classes,
  Vcl.ExtCtrls;

type
  TThrottleNotify<T> = procedure( Sender: TObject; const AValue: T ) of object;

  TThrottle<T> = class( TComponent )
  private const
    DefaultInterval = 50;
  private
    FCurrent       : T;
    FCurrentChanged: Boolean;
    FTimer         : TTimer;
    FOnChanged     : TThrottleNotify<T>;
    procedure TimerEvent( Sender: TObject );
    function GetInterval: Cardinal;
    procedure SetInterval( const Value: Cardinal );
  protected
    procedure DoNotify( );
  public
    property Interval : Cardinal read GetInterval write SetInterval default DefaultInterval;
    property OnChanged: TThrottleNotify<T> read FOnChanged write FOnChanged;
  public
    procedure AfterConstruction; override;
    procedure Send( const AValue: T );
  end;

implementation

{ TThrottle<T> }

procedure TThrottle<T>.AfterConstruction;
begin
  inherited;
  FTimer          := TTimer.Create( Self );
  FTimer.OnTimer  := TimerEvent;
  FTimer.Interval := DefaultInterval;
end;

procedure TThrottle<T>.DoNotify;
begin
  FCurrentChanged := False;
  if Assigned( FOnChanged )
  then
    FOnChanged( Self, FCurrent );
end;

function TThrottle<T>.GetInterval: Cardinal;
begin
  Result := FTimer.Interval;
end;

procedure TThrottle<T>.Send( const AValue: T );
begin
  FCurrent := AValue;
  if FTimer.Enabled
  then
    FCurrentChanged := True
  else
    begin
      DoNotify( );
      FTimer.Enabled := True;
    end;
end;

procedure TThrottle<T>.SetInterval( const Value: Cardinal );
begin
  FTimer.Interval := Value;
end;

procedure TThrottle<T>.TimerEvent( Sender: TObject );
begin
  FTimer.Enabled := False;
  if FCurrentChanged
  then
    DoNotify( );
end;

end.

Und dann so verwenden

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,

  Unit2;

type
  TForm1 = class( TForm )
    Label1: TLabel;
    Label2: TLabel;
    procedure FormMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer );
  private
    FCounter1, FCounter2: Integer;
    FMouseMoveThrottle  : TThrottle<TPoint>;
    procedure OnThrottledMouseMove( Sender: TObject; const APos: TPoint );
  public
    procedure AfterConstruction; override;

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
{ TForm1 }

procedure TForm1.AfterConstruction;
begin
  inherited;
  FMouseMoveThrottle           := TThrottle<TPoint>.Create( Self );
  FMouseMoveThrottle.Interval  := 100;
  FMouseMoveThrottle.OnChanged := OnThrottledMouseMove;
end;

procedure TForm1.FormMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer );
begin
  // Nur zur Info
  Inc( FCounter1 );
  Label1.Caption := Format( '%d ( %d, %d )', [ FCounter1, X, Y ] );

  FMouseMoveThrottle.Send( TPoint.Create( X, Y ) );
end;

procedure TForm1.OnThrottledMouseMove( Sender: TObject; const APos: TPoint );
begin
  // Nur zur Info
  Inc( FCounter2 );
  Label2.Caption := Format( '%d ( %d, %d )', [ FCounter2, APos.X, APos.Y ] );
end;

end.