简体   繁体   中英

Double buffering in delphi

Using Delphi XE2 I wanted to make some buttons move in delphi application.

I wrote this code:

procedure TForm1.DoSomething;
var x : integer;
begin    
   for x := 200 downto 139 do begin
       // move two buttons
      Button1.Top := x;
      Button3.Top := x;
       // skip some repaints to reduce flickering
      if (x mod 7 = 1) then begin
          Form1.Repaint;
      Sleep(50);
   end;
end;

Unfortunately it still significantly flickers when running this procedure.

Here's my question: Is there any way, to make the animation smooth (without any flickering)?

Edit: To make animation more smooth, change 50 to something smaller in sleep(50) and delete this line:

if(x mod 7 = 1) then begin

Set Form1.DoubleBuffered to True . You can do this in code, but I think the property is published in XE2, so you can set it in the Object Inspector as well.

I have found that it is better to decide how long you want the movement to take instead of using the Sleep procedure. This adjusts better for different speed computers and will also adjust for different distances being moved. If you want it to take 1 second to move across the screen you need to move by smaller steps between repaints vs. only taking .5 seconds to move across the screen.

I don't remember exactly why but we also added code to repaint the parent. I think we were having problems with a ghost image being left as our object moved across the screen.

Here is the code we are using. This is inside a component that can shift itself on and off the screen.

procedure TMyObject.ShiftRight;
var
  TicksStart: int64;
  StartLeftValue: integer;
  EndLeftValue: integer;
  NewLeftValue: integer;
  LeftValueDif: integer;
  RemainingTicks: int64;

begin
  StartLeftValue := Self.Left;
  EndLeftValue := Self.Left + Self.Width;
  LeftValueDif := EndLeftValue - StartLeftValue;

  TicksStart := GetTickCount();
  RemainingTicks := FadeTime;  // Fade Time is a constants that dermines how long the 
                               // slide off the screen should take

  while RemainingTicks > 0 do
  begin
    NewLeftValue := (LeftValueDif * (FadeTime - RemainingTicks)) div FadeTime;
    Self.Left := Max(StartLeftValue, NewLeftValue);
    Self.Parent.Repaint;
    Self.Repaint;

    RemainingTicks := FadeTime - int64(GetTickCount - TicksStart);
  end;

  if Self.Left < EndLeftValue then
    Self.Left := EndLeftValue;

  Self.Parent.Repaint;    
  Self.Repaint;
end;

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM