MouseMove verzögern

[Bjoerk]

Ich hab ein MouseMove wo ziemlich viel los ist. Ich suche schon seit einiger Zeit deshalb eine Verzögerung für das MouseMove. Jetzt hab ich mir das aus den Rippen geleiert. Was haltet ihr davon???

Delphi-Quellcode:

  private
    FLastTime, FMouseMoveIgnoreTime: cardinal;
  end;

..

procedure TForm1.FormCreate(Sender: TObject);
begin
  Color := clWindow;
  FMouseMoveIgnoreTime := 10;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if (GetTickCount - FLastTime) > FMouseMoveIgnoreTime then
    Canvas.Pen.Color := clBlue // "DoWork"
  else
    Canvas.Pen.Color := clRed; // not "DoWork"
  Canvas.Brush.Color := Canvas.Pen.Color;
  Canvas.Ellipse(X - 4, Y - 4, X + 4, Y + 4);
  FLastTime := GetTickCount;
end;

[Der schöne Günther]

Wenn deine Doku hergibt dass wir über Millisekunden sprechen, warum nicht?

Und ich finde es immer unübersichtlich wenn in einem "OnXYZ"-Handler direkt wild Quellcode kommt, ich mache es immer eher so:

Delphi-Quellcode:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
   processMouseMove(X, Y)
end;

procedure TForm1.processMouseMove(const mousePosX, mousePosY: Integer);
begin
   [...]
end;

Aber naja

[Namenloser]

Deutet für mich darauf hin, dass du die Arbeit, die im MouseMove passiert, in einen Thread auslagern solltest. So passiert die aufwendige Aktualisierung so oft wie es geht, aber ohne die GUI zu blockieren.

Delphi-Quellcode:

uses
  syncobjs;

type
  TProcessingThread = class(TThread)
  protected
    FEvent: TEvent;
    FMutex: TCriticalSection;
    FSavedX, FSavedY: Integer;
    procedure Execute; override;
    procedure DoTerminate; override;
    procedure DoMouseMove(X, Y: Integer);
    procedure UpdateUI;
  public
    constructor Create;
    destructor Destroy; override;

    procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 
  end;

implementation

procedure TProcessingThread.Execute;
var
  X, Y: Integer;
begin
  while FEvent.WaitFor() and not Terminated do
  begin
    FMutex.Acquire;
    X := FSavedX;
    Y := FSavedY;
    FMutex.Release;

    DoMouseMove(X, Y);
  end;
end;

procedure TProcessingThread.DoTerminate;
begin
  inherited DoTerminate;
  FEvent.Set;
end;

procedure TProcessingThread.DoMouseMove(X, Y: Integer);
begin
  { ... actual work ... }

  Synchronize(UpdateUI);
end;

procedure TProcessingThread.UpdateUI;
begin
  { ... }
end;

constructor TProcessingThread.Create;
begin
  inherited Create(False);
  FEvent := TEvent.Create(nil, False, False, '');
  FMutex := TCriticalSection.Create;
end;

destructor TProcessingThread.Destroy;
begin
  FEvent.Free;
  FMutex.Free;
end;

procedure TProcessingThread.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  FMutex.Acquire;
  FSavedX := X;
  FSavedY := Y;
  FMutex.Release;
  FEvent.Set;
end;

Delphi-Quellcode:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  FProcessingThread.MouseMove(Sender, Shift, X, Y);
end;

Code ist ungetestet, nur eben im Beitragseditor hier geschrieben.

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

[Namenloser]

Hardgecodete Intervalle würde ich immer so gut es geht vermeiden. Rechner sind unterschiedlich schnell, der eine verkraftet mehr als der andere. Wenn jemand das Programm in 10 Jahren verwendet, ärgert er sich, weil er unnötig ausgebremst wird, obwohl das Programm seinen Rechner nicht voll auslastet.

Ich habe das Problem so verstanden, dass der Rechner nicht schnell genug ist, um die Aktualisierung bei jeder Bewegung durchzuführen, ohne dass das Benutzerinterface stockt. Da bietet es sich an, den aufwendigen Teil in einen Hintergrundthread auszulagern und asynchron zu aktualisieren, wann immer es eben geht. So bremst man nicht mehr aus als nötig.

Es passiert nicht alles im UI-Thread. Das ganze ist so gedacht, dass der Thread z.B. erst mal alles in ein Bitmap rendert (der aufwendige Teil) und dann im Synchronize nur ein BitBlt macht. Das setzt natürlich voraus, dass das BitBlt nicht der langsame Teil ist.

Angenommen, die Berechnung würde eine Sekunde dauern, dann würde mit deiner Timer-Lösung das Benutzerinterface immer noch ab und zu für eine Sekunde einfrieren, mit dem Thread aber nicht. Ganz so extrem scheinen die Verzögerungen bei Bjoerk zwar nicht zu sein, aber das Prinzip bleibt dasselbe.

[Bjoerk]

Vielen Dank. Ihr seid wie immer Klasse. Hab leider keine Generics. Wie heißt dann der TWaitResult von WaitFor()?