这个问题的上下文是我正在处理WM_NCPAINT和WM_NCACTIVATE,以便我可以自定义绘制我的非客户区域。可以找到有关我正在做什么以及我面临的问题的更多信息here。出于这个问题的目的,我不应该调用我在非客户区域绘图的方式。 (你可以在我链接的问题中这样做)
我面临的一个问题是非常明显的闪烁,经过一些代码踩到后我发现问题的很大一部分来自这段代码:
procedure TForm1.WMNCActivate(var message: TWMNCActivate);
begin
inherited;
FormFrame; //In this function, I do my own drawing.
end;
问题是在继承的调用之后,整个默认的非客户区域被绘制出来,只有在那之后,我自己的框架版本才会被绘制出来。我尝试打开双缓冲,但这并没有解决问题。
我尝试解决此问题的方法是通过实现我自己的双缓冲版本,您可以告诉您的表单在某个时刻开始缓冲(即将所有绘图重定向到位图)和显示另一点的变化,也由你选择。这样做的典型方法当然是直接绘制到缓冲区,但由于某些绘图没有由我明确地完成,所以这不是一个选项(我认为)
我决定尝试覆盖Canvas属性及其读取函数,并在缓冲开始时返回位图。那种方式(我认为)所有尝试直接绘制到我的表单的画布上,最终都会出现在Bitmap上,当我认为合适时,我可以将其绘制到屏幕上。 我尝试过的,不起作用,不一定要阅读,但这就是我扔在一起的东西:
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,因此内插器类不起作用,而是需要一个类助手。