The context of this question is that I'm handling WM_NCPAINT and WM_NCACTIVATE so that I can custom paint my non client area. More information on what exactly I'm doing and the problems I'm facing can be found here. For the purpose of this question, the way I'm going about drawing on my non client area should not be called in question. (you can do that in the question I linked)
One of the problems I faced was that there was very noticable flickering, after some code stepping I found that a large portion of the problem stemmed from this piece of code:
procedure TForm1.WMNCActivate(var message: TWMNCActivate);
begin
inherited;
FormFrame; //In this function, I do my own drawing.
end;
The problem is that after the inherited call, the entire default non client area gets drawn and only after that, my own version of the frame gets drawn over. I tried turning on double buffering, but this did not solve the problem.
The way I tried to solve this problem is by implementing my own version of double buffering, where you could tell your form to start buffering at some point (i.e. redirecting all draws to a bitmap) and the show the changes at another point, also chosen by you. The typical way to do this is of course to draw directly to a buffer, but since some of the drawing is not done explicitely by me, that's not an option (I think)
What I decided to try is override the Canvas property and its read function and returning a bitmap when buffering has started. That way (I thought) all attempts to draw directly onto the canvas of my form, would end up on a Bitmap, which I can then draw onto the screen, when I see fit. What I tried, did not work and should not necessarily be read, but here's what I threw together:
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;
It compiled and ran without errors, but unfortunately did not work. I tried making an SSCCE, but for some reason, it throws Exception errors when trying to access the handle of the hacked FCanvas. You can find the full code here:
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.
I'm sure I'm doing a ton of things immensely wrong (a lot of thinsg I do in the code are only temporary since I first want to basic idea to work before investing time in doing things 'the right way'), but I feel like the basic idea of what I'm trying to do is not bad and should be possible.
So my questions are: What am I doing wrong? and more importantly:
What is the right way to go about creating the sort of buffer I'm trying to create?
edit Sertac pointed out that when the non client area gets painted, no references to the canvas are made, so it seems that in my case, my approach is useless. Perhaps what I'm doing could still be useful to avoid stubborn flickering in the client area though, I don't know. Peter made it clear that the SSCCE doesn't run because TForm1 never inherits from TCustomForm and thus an interposer class wouldn't work, in stead a class helper is needed.
