logo标签列表

Delphi 2010 控件闪烁问题

delphidelphi-2010flicker
7
我一直在将我们的软件从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;

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;

这是如何在表单上绘制的方式：
    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);

非常感谢您的帮助，谢谢。
2
你应该从TCustomControl派生你的控件，而不是从TCustomPanel派生。 - Andreas Rejbrand
你是否正在绘制整个表面？如果是，您是否必须调用“inherited Paint”？如果是，请在创建时尝试将控件的颜色设置为白色。我还会尝试使用Jose的答案中的“csOpaque”。 - Sertac Akyuz
2
ControlStyle := ControlStyle + [csOpaque]; - David Heffernan
6
为了让大家更好地理解，您所指的修正闪烁问题的改变是什么？是 "csOpaque" 吗？ - David Heffernan
1
是的，David。是csOpaque解决了闪烁问题。 - ThN
显示剩余2条评论
2个回答
6

我相信您之所以出现闪烁的问题，是因为您没有绘制到离屏位图上。如果您首先将所有内容绘制到一个位图上，然后再一次性地显示该位图，那么您的闪烁问题应该会消失。

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

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;
没错。我有一个旧版的Delphi，它没有这个新的DoubleBuffered属性。 - Jose Rui Santos
我为我的类TTrendChart和父窗体TForm设置了DoubleBuffered属性，但没有起作用。我在TForm上拥有的所有其他控件都不会闪烁，但TTrendChart控件会。然而，我同意Jose的观点。我曾经为Linux操作系统迁移编写过类似的代码。那确实停止了闪烁。 - ThN
重绘时闪烁还是调整大小时闪烁？我问这个问题是因为只有在调整大小时才会看到闪烁。 - David Heffernan
由于某些令人困惑的原因，这似乎对请求者有效。也许DoubleBuffered没有正确设置？无论如何，仍然只是一个提示：在重写的Resize中更新内存位图的大小。 - NGLN
1
在TTrendChart.Create中添加ControlStyle := ControlStyle + [csOpaque];这一行代码解决了控件闪烁的问题。 - ThN
显示剩余3条评论
5

  • 看起来您不使用键盘输入来控制。也不太可能在此图表上放置其他控件。当您也可以不使用OnEnter和OnExit事件时，完全可以从更轻量级的TGraphicControl继承。

  • 如果您用自定义绘图填充了控件的整个边界矩形，则无需在重写的Paint例程中调用inherited Paint。

  • 如果您希望具有键盘焦点的可能性，则应尝试从Andreas Rejbrand提到的TCustomControl继承。

  • 如果您希望您的控件（部分）看起来像面板，则保持它为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;
为什么inherited被注释掉了？如果我使用inherited，为什么这个不起作用？ - Little Helper
@Rob 继承的消息处理程序将是 TWinControl.WMEraseBkgnd，它会填充面板的整个画布。如果你再次绘制（大部分）它，那么就会出现闪烁。 - NGLN
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接