如何减少DevExpress VCL表格闪烁

时间:2016-03-03 16:44:38

标签: delphi devexpress

我正在进行另一个项目,DevExpress VCL Component有皮肤支持。在TcxPageControl上,我放置了两个TPanel,其标题颜色将根据一个TTimer进行更改。面板标题颜色总是随着闪烁而改变,但它在正常TPageControl中平滑变化。这是我的示例代码:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, dxSkinsCore, dxSkinVisualStudio2013Dark,
  dxSkinscxPCPainter, dxBarBuiltInMenu, cxGraphics, cxControls, cxLookAndFeels,
  cxLookAndFeelPainters, Vcl.Menus, cxClasses, cxContainer, cxEdit, dxBevel,
  Vcl.StdCtrls, cxButtons, dxSkinsForm, cxPC, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    cxPageControl1: TcxPageControl;
    cxTabSheet1: TcxTabSheet;
    cxTabSheet2: TcxTabSheet;
    cxTabSheet3: TcxTabSheet;
    cxTabSheet4: TcxTabSheet;
    cxTabSheet5: TcxTabSheet;
    dxSkinController1: TdxSkinController;
    cxButton1: TcxButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FoldedClientHeight: Integer;
    ContractedClientHeight: Boolean;
  public
    { Public declarations }
    procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown); message WM_NCRBUTTONDOWN;
    procedure WMNCLButtonDblClk(var Msg: TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMNCRButtonDown(var Msg: TWMNCRButtonDown);
begin
  if Msg.HitTest = HTCAPTION then
    begin
      Form1.Timer2.Enabled := true;
    end
  else
    begin
      inherited;
    end;
end;

procedure TForm1.WMNCLButtonDblClk(var Msg: TWMNCLButtonDblClk);
begin
  if Msg.HitTest = HTCAPTION then
    begin
      Form1.Timer2.Enabled := true;
    end
  else
    begin
      inherited;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer2.Enabled := false;
  Timer2.Interval := 1;
  FoldedClientHeight := ClientHeight;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
const
  IncrementalFactor = 5;
  DecrementalFactor = 5;
var
  RPanel1, GPanel1, BPanel1, RPanel2, GPanel2, BPanel2: Integer;
begin

  RPanel1 := GetRValue(ColorToRGB(Panel1.Font.Color));
  GPanel1 := GetGValue(ColorToRGB(Panel1.Font.Color));
  BPanel1 := GetBValue(ColorToRGB(Panel1.Font.Color));
  if (RPanel1 = 255) and (GPanel1 = 000) and (BPanel1 < 255) then
    begin
      BPanel1 := BPanel1 + IncrementalFactor;
    end
  else if (RPanel1 > 000) and (GPanel1 = 000) and (BPanel1 = 255) then
    begin
      RPanel1 := RPanel1 - DecrementalFactor;
    end
  else if (RPanel1 = 000) and (GPanel1 < 255) and (BPanel1 = 255) then
    begin
      GPanel1 := GPanel1 + IncrementalFactor;
    end
  else if (RPanel1 = 000) and (GPanel1 = 255) and (BPanel1 > 000) then
    begin
      BPanel1 := BPanel1 - DecrementalFactor;
    end
  else if (RPanel1 < 255) and (GPanel1 = 255) and (BPanel1 = 000) then
    begin
      RPanel1 := RPanel1 + IncrementalFactor;
    end
  else if (RPanel1 = 255) and (GPanel1 > 000) and (BPanel1 = 000) then
    begin
      GPanel1 := GPanel1 - DecrementalFactor;
    end
  else
    begin
      Timer1.Enabled := false;
    end;
  Panel1.Font.Color := RGB(RPanel1, GPanel1, BPanel1);

  RPanel2 := GetRValue(ColorToRGB(Panel2.Font.Color));
  GPanel2 := GetGValue(ColorToRGB(Panel2.Font.Color));
  BPanel2 := GetBValue(ColorToRGB(Panel2.Font.Color));
  if (RPanel2 = 255) and (GPanel2 = 000) and (BPanel2 < 255) then
    begin
      BPanel2 := BPanel2 + IncrementalFactor;
    end
  else if (RPanel2 > 000) and (GPanel2 = 000) and (BPanel2 = 255) then
    begin
      RPanel2 := RPanel2 - DecrementalFactor;
    end
  else if (RPanel2 = 000) and (GPanel2 < 255) and (BPanel2 = 255) then
    begin
      GPanel2 := GPanel2 + IncrementalFactor;
    end
  else if (RPanel2 = 000) and (GPanel2 = 255) and (BPanel2 > 000) then
    begin
      BPanel2 := BPanel2 - DecrementalFactor;
    end
  else if (RPanel2 < 255) and (GPanel2 = 255) and (BPanel2 = 000) then
    begin
      RPanel2 := RPanel2 + IncrementalFactor;
    end
  else if (RPanel2 = 255) and (GPanel2 > 000) and (BPanel2 = 000) then
    begin
      GPanel2 := GPanel2 - DecrementalFactor;
    end
  else
    begin
      Timer1.Enabled := false;
    end;
  Panel2.Font.Color := RGB(RPanel2, GPanel2, BPanel2);
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
  MinClientHeight: Integer;
begin
  MinClientHeight := GetSystemMetrics(SM_CYMIN) - (GetSystemMetrics(SM_CYCAPTION) + 2 * GetSystemMetrics(SM_CYFIXEDFRAME));

  if (ContractedClientHeight = true) then
    begin
      if ClientHeight < FoldedClientHeight then
        begin
          ClientHeight := ClientHeight + 25;
        end
      else
        begin
          ContractedClientHeight := false;
          Timer2.Enabled := false;
        end;
    end
  else if (ContractedClientHeight = false) then
    begin
      if ClientHeight > MinClientHeight then
        begin
          ClientHeight := ClientHeight - 25;
        end
      else
        begin
          ContractedClientHeight := true;
          Timer2.Enabled := false;
        end;
    end;
end;

end.

我还定义了使用另一个TTimer滚动的表单。它还会创建形式闪烁。我认为这是由于Double Buffer,因为它在DevExpress VCL组件中不可用。

如何修复所有问题?如何在DevExpress VCL组件中添加双缓冲?

0 个答案:

没有答案