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;
我正在尝试用 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;