delphi中的双缓冲不够

Question

我正在尝试使用 Delphi XE2 构建航空电子姿态指示器。

我正在使用 tRotateimage 作为地平线 http://www.delphiarea.com/products/delphi-components/rotateimage/

这是在中间有透明部分的常规图像后面。

能够旋转图像以进行滚动并移动 tRotateimage.top 以进行俯仰效果很好，但我收到了很多闪烁事件，双缓冲打开了我的表单。当我旋转图像或通过 .top 向上移动它时它会闪烁

我还能做些什么来消除这种闪烁吗？

 if tryStrToFloat(GetHashtag('#ROLL',',',Memo1.Lines.Text),MyDouble) then
 Begin
  rtAttitudeNeedle.Angle := 0- MyDouble;
  rtAttitude.Angle :=0- MyDouble;
 end;

 if tryStrToFloat(GetHashtag('#PITCH',',',Memo1.Lines.Text),MyDouble) then
 Begin
  rtAttitude.Top := Round(iAttitudeTop + MyDouble);
 end;

Answer 1

双缓冲表单并不总是解决所有闪烁问题的魔术。 您首先需要了解为什么会出现这种闪烁。

如果你在绘制例程中直接大量使用画布对象，那么你什么都不做。

大多数时候要解决这个问题并减少闪烁，您需要在内存位图上绘制，然后最后将CopyRect 绘制到您的画布对象上。

你的组件是这样的（用这段代码替换Paint过程）

procedure TRotateImage.Paint;
var
  SavedDC: Integer;
  PaintBmp: TBitmap;
begin
  PaintBmp := TBitmap.Create;
  try
    PaintBmp.SetSize(Width, Height);

    if not RotatedBitmap.Empty then
    begin
      if RotatedBitmap.Transparent then
      begin
        PaintBmp.Canvas.StretchDraw(ImageRect, RotatedBitmap);
      end
      else
      begin
        SavedDC := SaveDC(PaintBmp.Canvas.Handle);
        try
          SelectClipRgn(PaintBmp.Canvas.Handle, ImageRgn);
          IntersectClipRect(PaintBmp.Canvas.Handle, 0, 0, Width, Height);
          PaintBmp.Canvas.StretchDraw(ImageRect, RotatedBitmap);
        finally
          RestoreDC(PaintBmp.Canvas.Handle, SavedDC);
        end;
      end;
    end;
    if csDesigning in ComponentState then
    begin
      PaintBmp.Canvas.Pen.Style := psDash;
      PaintBmp.Canvas.Brush.Style := bsClear;
      PaintBmp.Canvas.Rectangle(0, 0, Width, Height);
    end;

    Canvas.CopyRect(ClientRect, PaintBmp.Canvas, PaintBmp.Canvas.ClipRect);
  finally
    PaintBmp.Free;
  end;
end;

如果这不能完全解决问题，那么您可以看看这个无闪烁组件集，并尝试调整您在他的一个组件上拥有的旋转代码或从它继承（我不是作者并且他是声称无闪烁功能的人。

FreeEsVclComponents GitHub 存储库

编辑：调试后我发现这个控件有很多问题，所以我决定按照我给你的建议去做。

我为你创建了以下控件

我所做的只是从TEsImage 继承并对其工作方式进行一些更改。从旧控件中，我使用下面的例程进行旋转变换。

function CreateRotatedBitmap(Bitmap: TBitmap; const Angle: Extended; bgColor: TColor): TBitmap;

正如您在上面的 gif 中看到的，旋转例程并不完美。我建议您寻找替代方案。

我还分叉了 FreeEsVclComponents 的存储库并将 TAttitudeControl 添加到 Es.Images 单元，因此您拥有在系统中安装控件所需的一切。 Click here

最后我在东京测试了这个，从存储库的自述文件来看，它应该可以在 XE2 上正常工作。

Edit2：我将CreateRotatedBitmap改成了更好的（基于GDI+），结果如下：

我已经将更改推送到 Github，因此您可以从那里获取代码。 我也在此处添加代码，以防 Github 出现故障（极不可能:)）

uses
  WinApi.Windows, WinApi.GDIPApi, WinApi.GDIPObj, Vcl.Graphics, System.Types;

function RotateImage(Source: TBitmap; Angle: Extended; AllowClip: Boolean): TBitmap;
var
  OutHeight, OutWidth: Integer;
  Graphics: TGPGraphics;
  GdiPBitmap: TGPBitmap;
begin

  if AllowClip then
  begin
    OutHeight := Source.Height;
    OutWidth := Source.Width;
  end
  else
  begin
    if (Source.Height > Source.Width) then
    begin
      OutHeight := Source.Height + 5;
      OutWidth := Source.Height + 5;
    end
    else
    begin
      OutHeight := Source.Width + 5;
      OutWidth := Source.Width + 5;
    end;
  end;

  Result := TBitmap.Create;
  Result.SetSize(OutWidth, OutHeight);

  GdiPBitmap := nil;
  Graphics := TGPGraphics.Create(Result.Canvas.Handle);
  try
    Graphics.SetSmoothingMode(SmoothingModeDefault);
    Graphics.SetPixelOffsetMode(PixelOffsetModeHalf);
    Graphics.SetInterpolationMode(InterpolationModeLowQuality);

    Graphics.TranslateTransform(OutWidth / 2, OutHeight / 2);
    Graphics.RotateTransform(Angle);
    Graphics.TranslateTransform(-OutWidth / 2, -OutHeight / 2);

    GdiPBitmap := TGPBitmap.Create(Source.Handle, Source.Palette);
    try
      Graphics.DrawImage(GdiPBitmap, 0, 0);
    finally
      GdiPBitmap.Free;
    end;
  finally
    Graphics.Free;
  end;
end;