TWinControl的刷新过程(5个非虚函数,4个覆盖函数,1个消息函数,默认没有双缓冲,注意区分是TCustomControl还是Windows原生封装控件,执行流程不一样)

时间:2023-03-09 00:29:20
TWinControl的刷新过程(5个非虚函数,4个覆盖函数,1个消息函数,默认没有双缓冲,注意区分是TCustomControl还是Windows原生封装控件,执行流程不一样)

前提条件:要明白在TWinControl有以下四个函数的存在,注意都是虚函数:

procedure Invalidate; override;
procedure Update; override;
procedure Repaint; override; // 相当于前两句的组合
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; // 调用API显示

1个消息函数(图形控件没有相应的消息函数,除非程序员手动添加,我忽然有种感觉:消息函数简直让程序员无所不能

procedure CMInvalidate(var Message: TMessage); message CM_INVALIDATE;

还有从TControl继承来的5个非虚函数:

procedure Show; // 设置自己和所有祖先的visible标识
procedure Hide; // 简单设置visible标识,与祖先无关
procedure Refresh; // 简单调用Repaint虚函数,但Refresh本身不是虚函数。一般应该使用它,因为可以获得更多的无关性。
procedure SendToBack;
procedure BringToFront; // 图形控件也要用此能力啊,所以在TControl就已经定义了

procedure TWinControl.Invalidate;
begin
Perform(CM_INVALIDATE, , );
end; procedure TWinControl.Update;
begin
if HandleAllocated then UpdateWindow(FHandle);
end; procedure TWinControl.Repaint;
begin
Invalidate;
Update;
end; procedure TWinControl.CMInvalidate(var Message: TMessage);
var
I: Integer;
begin
if HandleAllocated then
begin
if Parent <> nil then Parent.Perform(CM_INVALIDATE, , );
if Message.WParam = then
begin
InvalidateRect(FHandle, nil, not (csOpaque in ControlStyle));
end;
end;
end;

-------------------------------------------------------------------------

举例1:按钮刷新

procedure TForm1.Button2Click(Sender: TObject);
begin
Button1.Invalidate;
Button1.Update;
end;

执行过程:

procedure TWinControl.Invalidate;
begin
Perform(CM_INVALIDATE, , );
end;
procedure TWinControl.CMInvalidate(var Message: TMessage);
var
I: Integer;
begin
if HandleAllocated then
begin
if Parent <> nil then Parent.Perform(CM_INVALIDATE, , );
if Message.WParam = then
begin
InvalidateRect(FHandle, nil, not (csOpaque in ControlStyle));
end;
end; procedure TWinControl.Update;
begin
if HandleAllocated then UpdateWindow(FHandle); // 产生WM_PAINT消息
end;
procedure TWinControl.WMPaint(var Message: TWMPaint);
procedure TWinControl.DefaultHandler(var Message);

其中WMPaint函数里有判断:

procedure TWinControl.WMPaint(var Message: TWMPaint);
var
DC, MemDC: HDC;
MemBitmap, OldBitmap: HBITMAP;
PS: TPaintStruct;
begin
if not FDoubleBuffered or (Message.DC <> ) then
begin
if not (csCustomPaint in ControlState) and (ControlCount = ) then
inherited // 执行这里
else
PaintHandler(Message);
end
else
begin
DC := GetDC();
MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
ReleaseDC(, DC);
MemDC := CreateCompatibleDC();
OldBitmap := SelectObject(MemDC, MemBitmap);
try
DC := BeginPaint(Handle, PS);
Perform(WM_ERASEBKGND, MemDC, MemDC);
Message.DC := MemDC;
WMPaint(Message);
Message.DC := ;
BitBlt(DC, , , ClientRect.Right, ClientRect.Bottom, MemDC, , , SRCCOPY);
EndPaint(Handle, PS);
finally
SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;
end;
end;

因为TButton本质上是包装了Button,所以最后的结果是在TWinControl.DefaultHandler里执行了:

Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);

---------------------------------------------------------------------------

举例2:Panel刷新

procedure TForm1.Button2Click(Sender: TObject);
begin
Panel1.Invalidate;
Panel1.Update;
end;

区别在于,Panel1有句柄,失效后,可自己接受WM_Paint进行刷新,其执行过程如下:

procedure TWinControl.Update;
begin
if HandleAllocated then UpdateWindow(FHandle); // 产生WM_PAINT消息
end; // WM_PAINT消息会发送到Panel1的MainWndProc函数(MakeObjectInstance转换后存储的地址)
procedure TWinControl.MainWndProc(var Message: TMessage);
begin
WindowProc(Message);
end; procedure TWinControl.WndProc(var Message: TMessage);
begin
inherited WndProc(Message);
end; procedure TControl.WndProc(var Message: TMessage);
begin
Dispatch(Message);
end; // Dispath后,终于在消息函数里找到响应函数
procedure TCustomControl.WMPaint(var Message: TWMPaint);
begin
Include(FControlState, csCustomPaint); // 注意,只有继承自TCustomControl的控件,才有这个标志位。另外TForm也有。
inherited;
Exclude(FControlState, csCustomPaint);
end; procedure TWinControl.WMPaint(var Message: TWMPaint);
var
DC, MemDC: HDC;
MemBitmap, OldBitmap: HBITMAP;
PS: TPaintStruct;
begin
if not FDoubleBuffered or (Message.DC <> ) then
begin
if not (csCustomPaint in ControlState) and (ControlCount = ) then
inherited // 对于没有子控件的系统包装控件执行这里,分得清清楚楚
else
PaintHandler(Message); // 执行这里
end
end; procedure TWinControl.PaintHandler(var Message: TWMPaint);
var
I, Clip, SaveIndex: Integer;
DC: HDC;
PS: TPaintStruct;
begin
DC := Message.DC;
if DC = then DC := BeginPaint(Handle, PS);
try
if FControls = nil then PaintWindow(DC) else
begin
SaveIndex := SaveDC(DC);
Clip := SimpleRegion;
for I := to FControls.Count - do
with TControl(FControls[I]) do
if (Visible or (csDesigning in ComponentState) and
not (csNoDesignVisible in ControlStyle)) and
(csOpaque in ControlStyle) then
begin
Clip := ExcludeClipRect(DC, Left, Top, Left + Width, Top + Height);
if Clip = NullRegion then Break;
end;
if Clip <> NullRegion then PaintWindow(DC);
RestoreDC(DC, SaveIndex);
end;
PaintControls(DC, nil);
finally
if Message.DC = then EndPaint(Handle, PS);
end;
end;

控件终于可以自绘自己了:

procedure TCustomControl.PaintWindow(DC: HDC);
begin
FCanvas.Lock;
try
FCanvas.Handle := DC;
try
TControlCanvas(FCanvas).UpdateTextFlags;
Paint;
finally
FCanvas.Handle := ;
end;
finally
FCanvas.Unlock;
end;
end; // 现场画出来。注意,TPanel没有OnPaint事件,所以就是控件纯自绘,程序员没机会插手
procedure TCustomPanel.Paint;
const
Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
Rect: TRect;
TopColor, BottomColor: TColor;
FontHeight: Integer;
Flags: Longint; procedure AdjustColors(Bevel: TPanelBevel);
begin
TopColor := clBtnHighlight;
if Bevel = bvLowered then TopColor := clBtnShadow;
BottomColor := clBtnShadow;
if Bevel = bvLowered then BottomColor := clBtnHighlight;
end; begin
Rect := GetClientRect;
if BevelOuter <> bvNone then
begin
AdjustColors(BevelOuter);
Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
end;
Frame3D(Canvas, Rect, Color, Color, BorderWidth);
if BevelInner <> bvNone then
begin
AdjustColors(BevelInner);
Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
end;
with Canvas do
begin
if not ThemeServices.ThemesEnabled or not ParentBackground then
begin
Brush.Color := Color;
FillRect(Rect);
end;
Brush.Style := bsClear;
Font := Self.Font;
FontHeight := TextHeight('W');
with Rect do
begin
Top := ((Bottom + Top) - FontHeight) div ;
Bottom := Top + FontHeight;
end;
Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[FAlignment];
Flags := DrawTextBiDiModeFlags(Flags);
DrawText(Handle, PChar(Caption), -, Rect, Flags);
end;
end;

---------------------------------------------------------------------------

举例3:Form刷新

procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Invalidate;
Form1.Update;
end;

执行:

procedure TWinControl.Invalidate;
begin
Perform(CM_INVALIDATE, , );
end; procedure TWinControl.CMInvalidate(var Message: TMessage);
var
I: Integer;
begin
if HandleAllocated then
begin
if Parent <> nil then Parent.Perform(CM_INVALIDATE, , );
if Message.WParam = then
begin
InvalidateRect(FHandle, nil, not (csOpaque in ControlStyle));
end;
end;
end; procedure TWinControl.Update;
begin
if HandleAllocated then UpdateWindow(FHandle); // 产生WM_PAINT消息
end; procedure TCustomForm.WMPaint(var Message: TWMPaint);
var
DC: HDC;
PS: TPaintStruct;
begin
if not IsIconic(Handle) then
begin
ControlState := ControlState + [csCustomPaint];
inherited;
ControlState := ControlState - [csCustomPaint];
end
else
begin
DC := BeginPaint(Handle, PS);
DrawIcon(DC, , , GetIconHandle);
EndPaint(Handle, PS);
end;
end; procedure TWinControl.WMPaint(var Message: TWMPaint);
var
DC, MemDC: HDC;
MemBitmap, OldBitmap: HBITMAP;
PS: TPaintStruct;
begin
if not FDoubleBuffered or (Message.DC <> ) then
begin
if not (csCustomPaint in ControlState) and (ControlCount = ) then
inherited
else
PaintHandler(Message); // 执行这里
end
else
begin
DC := GetDC();
MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
ReleaseDC(, DC);
MemDC := CreateCompatibleDC();
OldBitmap := SelectObject(MemDC, MemBitmap);
try
DC := BeginPaint(Handle, PS);
Perform(WM_ERASEBKGND, MemDC, MemDC);
Message.DC := MemDC;
WMPaint(Message);
Message.DC := ;
BitBlt(DC, , , ClientRect.Right, ClientRect.Bottom, MemDC, , , SRCCOPY);
EndPaint(Handle, PS);
finally
SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;
end;
end; procedure TWinControl.PaintHandler(var Message: TWMPaint);
var
I, Clip, SaveIndex: Integer;
DC: HDC;
PS: TPaintStruct;
begin
DC := Message.DC;
if DC = then DC := BeginPaint(Handle, PS);
try
if FControls = nil then PaintWindow(DC) else
begin
SaveIndex := SaveDC(DC);
Clip := SimpleRegion;
for I := to FControls.Count - do
with TControl(FControls[I]) do
if (Visible or (csDesigning in ComponentState) and
not (csNoDesignVisible in ControlStyle)) and
(csOpaque in ControlStyle) then
begin
Clip := ExcludeClipRect(DC, Left, Top, Left + Width, Top + Height);
if Clip = NullRegion then Break;
end;
if Clip <> NullRegion then PaintWindow(DC);
RestoreDC(DC, SaveIndex);
end;
PaintControls(DC, nil);
finally
if Message.DC = then EndPaint(Handle, PS);
end;
end;
// TWinControl.PaintHandler 包括执行:
procedure TCustomForm.PaintWindow(DC: HDC); // 绘制自己
procedure TCustomForm.Paint; // 调用程序员事件
procedure TWinControl.PaintControls(DC: HDC; First: TControl); // 注意,此函数只重绘图形子控件

---------------------------------------------------------------------------

举例4:Win控件开启DoubleBuffer的功能

注意,DoubleBuffered是TWinControl的属性

procedure TForm1.Button1Click(Sender: TObject);
begin
Panel1.DoubleBuffered := true;
Panel1.Invalidate;
Panel1.Update;
end;

执行过程:

procedure TWinControl.WMPaint(var Message: TWMPaint);
var
DC, MemDC: HDC;
MemBitmap, OldBitmap: HBITMAP;
PS: TPaintStruct;
begin
if not FDoubleBuffered or (Message.DC <> ) then
begin
if not (csCustomPaint in ControlState) and (ControlCount = ) then
inherited
else
PaintHandler(Message);
end
else // 第一次执行会走这里!
begin
DC := GetDC();
MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
ReleaseDC(, DC);
MemDC := CreateCompatibleDC();
OldBitmap := SelectObject(MemDC, MemBitmap);
try
DC := BeginPaint(Handle, PS);
Perform(WM_ERASEBKGND, MemDC, MemDC);
Message.DC := MemDC; // 使用内存DC,这样下次递归判断条件的时候,就会把控件都绘制在内存DC上,最后靠BitBlt把它们一次性绘制在当前控件Handle的DC上,好像也不难理解
WMPaint(Message); // 递归执行
Message.DC := ;
BitBlt(DC, , , ClientRect.Right, ClientRect.Bottom, MemDC, , , SRCCOPY);
EndPaint(Handle, PS);
finally
SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;
end;
end;

但是双缓冲对于Win控件的意义还不清楚,但是对它的图像子控件起作用?