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()?

[Bjoerk]

Ich habs jetzt anders. So wollte ichs eigentlich lassen. Soll so eine Art dynamischer Timer sein (Basiert auf DeddyH’s TWaitCounter).

Delphi-Quellcode:

  TWaitCounterEx = class
  private
    FStart, FStop, FFrequency: Int64;
    FStartTime, FStopTime, FWaitTime: double;
    FSuccess: boolean;
    function GetCanWaitTimer: boolean;
  public
    procedure Start;
    procedure Stop;
    property WaitTime: double read FWaitTime;
    property CanWaitTimer: boolean read GetCanWaitTimer;
    constructor Create;
  end;

..

{ TWaitCounterEx }

constructor TWaitCounterEx.Create;
begin
  FSuccess := QueryPerformanceFrequency(FFrequency);
end;

procedure TWaitCounterEx.Start;
begin
  if FSuccess and QueryPerformanceCounter(FStart) then
    FStartTime := FStart / FFrequency;
end;

procedure TWaitCounterEx.Stop;
begin
  if FSuccess and QueryPerformanceCounter(FStop) then
  begin
    FStopTime := FStop / FFrequency;
    FWaitTime := (FStop - FStart) / FFrequency;
  end;
end;

function TWaitCounterEx.GetCanWaitTimer: boolean;
begin
  // NewStartTime - OldStopTime >= OldWaitTime;
  Result := not FSuccess or (CompareValue(FStartTime - FStopTime, FWaitTime, 1E-8) >= 0);
end;

(*
procedure TSomeForm.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  FWaitCounter.Start;
  try
    if FWaitCounter.CanWaitTimer then
    begin
      ..
    end;
  finally
    FWaitCounter.Stop;
  end;
end;
*)

[Namenloser]

Zitat von Bjoerk:

Wie heißt dann der TWaitResult von WaitFor()?

Du hast es zwar jetzt anders gelöst, aber: Ja, hatte ich vergessen, dass man das noch auswerten muss. Wobei das Resultat an der Stelle eigentlich fast egal ist. Die Zeile müsste korrekt heißen:

while (FEvent.WaitFor(INFINITE) = wrSignaled) and not Terminated do

[Sir Rufo]

@Namenloser

In deinem Thread fehlt noch das inherited im Destroy . Das muss vor den Freigaben aufgerufen werden!

[Namenloser]

Zitat von Sir Rufo:

@Namenloser

In deinem Thread fehlt noch das inherited im Destroy . Das muss vor den Freigaben aufgerufen werden!

Wieso vorher? Das inherited kommt im Destructor immer zum Schluss.

...

Achso, ich glaube, ich weiß was du meinst... ich erinnere mich, dass TThread in seinem Destructor irgendeinen Voodoo macht, der den Thread vorher noch terminiert und auf das Ende wartet, bevor er ihn wirklich freigibt.

Da halte ich aber nichts von, weil es im Destructor zu Problemen mit der Reihenfolge führen kann, wenn man von einem abgeleiteten Thread nochmals ableitet. Deshalb mache ich das schon lange nicht mehr so. Das inherited kommt, wie bei allen Klassen, zum Schluss, und ich gebe meine Threads dafür immer nach dem folgenden Muster frei:

1. Terminate
2. WaitFor
3. Free

So sind die einzelnen Phasen klar voneinander getrennt und man hat keine Probleme. Hat außerdem den Vorteil, dass man nach dem gleichen Schema mehrere Threads parallel beenden kann, ohne dass man mehrfach warten muss.