• 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控件的意义还不清楚,但是对它的图像子控件起作用?

  • 相关阅读:
    misc子系统
    Spring boot+RabbitMQ环境
    Linux input
    lnmp环境的搭建
    DDD的.NET开发框架
    【踩坑记】从HybridApp到ReactNative
    Migrating from IntelliJ Projects
    Windows下Redis中RedisQFork位置调整
    远程仓库版本回退方法 good
    maven repository
  • 原文地址:https://www.cnblogs.com/findumars/p/4757877.html
Copyright © 2020-2023  润新知