TImage ohne Ruckeln auf einem Form bewegen

[hoika]

Hallo #,

ich steht gerade auf dem Schlauch.

Ich habe ein TImage (PNG+Transparenz), was sich auf einem Form ohne Ruckeln bewegen soll.
Mein bisheriger Ansatz über einen TTimer bringt ebend diese Ruckeln,
egal wie klein ich das Timer-Intervall mache (ja, ch weiss, ist gibt eine untere Grenze).

Wie würdet ihr Vorgehen ?

Noch ein kleines "Hindernis".
Die Geschwindigkeit ist vorgegeben
von Punkt A nach Punkt B sollen 3 Sekunden vergehen ...


Mein 2. Ansatz

Delphi-Quellcode:

  while True do
  begin
    Image.Left:= Image.Left+1;

(*
    Self.Update;
    Self.Refresh;
*)

    Application.ProcessMessages;

//     MessageBox(0, '', '', 0);

    if Image.Left+Image.Width>=Self.Width then break;
    
  end;

Das sieht schon etwas besser aus.


Danke


Heiko

[hoika]

Hallo,

jetzt nehme ich Delay aus

Delay

Aber.

Rufe ich Delay mit Werten größer 50 auf,
kommt es zu einem Integer-Überlauf.

Delphi-Quellcode:

procedure TForm2.Button_StartClick(Sender: TObject);
begin
  while True do
  begin
    Image.Left:= Image.Left+1;

    Delay(50);

    if Image.Left+Image.Width>=Self.Width then break;

  end;

  MessageBox(0, 'stopped', '', 0);
end;

Ich habe das Delay mal ein bisschen "optimiert".

Delphi-Quellcode:

procedure Delay(Milliseconds: Integer);
var
  Tick      : DWord;
  Event     : THandle;
  TickCount : Cardinal;
begin
  Event := CreateEvent(nil, False, False, nil);
  try
    TickCount:= GetTickCount;
    Tick := TickCount + DWord(Milliseconds);
    while (Milliseconds > 0) and
          (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT) do
    begin
      Application.ProcessMessages;
      if Application.Terminated then Exit;

      TickCount:= GetTickcount;

      if Tick < TickCount then break;

      Milliseconds := Tick - TickCount;  // hier kommt der Überlauf, wenn TickCount<Tick
    end;
  finally
    CloseHandle(Event);
  end;
end;

Vielleicht liegt es ja auch an Delphi2010 ?.


Heiko

[Angel4585]

es ist früh un ich hab saumäßige Kopfschmerzen, aber ich meine das ging ganz gut mit der Option "DoubleBuffered" + das Updaten des Formulars vor der Änderung abschalten, danach anschalten und von Hand ein Refresh oder so machen.

[Uwe Raabe]

Der folgende Beispielcode sendet wiederholt Windows-Messages an das Form, um eine Neuberechneung der Image-Position zu triggern. Je nach abgelaufener Zeit wird die Bildposition neu berechnet und bei einer Änderung der Bildkoordinaten ein Neuzeichnen forciert. Damit wird sichergestellt, daß die Strecke auch in der angegebenen Zeit zurückgelegt wird, selbst auf einem langsamen System (das kann dann auch mal springen).

Beim Form ist DoubleBuffered = true. Das zweite Image ist nur ein Hintergrundbild, um die Transparenz zu überprüfen.

Delphi-Quellcode:

unit Unit19;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, pngimage, jpeg, ExtCtrls, Diagnostics;

const
  wm_MoveImage = wm_User + 1;

type
  TForm19 = class(TForm)
    Image: TImage;
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    FStartPos: Integer;
    FStopWatch: TStopWatch;
    FTimeToMoveInMs: Integer;
    FEndPos: Integer;
    function MoveImage: Boolean;
    procedure TriggerMove;
  protected
    procedure WMMoveImage(var Message: TMessage); message WM_MOVEIMAGE;
  public
    property StartPos: Integer read FStartPos write FStartPos;
    property StopWatch: TStopWatch read FStopWatch write FStopWatch;
    property TimeToMoveInMs: Integer read FTimeToMoveInMs write FTimeToMoveInMs;
    property EndPos: Integer read FEndPos write FEndPos;
  end;

var
  Form19: TForm19;

implementation

{$R *.dfm}

procedure TForm19.Button1Click(Sender: TObject);
begin
  { Start- und Endposition und Zeitspanne festlegen }
  StartPos := 100;
  EndPos := 400;
  TimeToMoveInMs := 3000;
  { Zeitmesser starten }
  StopWatch := TStopWatch.StartNew;
  { erste Bewegung auslösen }
  TriggerMove;
end;

procedure TForm19.WMMoveImage(var Message: TMessage);
begin
  { solange wir das Ziel nicht erreicht haben, triggern wir gleich die nächste Bewegung }
  if MoveImage then
    TriggerMove;
  Message.Result := 0;
  inherited;
end;

procedure TForm19.TriggerMove;
begin
  PostMessage(Handle, wm_MoveImage, 0, 0);
end;

function TForm19.MoveImage: Boolean;
var
  part: Extended;
  newPos: Integer;
begin
  if Image.Left <> EndPos then begin
    part := StopWatch.ElapsedMilliseconds / TimeToMoveInMs;
    if part > 1 then
      newPos := EndPos
    else
      newPos := StartPos + Round(part * (EndPos - StartPos));
    if newPos <> Image.Left then begin
      Image.Left := newPos;
      { Das Refresh ist nötig, da wir die Message-Queue so mit unseren eigenen Botschaften zumüllen, 
        daß keine Zeit für einen Bildaufbau bleibt. }
      Image.Refresh;
    end;
  end;
  { Solange wir das Ziel nicht erreicht haben, geben wir true zurück }
  result := (Image.Left <> EndPos);
end;

end.