Delphi 2010 控制闪烁

Question

我一直在从 XP 操作系统升级或迁移我们的软件，以便能够在 Windows 7 下编译和运行。我们的软件开始出现我们在 Windows XP 下没有注意到的问题。目前，我正在处理 TForm 上闪烁的用户定义控件。 它似乎时不时地闪烁，但并非总是闪烁，但当它闪烁时，它是非常明显的。我已经为 TForm 和 TTrendChart 类设置了 DoubleBuffered，但它没有帮助。

这是 TCustomPanel 的用户定义控件。它应该在 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;

这是它的创建方式：

    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;

这是它在表单上的绘制方式：

    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;

这是使用它的方式：

  TrendChart := TTrendChart.Create(form);

任何帮助将不胜感激。谢谢。

Answer 1

我相信你会出现这种闪烁，因为你没有绘制到屏幕外的位图。如果您首先在位图中绘制所有内容，然后最终一步显示位图，那么闪烁就会消失。

您需要创建一个私有位图：

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

在构造函数中写入：

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

也不要忘记析构函数：

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

最后在 paint 方法中，在您找到 Canvas 的任何地方，替换它使用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

• 您似乎没有使用键盘输入进行控制。您也不太可能希望在此图表上放置其他控件。如果您也可以不使用 OnEnter 和 OnExit 事件，那么从更轻量级的 TGraphicControl 继承是完全安全的。

• 如果使用自定义绘图填充控件的整个边界矩形，则不必在重写的 Paint 例程中调用继承的 Paint。

• 如果您确实想要键盘焦点的可能性，那么您当然应该尝试从 TCustomControl 继承，就像 Andreas Rejbrand 提到的那样。

• 如果您希望控件（部分）看起来像面板，则将其保留为 TCustomPanel。但在这种情况下，ParentBackground 属性可能是导致闪烁的部分原因，因为它是在继承的 Paint 中处理的。将其设置为 False。

作为一般提示：在绘制画布之前消除背景刷新：

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;