• 研究一下TForm.WMPaint过程(也得研究WM_ERASEBKGND)——TForm虽然继承自TWinControl,但是自行模仿了TCustomControl的全部行为,一共三种自绘的覆盖方法,比TCustomControl还多一种


    先擦除背景:

    procedure TCustomForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
    begin
      if not IsIconic(Handle) then inherited 
      else
      begin
        Message.Msg := WM_ICONERASEBKGND;
        DefaultHandler(Message);
      end;
    end;
    
    procedure TWinControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
    begin
      with ThemeServices do
      if ThemesEnabled and Assigned(Parent) and (csParentBackground in FControlStyle) then
        begin
          { Get the parent to draw its background into the control's background. }
          DrawParentBackground(Handle, Message.DC, nil, False);
        end
        else
        begin
          { Only erase background if we're not doublebuffering or painting to memory. }
          if not FDoubleBuffered or
             (TMessage(Message).wParam = TMessage(Message).lParam) then
            FillRect(Message.DC, ClientRect, FBrush.Handle); // Brush的颜色事先读取好了
        end;
    
      Message.Result := 1;
    end;

    然后进行绘制(背景色已经事先存在,无论后面绘制了什么都不影响背景色,如果不绘制,就全部都是背景色):

    procedure TCustomForm.WMPaint(var Message: TWMPaint);
    var
      DC: HDC;
      PS: TPaintStruct;
    begin
      if not IsIconic(Handle) then
      begin
        ControlState := ControlState + [csCustomPaint]; // 模仿1
        inherited; // 模仿2
        ControlState := ControlState - [csCustomPaint];
      end
      else
      begin
        DC := BeginPaint(Handle, PS);
        DrawIcon(DC, 0, 0, GetIconHandle);
        EndPaint(Handle, PS);
      end;
    end;

    inherited会调用:

    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;

    TCustomForm有相应的覆盖函数:

    procedure TCustomForm.PaintWindow(DC: HDC); // 模仿3
    begin
      FCanvas.Lock;
      try
        FCanvas.Handle := DC;
        try
          if FDesigner <> nil then FDesigner.PaintGrid else Paint; // 模仿4
        finally
          FCanvas.Handle := 0;
        end;
      finally
        FCanvas.Unlock;
      end;
    end;

    Paint会调用:

    procedure TCustomForm.Paint; // Paint是dynamic函数,也是虚函数
    begin
      if Assigned(FOnPaint) then FOnPaint(Self); // 巨变:这里直接调用程序员事件,而不是等着程序员覆盖Paint函数(那样做也可以,另外还可直接覆盖PaintWindow虚函数,所以一共有3种方法,即:覆盖OnPaint事件,覆盖PaintWindow虚函数,覆盖Paint虚函数)
    end;

    这个FOnPaint来自:

        property OnPaint: TNotifyEvent read FOnPaint write FOnPaint stored IsForm;

    它会调用我写的事件内容:

    procedure TForm1.FormPaint(Sender: TObject);
    begin
      //
    end;

    即使为空,也丝毫不影响整个Form1的显示。也许像上面那样写会被编译器删除,那么我这样写:

    procedure TForm1.FormPaint(Sender: TObject);
    begin
      tag := 100;
    end;

    还是丝毫不影响整个Form1的显示。为什么会不影响呢?因为背景色提前就绘制在上面了,后面的OnPaint无论是否绘制,都不影响它的存在,顶多覆盖一小部分区域。比如:

    procedure TForm1.FormPaint(Sender: TObject);
    begin
        Canvas.Brush.Color := clRed;
        Canvas.Rectangle(0, 0, 100, 100);
    end;

    也就是覆盖了一个角,剩下的还是背景色。

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

    这里测试了覆盖Paint函数,OnPaint的代码保留,但是效果只有左上角一个小绿块,而没有红色方块。如果加上inherited(IDE会自动帮你加上,也就是推荐使用),那么红的绿的方块都有,比较有意思:

    procedure TForm1.Paint;
    begin
       // inherited;
        Canvas.Brush.Color := clGreen;
        Canvas.Rectangle(0, 0, 50, 50);
    end;

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

    唯一有个问题是,InitInheritedComponent读取dfm的颜色以后,是什么时候把它赋值给FBrush.Color的?它与{$R *.dfm}是什么关系?

  • 相关阅读:
    4-结对开发地铁
    第五周学习进度博客
    mybatis的使用
    从写json作业谈起
    工作中慢慢明白的道理
    从参与公司开发到离职
    这也是风云变幻的年代
    学习的习惯和方法跟得上时代要求
    公司中springcloud项目遇到的问题
    实习生在公司的成长
  • 原文地址:https://www.cnblogs.com/findumars/p/5218631.html
Copyright © 2020-2023  润新知