Delphi 2010控制闪烁

如何解决Delphi 2010控制闪烁

| 我已经从XP OS升级或迁移了我们的软件，以便能够在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);
    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,chartRect.bottom));
      end
      else
      begin
           Canvas.MoveTo(chartRect.left+i,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.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);

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

解决方法

我相信您有这种闪烁现象，因为您没有绘制到屏幕外的位图。如果首先在位图中绘制所有内容，然后最终在一个步骤中显示位图，则闪烁应消失。您需要创建一个私有位图：

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,Width,Height),fBitmap.Canvas,Rect(0,Height));
end;

,您似乎没有使用键盘输入进行控制。您也不一定要在此图表上放置其他控件。并且当您还可以不用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;

Delphi 2010控制闪烁

如何解决Delphi 2010控制闪烁

解决方法

相关推荐