delphiflickerdouble-buffering

Double buffering in delphi not enough


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

enter image description here

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

enter image description here

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

enter image description here

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;

Solution

  • 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

    A gif image for TAttitudeControl

    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 image

    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;