Delphi2010控件闪烁

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

这是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;

---

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

我相信您有这种闪烁，因为您没有绘制屏幕外位图。如果您首先在位图中绘制所有内容，然后在一个步骤中最终显示位图，那么闪烁应该消失

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

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;

• 看起来您的控件没有使用键盘输入。您也不可能希望在此图表上放置其他控件。如果您也可以不使用oneter和OnExit事件，那么从更轻量级的tgraphic控件继承是完全安全的

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

• 如果您希望键盘焦点的可能性，那么您当然应该尝试继承Andreas Rejbrand提到的TCustomControl

• 如果您希望控件（部分）看起来像一个面板，那么请将其保留为TCustomPanel。但在这种情况下，ParentBackground属性可能是闪烁的部分原因，因为它是在继承的绘制中处理的。将其设置为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;

---

如果你只是从一个自定义面板继承，你就不能设置DoubleBuffered:=True，让VCL/Windows帮你做吗？这是正确的。我有一个旧的Delphi没有这个新的DoubleBuffered属性。我为我的类TTrendChart和父类TForm设置了DoubleBuffered属性为true。这没用。TForm上的所有其他控件都不会闪烁，但TTrendChart控件会闪烁。不过，我同意何塞的看法。我必须为Linux操作系统迁移做类似的编码。这确实阻止了闪烁。是在重新绘制还是在调整大小时闪烁？我这样问是因为我只在调整大小时看到闪烁；在TTrendChart中。Create解决了控件闪烁问题。您应该从

TCustomControl

派生控件，而不是从

TCustomPanel

派生控件。您正在绘制整个曲面吗？如果是，您是否必须调用“继承的油漆”？如果是，至少在创建控件时尝试将控件的颜色设置为白色。我还可以从Jose的答案中尝试使用“csOpaque”。

ControlStyle:=ControlStyle+[csOpaque]

@digitalanalog只是为了人们的利益，是什么改变修复了闪烁？它是不是不透明的？是的，大卫。是CS不透明修复了闪烁。为什么

继承的
被注释掉了？如果我使用
继承的
，为什么这不起作用？@Rob继承的消息处理程序将是
TWinControl.WMEraseBkgnd
，它填充了面板的整个画布。如果再次绘制（大部分），则会出现闪烁。
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;