0

这个问题的上下文是我正在处理 WM_NCPAINT 和 WM_NCACTIVATE 以便我可以自定义绘制我的非客户区。关于我到底在做什么以及我面临的问题的更多信息可以在这里找到。出于这个问题的目的，不应该质疑我在非客户区域上绘图的方式。（你可以在我链接的问题中做到这一点）

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

procedure TForm1.WMNCActivate(var message: TWMNCActivate);
begin
  inherited;
  FormFrame; //In this function, I do my own drawing.
end;

问题是在继承调用之后，整个默认的非客户区都被绘制出来，只有在那之后，我自己的框架版本才会被绘制出来。我尝试打开双缓冲，但这并没有解决问题。

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

我决定尝试的是覆盖 Canvas 属性及其读取功能，并在缓冲开始时返回位图。这样（我认为）所有直接在我的表单画布上绘制的尝试最终都会出现在一个位图上，然后我可以在我认为合适的时候将其绘制到屏幕上。我试过的，没有用，不一定要阅读，但这是我拼凑的：

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;

它编译并运行没有错误，但不幸的是没有工作。我尝试制作 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.

但我觉得我正在尝试做的基本想法还不错，应该是可能的。

所以我的问题是：我做错了什么？更重要的是：

创建我要创建的那种缓冲区的正确方法是什么？

编辑 Sertac 指出，当绘制非客户区时，不会对画布进行任何引用，所以在我的情况下，我的方法似乎是无用的。我不知道，也许我正在做的事情仍然有助于避免客户区的顽固闪烁。Peter 明确表示 SSCCE 不会运行，因为 TForm1 从不从 TCustomForm 继承，因此插入器类不起作用，而是需要类帮助器。

4

0 回答 0