delphi 双缓冲不够

Double buffering in delphi not enough

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

我正在为 horizon 使用 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;

双重缓冲表单并不总是解决所有闪烁问题的灵丹妙药。 您首先需要了解为什么会出现闪烁。

如果您在绘画例程中直接大量使用 canvas 对象,那么您什么也没做。

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

您的组件类似于此(用此代码替换 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,因此您可以从那里 git 代码。 我也在此处添加代码,以防 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;