Geek Answers Handbook

Flicker Management Delphi 2010

I update or stand our software XP operating system to be able to compile and run under Windows 7. Our software is starting to show the problems that we had not noticed under Windows XP. I am currently dealing with user control flickering on TForm. It does not seem to flicker every now and then, but when it flickers, it is very noticeable. I installed DoubleBuffered for TForm and TTrendChart Class, but it does not help.

This is a custom TCustomPanel control. It should display Live Trendchart on 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's how it was 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; ;  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; ;  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 written 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's how to use it:

  TrendChart := TTrendChart.Create(form);

Any help would be appreciated. Thanks.

+4
source share
2 answers

I believe that you have it blink, because you do not draw the bitmap image off-screen. If you first painted everything in a bitmap, and then finally display the bitmap in one step, then you flicker, it should disappear.

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 do not forget the destructor:

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

and finally, in the paint method, everywhere you will 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; component 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;
+5
source

  • It looks like you are not using keyboard input for your control. It is possible that you want to place other controls on this chart. And when you can also dispense with the OnEnter and OnExit events, it is completely safe to inherit from the lighter TGraphicControl.

  • If you fill the entire bounding box of a control with a special drawing, you do not need to invoke the inherited Paint within the redefined Paint.

  • If you want the opportunity to focus on the keyboard, then you definitely need to inherit from TCustomControl, like mentioned Andreas Reydzhrand.

  • If you want your control (partially) to look like a panel, then save it to TCustomPanel. But in this case, it is possible that the ParentBackground property is partly the cause of the flicker that is handled in the inherited Paint. Set the value to False.

And as a general tip: eliminate background updates before 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;
+3
source

More articles:


All Articles