简体   繁体   中英

Double buffering in delphi not enough

I am trying to build an avionic attitude indicator with Delphi XE2.

在此处输入图像描述

I am using tRotateimage for the horizon http://www.delphiarea.com/products/delphi-components/rotateimage/

在此处输入图像描述

This is behind a regular image which has transparent section in the middle.

在此处输入图像描述

Being able to rotate the image for roll and move the tRotateimage.top for pitch works well but I am getting a lot of flickering event with double buffered turned on my form. It flickers when I rotate the image or when I move it up via.top

Is there something else I can do to eliminate this flickering?

 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;

Double buffering a form is not always the magic trick to solve all your flicker problems. you need to understand why you are having that flicker in the first place.

if you use the canvas object directly a lot in the paint routine, then you are doing nothing.

Most the time to solve this problem and reduce the flicker, you need to draw on a memory bitmap then at last CopyRect that to your canvas object.

Something like this for your component (Replace the Paint procedure with this code)

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;

if this does not solve the problem entirely then you could take a look at this flicker free set of components and try to adapt the rotating code you have on one of his components or inherit from it (I'm not the author and he is the one claiming flicker free functionality).

the FreeEsVclComponents GitHub repository

Edit: after debugging I found a lot of problems with that control, so I decided to go with my recommendation to you.

I created the following control for you

TAttitudeControl 的 gif 图像

All what I did is that inheriting from TEsImage and doing some changes to the way it work. From the old control I used the routine below to do the rotation transformation.

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

As you can see in the gif above the rotation routine is not perfect. I suggest you look for an alternative.

I also forked the repository of FreeEsVclComponents and added the TAttitudeControl to the Es.Images unit, so you have all what you need to install the control in your system. Click here

At last I tested this on Tokyo and from the readme of the repository it should work on XE2 without problems.

Edit2: I changed the CreateRotatedBitmap with a better one (based on the GDI+), this is the result:

TAlttitudeControl gif 图像

I already pushed the changes to Github so you can git the code from there. I'm adding the code here as well in case Github goes down (highly unlikely:))

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;

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