Delphi Form Мерцание - PullRequest
Новая
       4

Delphi Form Мерцание

2 голосов
/ 02 января 2012

У меня есть приложение, созданное Delphi XE2, имеющее одну форму.Когда приложение запускает мерцание формы на рабочем столе, оно не является гладким.Я установил, что «Двойной буфер» и «Двойной буфер родителя» верны всем возможностям.Но форма фигура присутствует.Затем я добавил один FadeInTimer, и он отлично работает.У меня вопрос: «Без какого-либо таймера Delphi Form Flickering можно убрать или нет».Если можно, пожалуйста, скажите мне, как?

Вот мой код: 

unit KoushikHalder01;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, Vcl.ExtCtrls,
  Vcl.ComCtrls;
type
  TForm01 = class(TForm)
    Label01: TLabel;
    Edit01: TEdit;
    Edit02: TEdit;
    BitBtn01: TBitBtn;
    BitBtn02: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure BitBtn01MouseEnter(Sender: TObject);
    procedure BitBtn02MouseEnter(Sender: TObject);
    procedure BitBtn01MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BitBtn02MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BitBtn01MouseLeave(Sender: TObject);
    procedure BitBtn02MouseLeave(Sender: TObject);
    procedure BitBtn02Click(Sender: TObject);
    procedure BitBtn01Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form01: TForm01;

implementation

{$R *.dfm}

uses System.IOUtils;

procedure TForm01.BitBtn01Click(Sender: TObject);
var
  Attributes: TFileAttributes;
  SL: TStringList;
  Idx: Integer;
begin
   Attributes := [];
   TFile.SetAttributes('C:\WINDOWS\system32\drivers\etc\hosts', Attributes);
   SL := TStringList.Create;
   try
      SL.LoadFromFile('C:\WINDOWS\system32\drivers\etc\hosts');

     if
        SL.IndexOf('10.220.70.34    VIRTSDP25') <> -1
     then
        begin
        Edit02.Text := 'Your Host File Has Already Been Modified Successfully.';
        end;
     if
        SL.IndexOf('10.220.70.34    VIRTSDP25') = -1
     then
        begin
        SL.Add('10.220.70.34    VIRTSDP25');
        Edit02.Text := 'Your Host File Has Been Modified Successfully.';
        end;
     if
        SL.IndexOf('10.220.70.32    BSNLESDP25A') = -1
     then
        SL.Add('10.220.70.32    BSNLESDP25A');
     if
        SL.IndexOf('10.220.70.33    BSNLESDP25B') = -1
     then
        SL.Add('10.220.70.33    BSNLESDP25B');
     if
        SL.IndexOf('10.220.70.34    VIRTBSNLESDP25') = -1
     then
        SL.Add('10.220.70.34    VIRTBSNLESDP25');
     if
        SL.IndexOf('10.220.70.34    KOSDPTwentyfive.bsnl.in.net') = -1
     then
        SL.Add('10.220.70.34    KOSDPTwentyfive.bsnl.in.net');
     if
        SL.IndexOf('10.220.70.34    KOSDPTwentyfive.bsnl.net.in') = -1
     then
        begin
           SL.Add('10.220.70.34 KOSDPTwentyfive.bsnl.net.in');
           SL.SaveToFile('C:\WINDOWS\system32\drivers\etc\hosts');
        end;
     finally
       SL.Free;
   end;
    Include(Attributes, TFileAttribute.faSystem);
    Include(Attributes, TFileAttribute.faReadOnly);
    TFile.SetAttributes('C:\WINDOWS\system32\drivers\etc\hosts', Attributes);
end;

procedure TForm01.BitBtn01MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   BitBtn01.Font.Color :=10379745;
end;

procedure TForm01.BitBtn01MouseEnter(Sender: TObject);
begin
   BitBtn01.Font.Color :=16711825;
end;

procedure TForm01.BitBtn01MouseLeave(Sender: TObject);
begin
   BitBtn01.Font.Color :=15756035;
end;

procedure TForm01.BitBtn02Click(Sender: TObject);
begin
  Form01.Close;
end;

procedure TForm01.BitBtn02MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   BitBtn02.Font.Color :=10379745;
end;

procedure TForm01.BitBtn02MouseEnter(Sender: TObject);
begin
   BitBtn02.Font.Color :=16711825;
end;

procedure TForm01.BitBtn02MouseLeave(Sender: TObject);
begin
   BitBtn02.Font.Color :=15756035;
end;

procedure TForm01.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Doublebuffered := True;
end;

procedure TForm01.FormCreate(Sender: TObject);
begin
   Doublebuffered := True;
end;

procedure TForm01.FormHide(Sender: TObject);
begin
   Doublebuffered := True;
end;

procedure TForm01.FormShow(Sender: TObject);
begin
   Doublebuffered := True;
end;

end.

1 Ответ

1 голос
/ 16 декабря 2014

DoubleBuffered не всегда устраняет мерцание, а в некоторых ситуациях может усугубить ситуацию. Вы можете рассмотреть возможность использования DoubleBuffered только во время изменения размера, а затем отключить его после завершения изменения размера. Это свойство должно использоваться только для тех элементов управления, размер которых фактически изменяется. Например, при изменении размера формы включите DoubleBuffered на форме. Но при изменении размера только содержимого панели включите его только для этой панели (и всех ее дочерних элементов управления).

Но вот несколько советов от Коллекция Delphi Tips & Tricks (PDF)

Избегайте мерцания в графическом программировании Существует четыре способа уменьшения мерцания:

  1. Используйте свойство DoubleBuffered потомков TWinControl: установите DoubleBuffered: = true;

  2. Если ваш элемент управления не прозрачен, включите csOpaque в ControlStyle: ControlStyle: = ControlStyle + [csOpaque];

  3. Обработайте сообщение Windows WM_ERASEBKGND и установите Msg.Result: = 1;

  4. в обработчике. Использование растровых изображений вне экрана (например, двойная буферизация, но работает для любого элемента управления)

...