在Lazarus的GUI组件动画时,如何避免闪烁



我在GUI应用程序中左右移动TMemo对象。问题是,我的TMemo中的字母在动作开始后立即闪烁。

我已经查找了这个,显然,设置了我的主要形式的DoubleBuffering属性应该对我有所帮助,但事实并非如此。因此,我尝试将该属性设置为"移动的所有对象",但仍然存在闪烁。

有什么方法可以实现Lazarus中GUI组件的无闪烁动画?我是拉撒路的新手,所以我现在有点盲目地搜索解决方案。我真的很感谢您的帮助。

为了提供进一步的上下文,这是我对TMemo进行动画操作的方式:我有一个间隔值10的TTimer,其OnTimer事件将我的TMemo左右连续移动。为了使运动稍微更顺畅,我添加了一个简单的余弦插值功能。

最后是代码:

procedure TServerSideForm.ControlPanelHideTimerTimer(Sender: TObject);
begin
  if (hideAnimVal < 1) then
  begin
    hideAnimVal := hideAnimVal + 0.025;
  end
  else
  begin
    MemoHideTimer.Enabled:=false;
  end;

  // hideStart - starting position of my TMemo, hideEnd - end position of my TMemo
  hideCurr := Round(CosineInterpolation(hideStart, hideEnd, hideAnimVal));
  Memo.Left:=hideCurr;
end; 

余弦插值:

function CosineInterpolation(Val1, Val2, Angle: Double): Double;
var
  Percent: Double;
begin
  Percent := (1-Cos(Angle*PI))/2;
  Result := (Val1 * (1 - Percent) + Val2 * Percent);
end;

我会尝试移动图像:

var
  Memo1dc: hdc;
  Cnv: TCanvas;
  Rct: TRect;
implementation
procedure TForm1.MemoHideTimerTimer(Sender: TObject);
begin
  if Memo1.Visible then
  begin
    Memo1dc := GetDC(Memo1.Handle);
    Cnv.Handle := Memo1dc;
    Rct.Height := Memo1.Height;
    Rct.Width := Memo1.Width;
    Image1.Left := Memo1.Left;
    Image1.Top := Memo1.Top;
    Image1.Width := Memo1.Width;
    Image1.Height := Memo1.Height;
    Image1.Canvas.CopyRect(Rct, Cnv, Rct);
    Memo1.Visible := False;
    Image1.Visible := True;
  end;
  if (hideAnimVal < 1) then
  begin
    hideAnimVal := hideAnimVal + 0.025;
  end
  else
  begin
    MemoHideTimer.Enabled := False;
  end;
  // hideStart - starting position of my TMemo, hideEnd - end position of my TMemo
  hideCurr := Round(CosineInterpolation(hideStart, hideEnd, hideAnimVal));
  Image1.Left := hideCurr;
  if MemoHideTimer.Enabled = False then
  begin
    Memo1.Left := Image1.Left;
    Memo1.Visible := True;
    Image1.Visible := False;
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
   Cnv := TCanvas.Create;
end; 

最新更新