Programm verbraucht zuviel Prozessorleistung - Wie kann ich Lag verhindern?

[Sir Rufo]

Du musst immer die Zeit berechnen, die zwischen dem letzten Aufruf und dem aktuellen Aufruf vergangen ist und dann berechnen, wie viele Schritte eigentlich hätten erfolgen sollen.
Die noch verbleibende Zeit speicherst du als Reserve und wird beim nächsten Schritt berücksichtigt.

Diese Schritte werden dann ausgeführt und dann wird das Zeichnen einmalig veranlasst.

Hier mal eine Klasse, die dieses berücksichtigt

Delphi-Quellcode:

unit Animator;

interface

  uses
    Classes,
    SysUtils,
    ExtCtrls;

  type
    TAnimator = class( TComponent )
    private
      FLocked     : Boolean;
      FTimer      : TTimer;
      FAccu       : Integer;
      FLastCall   : TDateTime;
      FOnStep     : TNotifyEvent;
      FOnPaint    : TNotifyEvent;
      FResolution : Cardinal;
      procedure TimerEvent( Sender : TObject );
      procedure SetResolution( const Value : Cardinal );
      function CalculateSteps : Integer;
      function GetEnabled : Boolean;
      procedure SetEnabled( const Value : Boolean );
      procedure DoStep;
      procedure DoPaint;
    public
      constructor Create( AOwner : TComponent ); override;
      destructor Destroy; override;

      // Event für den Berechnungs-Schritt
      property OnStep : TNotifyEvent read FOnStep write FOnStep;
      // Event für die Zeichen-Schritt
      property OnPaint : TNotifyEvent read FOnPaint write FOnPaint;
      // Auflösung in Millisekunden
      property Resolution : Cardinal read FResolution write SetResolution default 30;
      property Enabled : Boolean read GetEnabled write SetEnabled default True;
    end;

implementation

  uses
    DateUtils;

  { TAnimator }

  function TAnimator.CalculateSteps : Integer;
    var
      LNow  : TDateTime;
      LSpan : Integer;
    begin
      LNow := Now;

      // Zeitspanne zwischen letzem Aufruf und Jetzt
      // plus dem noch nicht berücksichtigtem Zeitvorrat
      LSpan := MilliSecondsBetween( LNow, FLastCall ) + FAccu;
      // Anzahl der Schritt pro Zeitauflösung
      Result := LSpan div FResolution;
      // Restzeit in den Zeitvorrat
      FAccu := LSpan - Result * FResolution;

      FLastCall := LNow;
    end;

  constructor TAnimator.Create( AOwner : TComponent );
    begin
      inherited;
      FLastCall       := Now;
      FResolution     := 30;
      FTimer          := TTimer.Create( Self );
      FTimer.OnTimer  := TimerEvent;
      FTimer.Interval := 1;
      FTimer.Enabled  := True;
    end;

  destructor TAnimator.Destroy;
    begin

      inherited;
    end;

  procedure TAnimator.DoPaint;
    begin
      if Assigned( OnPaint )
      then
        OnPaint( Self );
    end;

  procedure TAnimator.DoStep;
    begin
      if Assigned( OnStep )
      then
        OnStep( Self );
    end;

  function TAnimator.GetEnabled : Boolean;
    begin
      Result := FTimer.Enabled;
    end;

  procedure TAnimator.SetEnabled( const Value : Boolean );
    begin
      if Value = Enabled
      then
        Exit;

      if Value
      then
      begin

        // Wird der Timer wieder eingeschaltet, dann
        // LastCall und Accu wieder zurücksetzen

        FLastCall := Now;
        FAccu     := 0;
      end;

      FTimer.Enabled := Value;
    end;

  procedure TAnimator.SetResolution( const Value : Cardinal );
    begin
      if ( Value = FResolution ) or ( Value = 0 )
      then
        Exit;

      FResolution := Value;
    end;

  procedure TAnimator.TimerEvent( Sender : TObject );
    var
      LSteps : Integer;
    begin
      if FLocked
      then
        Exit;

      FLocked := True;
      try

        LSteps := CalculateSteps;

        if LSteps = 0
        then
          Exit;

        while ( LSteps > 0 ) do
        begin
          DoStep;
          Dec( LSteps );
        end;

        DoPaint;

      finally
        FLocked := False;
      end;
    end;

end.

Und ein kleines Testprogramm, was drei Shapes unterschiedlich schnell über die Form fliegen lässt

Delphi-Quellcode:

unit ViewMain;

interface

  uses
    Animator,
    Windows,
    Messages,
    SysUtils,
    Variants,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    ExtCtrls;

  type
    TFloatPoint = record
      x, y : Extended;
    end;

    TMainView = class( TForm )
      Shape1 : TShape;
      Shape2 : TShape;
      Shape3 : TShape;
      procedure FormCreate( Sender : TObject );
    private
      FShape1Pos : TFloatPoint;
      FShape2Pos : TFloatPoint;
      FShape3Pos : TFloatPoint;
      FAnimator  : TAnimator;
      procedure AnimatorStep( Sender : TObject );
      procedure AnimatorPaint( Sender : TObject );
    public

    end;

  var
    MainView : TMainView;

implementation

{$R *.dfm}

  procedure TMainView.AnimatorPaint( Sender : TObject );
    begin
      // Hier wird das Zeichnen der Oberfläche veranlasst

      Shape1.Top  := Round( FShape1Pos.y );
      Shape1.Left := Round( FShape1Pos.x );

      Shape2.Top  := Round( FShape2Pos.y );
      Shape2.Left := Round( FShape2Pos.x );

      Shape3.Top  := Round( FShape3Pos.y );
      Shape3.Left := Round( FShape3Pos.x );
    end;

  procedure TMainView.AnimatorStep( Sender : TObject );
    begin
      // Hier erfolgen NUR die Berechnungen

      // Shape1

      // Geschwindigkeit 500 Pixel/Sekunde
      FShape1Pos.y := FShape1Pos.y - ( 500 / 1000 * FAnimator.Resolution );

      // Wenn es nach oben rausrutscht, dann von unten wieder komplett reinkommen lassen
      if FShape1Pos.y < 0
      then
        FShape1Pos.y := FShape1Pos.y + Self.Height - Shape1.Height;

      // Shape2

      // Geschwindigkeit 200 Pixel/Sekunde
      FShape2Pos.y := FShape2Pos.y - ( 200 / 1000 * FAnimator.Resolution );

      // Wenn es nach oben rausrutscht, dann von unten wieder komplett reinkommen lassen
      if FShape2Pos.y < 0
      then
        FShape2Pos.y := FShape2Pos.y + Self.Height - Shape2.Height;

      // Shape3

      // Geschwindigkeit 800 Pixel/Sekunde
      FShape3Pos.y := FShape3Pos.y - ( 800 / 1000 * FAnimator.Resolution );

      // Wenn es nach oben rausrutscht, dann von unten wieder komplett reinkommen lassen
      if FShape3Pos.y < 0
      then
        FShape3Pos.y := FShape3Pos.y + Self.Height - Shape3.Height;

    end;

  procedure TMainView.FormCreate( Sender : TObject );
    begin

      // Positionen der Objekte merken

      FShape1Pos.x := Shape1.Left;
      FShape1Pos.y := Shape1.Top;

      FShape2Pos.x := Shape2.Left;
      FShape2Pos.y := Shape2.Top;

      FShape3Pos.x := Shape3.Left;
      FShape3Pos.y := Shape3.Top;

      // Animator initialisieren

      FAnimator         := TAnimator.Create( Self );
      FAnimator.OnStep  := AnimatorStep;
      FAnimator.OnPaint := AnimatorPaint;
    end;

end.