Delphi 2010 Control Flickering

Question

I have been upgrading or migrating our software from XP OS to be able to compile and run under Windows 7. Our software is starting to show issues that we didn't notice under Windows XP. Currently, I am dealing with a user defined control flickering on a TForm. It seems to flicker every now and then not always, but when it flickers it is very noticeable. I have set DoubleBuffered for the TForm and TTrendChart Class, but it is not helping.

This a user-defined control of TCustomPanel. It is supposed to display a Live Trendchart on a TForm.

TTrendChart = class(TCustomPanel)
private
  fCount:integer;
  fColors:array[0..7] of TColor;
  fNames:array[0..7] of string;
  fMinText:string16;
  fMaxText:string16;
  fShowNames:Boolean;
  fMaxTextWidth:integer;
  data:TList;
  Indexer:integer;
  chartRect:TRect;
  fWidth:integer;
  fHeight:integer;
  firstTime:Boolean;
  function GetColors(Index:integer):TColor;
  procedure SetColors(Index:integer; const value :TColor);
  function GetNames(Index:integer):string;
  procedure SetNames(Index:integer; const value: string);
  procedure SetCount(const value : integer);
  procedure rShowNames(const value : Boolean);
  procedure SetMaxText(const value:string16);
  procedure SetMinText(const value:string16);
  procedure RecalcChartRect;
protected
  procedure Resize; override;
  procedure Paint; override;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure PlotPoints(p1,p2,p3,p4,p5,p6,p7,p8:real);
  procedure ClearChart;
  procedure Print;
  property TrendColors[Index:integer]: TColor read GetColors write SetColors;
  property TrendNames[index:integer]: string read GetNames write SetNames;
published
  property TrendCount: Integer read fCount write SetCount default 8;
  property ShowNames: Boolean read fShowNames write rShowNames default true;
  property MaxText:string16 read fMaxText write SetMaxText;
  property MinText:string16 read fMinText write SetMinText;
  property Align;
  property Alignment;
  property BevelInner;
  property BevelOuter;
  property BevelWidth;
  property DragCursor;
  property DragMode;
  property Enabled;
  property Caption;
  property Color;
  property Ctl3D;
  property Font;
  property Locked;
  property ParentColor;
  property ParentCtl3D;
  property ParentFont;
  property ParentShowHint;
  property PopupMenu;
  property ShowHint;
  property TabOrder;
  property TabStop;
  property Visible;

  property OnClick;
  property OnDblClick;
  property OnDragDrop;
  property OnDragOver;
  property OnEndDrag;
  property OnEnter;
  property OnExit;
  property OnMouseDown;
  property OnMouseUp;
  property OnMouseMove;
  property OnResize;
end;

Here how it created:

    constructor TTrendChart.Create(AOwner:TComponent);
var
  i:integer;
  tp:TTrendPoints;
begin
  inherited Create(AOwner);
  Parent := TWinControl(AOwner);
  fCount := 8;
  fShowNames := true;
  Caption := '';
  fMaxText := '100';
  fMinText := '0';
  fMaxTextWidth := Canvas.TextWidth('Bar 0');
  firstTime := true;
  BevelInner := bvLowered;
  data := TList.Create;
  Indexer := 0;
  RecalcChartRect;
  DoubleBuffered:=true;
  for i := 0 to 10 do
  begin
    tp := TTrendPoints.Create(0.0 + 0.1 * fWidth,0.0,0.0,0.0,0.0,0.0,0.0,0.0);
    data.Add(tp);
  end;
  for i := 0 to 7 do
  begin
    case i of
    0: fColors[i] := clMaroon;
    1: fColors[i] := clGreen;
    2: fColors[i] := clOlive;
    3: fColors[i] := clNavy;
    4: fColors[i] := clPurple;
    5: fColors[i] := clFuchsia;
    6: fColors[i] := clLime;
    7: fColors[i] := clBlue;
    end;
    fNames[i] := Format('Line %d',[i]);
  end;

end;

Here is how it is painted on the Form:

    procedure TTrendChart.Paint;
var
  oldColor:TColor;
  dataPt:TTrendPoints;
  i,j:integer;
  curx:integer;
  count,step:integer;
  r:TRect;
begin
   inherited Paint;

  oldcolor := Canvas.Pen.Color;

  Canvas.Brush.Color:=clWhite;
  r.Left:=chartRect.Left-25;
  r.Right:=chartRect.Right+11;
  r.Top:=chartRect.Top-11;
  r.Bottom:=chartRect.Bottom+22;
  Canvas.FillRect(r);

  if FirstTime then
  begin
    count := Indexer - 1;
  end
  else
    count := data.Count - 2;

    { Draw minute lines }
    Canvas.Pen.Color := clBtnShadow;
    i := chartRect.left + 60;
    while i < chartRect.Right do
    begin
         Canvas.Moveto(i, chartRect.top);
         Canvas.LineTo(i, chartRect.bottom);
         i := i + 60;
    end;

    { Draw value lines }

    step := (chartRect.bottom - chartRect.top) div 5;

    if step > 0 then
    begin
         i := chartRect.bottom - step;
         while i > (chartRect.top + step - 1) do
         begin
              Canvas.Moveto(chartRect.left,i);
              Canvas.LineTo(chartRect.right,i);
              i := i - step;
         end;
    end;

  { Draw Pens }
  for j := 0 to fCount - 1 do
  begin
    Canvas.Pen.Color := fColors[j];
    dataPt := TTrendPoints(data.Items[0]);
    Canvas.MoveTo(chartRect.left,PinValue(round(chartRect.bottom - (fHeight * dataPt.pnts[j] / 100.0)),
                                                                 chartRect.top,chartRect.bottom));

    for i := 1 to count do
    begin
      dataPt := TTrendPoints(data.Items[i]);
      if i <> Indexer then
      begin
           Canvas.LineTo(chartRect.left+i,PinValue(round(chartRect.bottom - (fHeight * dataPt.pnts[j] / 100.0)),
                                                               chartRect.top,chartRect.bottom));
      end
      else
      begin
           Canvas.MoveTo(chartRect.left+i,PinValue(round(chartRect.bottom - (fHeight * dataPt.pnts[j] / 100.0)),
                                                                 chartRect.top,chartRect.bottom));
      end;
    end;
  end;

    r := chartRect;
    InflateRect(r,1,1);
    Canvas.Pen.Color := clBtnShadow;
    Canvas.moveto(r.left,r.top);
    Canvas.lineto(r.right,r.top);
    Canvas.lineto(r.right,r.bottom);
    Canvas.lineto(r.left,r.bottom);
    Canvas.lineto(r.left,r.top);

    { draw index line }
//    Canvas.Pen.Color := clWhite;
    Canvas.Pen.Color := clBlack;    
    Canvas.MoveTo(chartRect.Left + Indexer,chartRect.top);
    Canvas.LineTo(chartRect.left + Indexer, chartRect.bottom+1);
    Canvas.Pen.Color := oldcolor;

    Canvas.Font.COlor := clBlack;
    Canvas.TextOut(chartRect.left-Canvas.TextWidth(string(fMinText))-2,chartRect.Bottom-8,string(fMinText));
    Canvas.TextOut(chartRect.left-Canvas.TextWIdth(string(fMaxText))-2,chartRect.top-8,string(fMaxText));

    if fShowNames then
    begin
      curx := 32;
      for i := 0 to fCount - 1 do
      begin
        Canvas.Font.Color := fColors[i];
        Canvas.TextOut(curx,chartRect.bottom+4,fNames[i]);
        curx := curx +  fMaxTextWidth + 16;
      end;
    end;
end;

Here is how one would use it:

  TrendChart := TTrendChart.Create(form);

Any help will be appreciated. Thank you.

Answer 1

I believe you have this flickering because you are not drawing to an off-screen bitmap. If you first paint everything in a bitmap and then finally display your bitmap in a single step, then you flickering should go away.

You need to create a private bitmap:

TTrendChart = class(TCustomPanel)
private
  ...
  fBitmap: TBitmap;
  ...
end;

in the constructor write:

constructor TTrendChart.Create(AOwner:TComponent);
begin
  ...
  fBitmap := TBitmap.Create;
  // and also make the ControlStyle opaque
  ControlStyle := ControlStyle + [csOpaque];
  ...
end;

also don't forget the destructor:

destructor TTrendChart.Destroy;
begin
  ...
  fBitmap.Free;
  inherited;
end;

and finally in the paint method, everywhere you have find Canvas, replace it with fBitmap.Canvas:

procedure TTrendChart.Paint;
...
begin
   inherited Paint;
   ...
   // here replace all ocurrences of Canvas with bBitmap.Canvas
   ...
   // finally copy the fBitmap cache to the component Canvas
   Canvas.CopyRect(Rect(0, 0, Width, Height), fBitmap.Canvas, Rect(0, 0, Width, Height));
end;

Answer 2

• It looks like you don't use keyboard input for your control. Nor is it likely that you want to put other controls on this chart. And when you also could do without the OnEnter and OnExit events, then it is completely safe to inherit from the more lightweight TGraphicControl.

• If you fill the entire bounding rect of the control with custom drawing, then you don't have to call inherited Paint within the overriden Paint routine.

• If you dó want the possibility of keyboard focus, then you should certainly try to inherit from TCustomControl like Andreas Rejbrand mentioned.

• If you want your control to (partly) look like a Panel, then keep it a TCustomPanel. But in that case, maybe the ParentBackground property is partly the cause of the flickering for that is handled in inherited Paint. Set it to False.

And as a general tip: to eliminate background refreshing prior to painting the canvas:

type 
  TTrendChart = class(TCustomPanel)
  private
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    ...

procedure TTrendChart.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  { Eat inherited }
  Message.Result := 1; // Erasing background is "handled"
end;