Delphi 更可控的双缓冲

Delphi 更可控的双缓冲,delphi,graphics,vcl,delphi-xe3,double-buffering,Delphi,Graphics,Vcl,Delphi Xe3,Double Buffering,这个问题的背景是我正在处理WM_NCPAINT和WM_NCACTIVATE,以便我可以自定义绘制非客户区。更多关于我正在做什么和我面临的问题的信息可以找到。就这个问题而言,我在非客户区的绘图方式不应该受到质疑。(你可以在我链接的问题中这样做) 我面临的一个问题是出现了非常明显的闪烁,经过一些代码步进后,我发现问题的很大一部分源于这段代码: procedure TForm1.WMNCActivate(var message: TWMNCActivate); begin inherited;

这个问题的背景是我正在处理WM_NCPAINT和WM_NCACTIVATE,以便我可以自定义绘制非客户区。更多关于我正在做什么和我面临的问题的信息可以找到。就这个问题而言,我在非客户区的绘图方式不应该受到质疑。(你可以在我链接的问题中这样做)

我面临的一个问题是出现了非常明显的闪烁,经过一些代码步进后,我发现问题的很大一部分源于这段代码:

procedure TForm1.WMNCActivate(var message: TWMNCActivate);
begin
  inherited;
  FormFrame; //In this function, I do my own drawing.
end;
问题是,在继承调用之后,整个默认的非客户端区域都会被绘制出来,只有在这之后,我自己的框架版本才会被绘制出来。我尝试打开双缓冲,但这并没有解决问题

我试图解决这个问题的方法是实现我自己版本的双缓冲,您可以告诉表单在某个点开始缓冲(即将所有绘图重定向到位图),然后在另一点显示更改,这也是您选择的。这样做的典型方法当然是直接绘制到缓冲区,但由于一些绘制不是我明确完成的,所以这不是一个选项(我认为)

我决定尝试重写Canvas属性及其read函数,并在缓冲开始时返回位图。这样(我认为)所有直接在我的表单画布上绘制的尝试都会在位图上结束,当我觉得合适时,我可以在屏幕上绘制位图我尝试过的东西不起作用,也不一定要读,但下面是我总结的:

public
  property Canvas: TCanvas read GetCanvas;
...

implementation

procedure TForm1.WMNCActivate(var message: TWMNCActivate);
begin
  SetBuffer(true);
  inherited;
  FormFrame;
  SetBuffer(false);
end;

procedure TForm1.SetBuffer(turnOn: Boolean);
var
  DC: HDC;
begin
  if FUseCustomBuffer = turnOn then
    exit;

  if turnOn then begin
    FUseCustomBuffer := true;
    FBuffer := TBitmap.Create;
    try
      Assert(HandleAllocated);
      DC := GetWindowDC(Handle);
      Win32Check(DC <> 0);

      FBuffer.SetSize(Width, Height);

      Win32Check(BitBlt(FBuffer.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY));
    finally
      ReleaseDC(Handle, DC);
    end;
  end else begin
    FUseCustomBuffer := false;
    try
      Assert(HandleAllocated);

      THackedCustomForm(self).FCanvas.Handle := GetWindowDC(Handle); //THackedCustomForm is used to access FCanvas

      Win32Check(BitBlt(THackedCustomForm(self).FCanvas.Handle, 0, 0, Width, Height, FBuffer.Canvas.Handle, 0, 0, SRCCOPY));
    finally
      FBuffer.Free;
    end;
  end;
end;

function TForm1.GetCanvas: TCanvas;
begin
  if FUseCustomBuffer then
    Result := FBuffer.Canvas
  else
    Result := THackedCustomForm(self).FCanvas;
end;
公共
属性画布:TCanvas read GetCanvas;
...
实施
过程TForm1.WMNCActivate(变量消息:TWMNCActivate);
开始
SetBuffer(真);
继承;
模板;
SetBuffer(假);
终止
程序TForm1.SetBuffer(打开:布尔值);
变量
DC:HDC;
开始
如果FUseCustomBuffer=打开
出口
如果打开,则开始
FUseCustomBuffer:=真;
FBuffer:=TBitmap.Create;
尝试
断言(HandleAllocated);
DC:=GetWindowDC(句柄);
Win32Check(dc0);
FBuffer.SetSize(宽度、高度);
Win32Check(BitBlt(FBuffer.Canvas.Handle,0,0,宽度,高度,DC,0,0,SRCCOPY));
最后
释放DC(手柄,DC);
终止
结束,否则开始
FUseCustomBuffer:=假;
尝试
断言(HandleAllocated);
THackedCustomForm(self).FCanvas.Handle:=GetWindowDC(Handle)//THackedCustomForm用于访问FCanvas
Win32Check(BitBlt(THackedCustomForm(self).FCanvas.Handle,0,0,Width,Height,FBuffer.Canvas.Handle,0,0,SRCCOPY));
最后
免费的;
终止
终止
终止
函数TForm1.GetCanvas:TCanvas;
开始
如果是FUseCustomBuffer那么
结果:=FBuffer.Canvas
其他的
结果:=THackedCustomForm(self).FCanvas;
终止
它编译并运行时没有错误,但不幸的是没有工作。我尝试制作一个SSCCE,但由于某种原因,它在试图访问被黑客攻击的FCanvas的句柄时抛出异常错误。您可以在此处找到完整的代码:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, VCL.Forms, Vcl.Dialogs;

type

THackedCustomForm = class(TCustomForm)
  protected
    FCanvas: TControlCanvas;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    FUseCustomBuffer: Boolean;
    FBuffer: TBitmap;

    procedure WMNCActivate(var message : TWMNCActivate); message WM_ACTIVATE;
    procedure WMNCHitTest(var message : TWMNCHitTest); message WM_NCHitTest;
    procedure WMNCLBUTTONDOWN(var message : TWMNCLBUTTONDOWN); message WM_NCLBUTTONDOWN;
    procedure WMNCPaint(var message : TMessage); message WM_NCPaint;
    procedure FormFrame;
    function GetCanvas: TCanvas;
    procedure SetBuffer(turnOn: Boolean);
  public
    property Canvas: TCanvas read GetCanvas;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  FUseCustomBuffer := false;
  THackedCustomForm(self).FCanvas := TCustomForm(self).Canvas as TControlCanvas;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetBuffer(false);
end;

procedure TForm1.FormFrame;
var
  YCaption, YFrame, XFrame: Integer;
  menuHdc: HDC;
  s: string;
begin
  YCaption := GetSystemMetrics(SM_CYCaption);
  YFrame := GetSystemMetrics(SM_CYFRAME);
  XFrame := GetSystemMetrics(SM_CXFRAME);
  Canvas.Handle := GetWindowDC(Handle);

  Canvas.Pen.Style := psClear;

  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clRed;

  Canvas.Rectangle(0, 0, Width + 1, YCaption + YFRame + 1);
  Canvas.Rectangle(0, YCaption + YFRame, XFrame + 1, Height + 1);
  Canvas.Rectangle(XFrame, Height - YFrame, Width + 1, Height + 1);
  Canvas.Rectangle(Width - XFrame, YCaption + YFRame, Width + 1, Height - YFrame + 1);

  Canvas.Font.Color := clWhite;
  Canvas.Font.Size := 10;
  Canvas.Font.Style := [fsBold];
  Canvas.Font.Name := 'Calibri';
  Canvas.TextOut(XFrame + 10, YFrame, Caption);

  Canvas.Font.Size := 20;
  Canvas.TextOut(Width - XFrame - 15, YFrame - 11, 'x');
  Canvas.TextOut(Width - XFrame - 35, YFrame - 11, '+');
  Canvas.TextOut(Width - XFrame - 55, YFrame - 11, '-');
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  FUseCustomBuffer := false;
end;

function TForm1.GetCanvas: TCanvas;
begin
  if FUseCustomBuffer then
    Result := FBuffer.Canvas
  else
    Result := THackedCustomForm(self).FCanvas;
end;

procedure TForm1.SetBuffer(turnOn: Boolean);
var
  DC: HDC;
begin
  if FUseCustomBuffer = turnOn then
    exit;

  if turnOn then begin
    FUseCustomBuffer := true;
    FBuffer := TBitmap.Create;
    try
      Assert(HandleAllocated);
      DC := GetWindowDC(Handle);
      Win32Check(DC <> 0);

      FBuffer.SetSize(Width, Height);

      Win32Check(BitBlt(FBuffer.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY));
    finally
      ReleaseDC(Handle, DC);
    end;
  end else begin
    FUseCustomBuffer := false;
    try
      Assert(HandleAllocated);

      THackedCustomForm(self).FCanvas.Handle := GetWindowDC(Handle);

      Win32Check(BitBlt(THackedCustomForm(self).FCanvas.Handle, 0, 0, Width, Height, FBuffer.Canvas.Handle, 0, 0, SRCCOPY));
    finally
      FBuffer.Free;
    end;
  end;
end;

procedure TForm1.WMNCActivate(var message: TWMNCActivate);
begin
  SetBuffer(true);
  inherited;
  FormFrame;
  SetBuffer(false);
end;

procedure TForm1.WMNCHitTest(var message: TWMNCHitTest);
begin
  inherited;
  case message.Result of
    HTMINBUTTON, HTMAXBUTTON, HTCLOSE:
      message.Result := HTCAPTION;
  end;
end;

procedure TForm1.WMNCLBUTTONDOWN(var message: TWMNCLBUTTONDOWN);
var
  X, Y: Integer;
begin
  inherited;
  X := message.XCursor - Left;
  Y := message.YCursor - Top;

  if (X < Width - 8) and (X > Width - 28) and (Y > 1) and (Y < 20) then
    Close;

  if (X < Width - 28) and (X > Width - 48) and (Y > 1) and (Y < 20) then
    if WindowState = wsMaximized then
      ShowWindow(Handle, SW_SHOWNORMAL)
    else
      ShowWindow(Handle, SW_SHOWMAXIMIZED);

  if (X < Width - 48) and (X > Width - 68) and (Y > 1) and (Y < 20) then
    ShowWindow(Handle, SW_SHOWMINIMIZED);
end;

procedure TForm1.WMNCPaint(var message: TMessage);
begin
  SendMessage(Handle, WM_NCActivate, ORD(self.Active), -1)
end;

end.
单元1;
界面
使用
Winapi.Windows、Winapi.Messages、System.SysUtils、System.Variants、System.Classes、Vcl.Graphics、,
控件、窗体、对话框;
类型
THackedCustomForm=类(TCustomForm)
受保护的
FCanvas:TControlCanvas;
终止
TForm1=类(TForm)
过程表单创建(发送方:ToObject);
销毁程序表(发送方:TObject);
程序表单显示(发送方:TObject);
私有的
FUseCustomBuffer:布尔值;
FBuffer:TBitmap;
过程WMNCActivate(var消息:TWMNCActivate);信息WM_激活;
程序WMNCHitTest(var消息:TWMNCHitTest);信息WM_NCHitTest;
过程WMNCLBUTTONDOWN(变量消息:TWMNCLBUTTONDOWN);消息WM_nclubuttondown;
程序WMNCPaint(var消息:TMessage);消息WM_NCPaint;
程序框架;
函数GetCanvas:TCanvas;
程序SetBuffer(打开:布尔值);
平民的
属性画布:TCanvas read GetCanvas;
终止
变量
表1:TForm1;
实施
{$R*.dfm}
{TForm1}
过程TForm1.FormCreate(发送方:TObject);
开始
FUseCustomBuffer:=假;
THackedCustomForm(self).FCanvas:=TCustomForm(self).Canvas作为TControlCanvas;
终止
程序TForm1.FormDestroy(发送方:ToObject);
开始
SetBuffer(假);
终止
程序TForm1.FormFrame;
变量
YCaption,YFrame,XFrame:整数;
menuHdc:HDC;
s:字符串;
开始
YCaption:=GetSystemMetrics(SM_CYCaption);
YFrame:=GetSystemMetrics(SM_CYFRAME);
XFrame:=GetSystemMetrics(SM_CXFRAME);
Canvas.Handle:=GetWindowDC(句柄);
Canvas.Pen.Style:=psClear;
Canvas.Brush.Style:=bsSolid;
Canvas.Brush.Color:=clRed;
画布矩形(0,0,宽度+1,YCaption+YFRame+1);
画布.矩形(0,YCaption+YFRame,XFrame+1,高度+1);
Canvas.Rectangle(XFrame,高度-YFrame,宽度+1,高度+1);
Canvas.Rectangle(宽度-XFrame,YCaption+YFRame,宽度+1,高度-YFRame+1);
Canvas.Font.Color:=clWhite;
Canvas.Font.Size:=10;
Canvas.Font.Style:=[fsBold];
Canvas.Font.Name:=“Calibri”;
TextOut(XFrame+10,YFrame,标题);
Canvas.Font.Size:=20;
TextOut(宽度-XFrame-15,YFrame-11,'x');
TextOut(宽度-XFrame-35,YFrame-11,“+”);
TextOut(宽度-XFrame-55,YFrame-11'-');
终止
程序TForm1.FormShow(发送方:TObject);
开始
FUseCustomBuffer:=假;
终止
函数TForm1.GetCanvas:TCanvas;
开始
如果是FUseCustomBuffer那么
结果:=FBuffer.Canvas
其他的
结果:=THackedCustomForm(self).FCanvas;
终止
程序TForm1.SetBuffer(打开:布尔值);
变量
DC:HDC;
开始
如果FUseCustomBuffer=开启,则
出口
如果打开,则开始
FUseCustomBuffer:=真;
FBuffer:=TBitmap.Create;
尝试
断言(HandleAllocated);
DC:=GetWindowDC(句柄);
Win32Check(DC)