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, 0, 0);
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, 1, 0);
    if Message.WParam = 0 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, 0, 0);
end;
procedure TWinControl.CMInvalidate(var Message: TMessage);
var
  I: Integer;
begin
  if HandleAllocated then
  begin
    if Parent <> nil then Parent.Perform(CM_INVALIDATE, 1, 0);
    if Message.WParam = 0 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 <> 0) then
  begin
    if not (csCustomPaint in ControlState) and (ControlCount = 0) then
      inherited // 执行这里
    else
      PaintHandler(Message);
  end
  else
  begin
    DC := GetDC(0);
    MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
    ReleaseDC(0, DC);
    MemDC := CreateCompatibleDC(0);
    OldBitmap := SelectObject(MemDC, MemBitmap);
    try
      DC := BeginPaint(Handle, PS);
      Perform(WM_ERASEBKGND, MemDC, MemDC);
      Message.DC := MemDC;
      WMPaint(Message);
      Message.DC := 0;
      BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, 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 <> 0) then
  begin
    if not (csCustomPaint in ControlState) and (ControlCount = 0) 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 = 0 then DC := BeginPaint(Handle, PS);
  try
    if FControls = nil then PaintWindow(DC) else
    begin
      SaveIndex := SaveDC(DC);
      Clip := SimpleRegion;
      for I := 0 to FControls.Count - 1 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 = 0 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 := 0;
    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 2;
      Bottom := Top + FontHeight;
    end;
    Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[FAlignment];
    Flags := DrawTextBiDiModeFlags(Flags);
    DrawText(Handle, PChar(Caption), -1, Rect, Flags);
  end;
end;

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

举例3:Form刷新

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

执行:

procedure TWinControl.Invalidate;
begin
  Perform(CM_INVALIDATE, 0, 0);
end;

procedure TWinControl.CMInvalidate(var Message: TMessage);
var
  I: Integer;
begin
  if HandleAllocated then
  begin
    if Parent <> nil then Parent.Perform(CM_INVALIDATE, 1, 0);
    if Message.WParam = 0 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, 0, 0, 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 <> 0) then
  begin
    if not (csCustomPaint in ControlState) and (ControlCount = 0) then
      inherited
    else
      PaintHandler(Message); // 执行这里
  end
  else
  begin
    DC := GetDC(0);
    MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
    ReleaseDC(0, DC);
    MemDC := CreateCompatibleDC(0);
    OldBitmap := SelectObject(MemDC, MemBitmap);
    try
      DC := BeginPaint(Handle, PS);
      Perform(WM_ERASEBKGND, MemDC, MemDC);
      Message.DC := MemDC;
      WMPaint(Message);
      Message.DC := 0;
      BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, 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 = 0 then DC := BeginPaint(Handle, PS);
  try
    if FControls = nil then PaintWindow(DC) else
    begin
      SaveIndex := SaveDC(DC);
      Clip := SimpleRegion;
      for I := 0 to FControls.Count - 1 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 = 0 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 <> 0) then
  begin
    if not (csCustomPaint in ControlState) and (ControlCount = 0) then
      inherited
    else
      PaintHandler(Message);
  end
  else // 第一次执行会走这里!
  begin 
    DC := GetDC(0);
    MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
    ReleaseDC(0, DC);
    MemDC := CreateCompatibleDC(0);
    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 := 0;
      BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
      EndPaint(Handle, PS);
    finally
      SelectObject(MemDC, OldBitmap);
      DeleteDC(MemDC);
      DeleteObject(MemBitmap);
    end;
  end;
end;

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

原文地址:https://www.cnblogs.com/findumars/p/4757877.html