Einzelnen Beitrag anzeigen

flashcoder

Registriert seit: 10. Nov 2013
83 Beiträge
 
#1

How elimitnate flicker of Form on resizing?

  Alt 6. Feb 2018, 01:26
Delphi-Version: 10 Seattle
I have this code below where is possible see desktop behind a full screen Form and have a trouble of flicker every time that Form is resized on these lines:

Delphi-Quellcode:
procedure TForm1.TakeScreenShot;
begin
  Width := 0;
  Height := 0;
  DoSnapShot := True;
  Width := ScreenRect.Width;
  Height := ScreenRect.Height;
end;
How prevent this flicker?

Thanks in advance

Full code:

Delphi-Quellcode:
type
  TForm1 = class(TForm)
    CAPTURAR: TButton;
    SAIR: TButton;
    procedure FormCreate(Sender: TObject);
    procedure CAPTURARClick(Sender: TObject);
    procedure SAIRClick(Sender: TObject);
  private
    DesktopBMP: TBitmap;
    DoSnapShot: boolean;
    ScreenRect: TRect;
    procedure TakeScreenShot;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
    { Public declarations }
  protected
    procedure Paint; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CAPTURARClick(Sender: TObject);
begin
  TakeScreenShot;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Left := 0;
  Top := 0;
  Width := Screen.Width;
  Height := Screen.Height - 10;

  ScreenRect := Rect(Left, Top, Width, Height);

  DesktopBMP := TBitmap.Create;
  DesktopBMP.SetSize(Width, Height);
end;

procedure TForm1.Paint;
begin
  inherited;
  // Canvas.Draw(0, 0, DesktopBMP);
  DesktopBMP.SaveToFile('c:\screen.bmp');
end;

procedure TForm1.SAIRClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.TakeScreenShot;
begin
  Width := 0;
  Height := 0;
  DoSnapShot := True;
  Width := ScreenRect.Width;
  Height := ScreenRect.Height;
end;

procedure TForm1.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  DesktopDC: HDC;
  DesktopHwnd: Hwnd;
  DesktopCanvas: TCanvas;
begin
  if DoSnapShot then
  begin
    DoSnapShot := False;
    DesktopHwnd := GetDesktopWindow;
    DesktopDC := GetDC(DesktopHwnd);
    try
      DesktopCanvas := TCanvas.Create;
      DesktopCanvas.Handle := DesktopDC;
      DesktopBMP.Canvas.CopyRect(ScreenRect, DesktopCanvas, ScreenRect);
    finally
      DesktopCanvas.Free;
      ReleaseDc(DesktopHwnd, DesktopDC);
    end;
  end;
  Message.Result := 1;
  inherited;
end;
PS: BorderStyle property is bsNone
Angehängte Dateien
Dateityp: zip test.zip (74,3 KB, 15x aufgerufen)

Geändert von flashcoder ( 6. Feb 2018 um 02:08 Uhr)
  Mit Zitat antworten Zitat