zoukankan      html  css  js  c++  java
  • 一行代码设置TLabel.Caption的前世今生

    第零步,测试代码:

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      Label1.Caption := 'Hello World';
    end;
    

    ---------------------------------------------------------------
    第一步,先看TLabel的继承过程,及其关键属性:

      TControl = class(TComponent)
      protected
        property Caption: TCaption read GetText write SetText stored IsCaptionStored;
        property Text: TCaption read GetText write SetText; // 和Caption是一回事,别名而已
        property WindowText: PChar read FText write FText; // Windows窗口的真正标题
      end;
    
      TGraphicControl = class(TControl)
      private
        FCanvas: TCanvas; // 私有内部画板,不用程序员申请就有了
      end;
    
      TCustomLabel = class(TGraphicControl)
      public
        property Caption; // 变成公开属性,但不是发布属性
      end;
    
      TLabel = class(TCustomLabel)
      published
        property Caption; // 变成发布属性
      end;

    显然,最后调用的还是TControl.SetText;函数起了左右,也是真正的入口函数。

    ---------------------------------------------------------------
    第二步,查看函数调用过程,发现分为两个消息步骤,先发消息设置文字,后发消息通知文字改变了:

    procedure TControl.SetText(const Value: TCaption);
    begin
      if GetText <> Value then SetTextBuf(PChar(Value)); // 类函数
    end;
    
    procedure TControl.SetTextBuf(Buffer: PChar);
    begin
      Perform(WM_SETTEXT, 0, Longint(Buffer)); // 先发消息设置文字
      Perform(CM_TEXTCHANGED, 0, 0);           // 文字设置完了,还要通知一下,TEdit,TLabel和TGroupBox都有相应的消息处理函数
    end;
    
    // WM_SETTEXT消息一路传递,先在TLabel自己和各个祖先类里的WndProc检索,后开始查找自己和各祖先类WM_SETTEXT的消息函数,发现都没有处理,最后到这里才会被处理:
    procedure TControl.DefaultHandler(var Message);
    var
      P: PChar;
    begin
      with TMessage(Message) do
        case Msg of
          WM_GETTEXT: // 取得文字
            begin
              if FText <> nil then P := FText else P := '';
              Result := StrLen(StrLCopy(PChar(LParam), P, WParam - 1));
            end;
          WM_GETTEXTLENGTH: // 取得文字长度
            if FText = nil then Result := 0 else Result := StrLen(FText);
          WM_SETTEXT: // 设置文字
            begin
              P := StrNew(PChar(LParam));
              StrDispose(FText);
              FText := P; // 这里设置Caption
              SendDockNotification(Msg, WParam, LParam);
            end;
        end;
    end;
    

    ---------------------------------------------------------------
    第三步,上面的函数合起来只是重新设置了TLabel的Caption属性文字,这还远远不代表什么。因为还需要显示它,这才是重头戏。因此TControl(也就是TLabel)马上发送了CM_TEXTCHANGED消息,并当场在TLabel类中就找到相应的消息函数:

    procedure TCustomLabel.CMTextChanged(var Message: TMessage);
    begin
      Invalidate;   // 调用TControl.Invalidate;使其图像失效
      AdjustBounds; // 类函数,看看有没有必要调整大小和边框
    end;
    
    // 这个函数基本上是图形控件使用的,因为TWinControl覆盖了这个函数,永远不会执行到这里来
    // 这个函数存在的意义是,让其它类函数简单调用,这里负责加上类的属性成员作为参数。起了一个桥梁和中介的作用。
    procedure TControl.Invalidate;
    begin
      // 图形控件默认不透明风格。但是新增标签的时候,默认就是不透明。
      InvalidateControl(Visible, csOpaque in ControlStyle); // important 刷新无效区域的时候,还要传递控件的不透明状态
    end;
    
    // 非虚函数,私有函数,主要是决定是否使控件图像失效
    procedure TControl.InvalidateControl(IsVisible, IsOpaque: Boolean);
    var
      bParentOpaque: Boolean;
      bChlipped: Boolean; 
      Rect: TRect;
      // 检测自己是否被完全掩盖(剪裁)
      function BackgroundClipped: Boolean;
      var
        R: TRect;
        List: TList;
        I: Integer;
        C: TControl;
      begin
        Result := True; // 默认不需要重画,直到发现自己有一部分需要重画
        List := FParent.FControls; // 专指父控件的图形子控件列表
        I := List.IndexOf(Self); // 从父控件的子控件列表里寻找自己。
        while I > 0 do
        begin
          Dec(I);  // 根据子控件的兄长来计算自己是否需要重画。
          C := List[I];
          with C do
            if C.Visible and (csOpaque in ControlStyle) then // 如果可视并且不透明
            begin
              // 这些计算对Rect本身不影响
              IntersectRect(R, Rect, BoundsRect); // API,计算交叉区域,第二个参数是自己的矩形,第三个是兄弟的矩形
              if EqualRect(R, Rect) then Exit;    // API,交叉区域与自己的矩形完全相等,即完全被覆盖就退出,也就是不用重画了
            end;
        end;
        Result := False; // 兄长都与其不相等,即有一部分需要重画,即背景没有被剪裁(或者没有被完全掩盖)
      end;
    begin
      //  要求显示         正处于组件设计状态              不是 设计期间不可视
      if (IsVisible or (csDesigning in ComponentState) and not (csNoDesignVisible in ControlStyle))
      // 父控件不为空              父控件有句柄
         and (Parent <> nil) and Parent.HandleAllocated then
      begin
        Rect := BoundsRect; // 类函数,简单计算(根据控件的长宽高)标签的坐标以及尺寸
        //  为了分析更清楚,我改成成以下语句:
        bParentOpaque := csOpaque in Parent.ControlStyle; // Form默认透明(csOpaque不在风格里)。但是父控件不一定是Form,不要思维僵化在这里。
        bChlipped:=BackgroundClipped; // 一般情况下,图形控件之间完全重合也是不可能的
        // 实验说明后两个一般情况下都是False,所以一般情况下只依赖于控件自己
        // 第三个参数为False,则保持背景不变。Not作用符以后,有三者条件之一成立即可,就会保持背景不变。
        InvalidateRect(Parent.Handle, @Rect, not (IsOpaque or bParentOpaque or bChlipped)); // API
      end;
    end;
    
    procedure TCustomLabel.AdjustBounds;
    const
      WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
    var
      DC: HDC;
      X: Integer;
      Rect: TRect;
      AAlignment: TAlignment;
    begin
      if not (csReading in ComponentState) and FAutoSize then
      begin
        Rect := ClientRect; // TControl的类属性,调用虚函数取得客户区(默认就是0,0,Width,Height)
        DC := GetDC(0); // API,参数0表示整个屏幕的DC
        Canvas.Handle := DC; // 给Label的canvas一个句柄,这样才能自绘
        // 根据三个参数(展开Tab的8个字符,是否换行)来计算所需区域
        DoDrawText(Rect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]); // 类保护函数,第一个参数是指针传递
        Canvas.Handle := 0; // 画完就不需要句柄了
        ReleaseDC(0, DC); // API
        X := Left;
        // 记录现在的左右对齐情况
        AAlignment := FAlignment;
        // 如有必要就颠倒左右对齐
        if UseRightToLeftAlignment then // TControl类函数,查看民族文字是左对齐还是右对齐
          ChangeBiDiModeAlignment(AAlignment); // Control单元的全局函数,颠倒原来的左右对齐
        // 如果是右对齐,那么重新计算文字的起点
        if AAlignment = taRightJustify then
          Inc(X, Width - Rect.Right);
        SetBounds(X, Top, Rect.Right, Rect.Bottom); // TControl的类函数
      end;
    end;
    
    procedure TCustomLabel.DoDrawText(var Rect: TRect; Flags: Longint);
    var
      Text: string;
    begin
      Text := GetLabelText;
      if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and (Text[1] = '&') and (Text[2] = #0)) then
        Text := Text + ' ';
      if not FShowAccelChar then Flags := Flags or DT_NOPREFIX;
      Flags := DrawTextBiDiModeFlags(Flags);
      // 说到底,还是依靠Canvas来画图写文字
      Canvas.Font := Font;
      if not Enabled then
      begin
        OffsetRect(Rect, 1, 1); // API
        Canvas.Font.Color := clBtnHighlight; // 白亮色
        DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); // API
        OffsetRect(Rect, -1, -1); // API
        Canvas.Font.Color := clBtnShadow;    // 加阴影
        DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); // API
      end
      // 一般走这里
      else
        DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
    end;
    
    // SetBounds 做了六件事:重新计算长宽,使控件失效,重新铆接,发消息WM_WINDOWPOSCHANGED通知Windows位置变了,最后对齐,还要调用程序员OnResize事件
    procedure TControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
    begin
      if CheckNewSize(AWidth, AHeight) and // TControl的类函数
        ((ALeft <> FLeft) or (ATop <> FTop) or (AWidth <> FWidth) or (AHeight <> FHeight)) then
      begin
        InvalidateControl(Visible, False); // TControl的类函数,第二个参数表示暂时设置当前控件是透明的
        FLeft := ALeft;
        FTop := ATop;
        FWidth := AWidth;
        FHeight := AHeight;
        UpdateAnchorRules; // TControl的类函数,坐标和长宽设置完了,就要重新铆接一下
        // 属性设置完了,如果有API可以使之起作用就当场调用(关于显示部分,不需要句柄就有API使用,这是特殊情况)
        Invalidate; // TControl的类函数,调用TControl.InvalidateControl,再调用API声明无效区域
        // 此消息在TControl和TWinControl里都有相应的函数,图形控件使用消息再做一些自己力所能及的变化,Win控件使用消息调用类函数使之调用API真正起作用
        // 前者重新计算最大化最小化的限制和坞里的尺寸,后者使用API调整边框和控件自己的位置,当然也得重新计算最大化最小化的限制和坞里的尺寸(三明治手法) 
        Perform(WM_WINDOWPOSCHANGED, 0, 0);
        // Windows位置调整完了,还要重新对齐(本质是调用TWinControl.RequestAlign,然后调用API重新排列)
        // 但实际上是靠父Win控件重新排列自己,因为它自己没有能力拥有别的控件,当然也就不能实质上让所有控件对齐。
        RequestAlign; // TControl的虚函数,各WinControl的子类可自己改写,比如TCustomForm就改写了
        if not (csLoading in ComponentState) then Resize; // TControl的虚函数,简单调用程序员事件。子类一般不需要改写它。
      end;
    end;
    
    procedure TControl.WMWindowPosChanged(var Message: TWMWindowPosChanged);
    begin
      // 先执行潜在的程序员消息函数
      // 这里其实不会是TControl自己调用inherited,因为没有TControl的直接实例,而是由它的子类比如TLabel来调用
      // 因此会调用TLabel的WM_WINDOWPOSCHANGED消息函数,如果它有的话
      inherited;
      // 后根据新的长宽,给控件最大长度和最大宽度重新赋值
      { Update min/max width/height to actual extents control will allow }
      if ComponentState * [csReading, csLoading] = [] then
      begin
        with Constraints do // 类属性
        begin
          if (MaxWidth > 0) and (Width > MaxWidth) then
            FMaxWidth := Width
          else if (MinWidth > 0) and (Width < MinWidth) then
            FMinWidth := Width;
          if (MaxHeight > 0) and (Height > MaxHeight) then
            FMaxHeight := Height
          else if (MinHeight > 0) and (Height < MinHeight) then
            FMinHeight := Height;
        end;
        // 根据消息传来的结构体的值,计算坞尺寸
        if Message.WindowPos <> nil then
          with Message.WindowPos^ do
            if (FHostDockSite <> nil) and not (csDocking in ControlState)  and
              (Flags and SWP_NOSIZE = 0) and (cx <> 0) and (cy <> 0) then
              CalcDockSizes; // 类函数
      end;
    end;
    

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

    第四步:虽然使用API把文字绘制好了,但是还得等待WM_Paint消息,然后进行绘制。其实图形控件无法直接收到WM_Paint消息,但是其父控件,比如TForm能收到WM_Paint消息,它会检测自己是否有无效区域,然后重绘所有子控件。
    因为TForm是直接继承自TWinControl,所以总体顺序如下:
    TCustomForm.WMPaint(var Message: TWMPaint);
    TWinControl.WMPaint(var Message: TWMPaint);
    TWinControl.PaintHandler(var Message: TWMPaint);
    TWinControl.PaintWindow(DC: HDC);
    TWinControl.PaintControls(DC: HDC; First: TControl);
    其中:

    procedure TWinControl.PaintControls(DC: HDC; First: TControl);
    var
      I, Count, SaveIndex: Integer;                                    
      FrameBrush: HBRUSH;
    begin
      if FControls <> nil then // 专指图形控件,不包含windows控件
      begin
        I := 0;
        if First <> nil then
        begin
          I := FControls.IndexOf(First);
          if I < 0 then I := 0;
        end;
        Count := FControls.Count;
        while I < Count do
        begin
          with TControl(FControls[I]) do
            if (Visible or (csDesigning in ComponentState) and not (csNoDesignVisible in ControlStyle)) and
              RectVisible(DC, Rect(Left, Top, Left + Width, Top + Height)) then // API,看rect是否在DC中可见
            begin
              if csPaintCopy in Self.ControlState then Include(FControlState, csPaintCopy);
              SaveIndex := SaveDC(DC);      // API,重画前,保存父控件的DC
              MoveWindowOrg(DC, Left, Top); // 调用2个API
              IntersectClipRect(DC, 0, 0, Width, Height); // API,新建一个完全的区域
              // 原本图形控件不能直接接受Windows消息的,现在通过VCL体系的变换也接受了。注意传递了父控件的DC
              Perform(WM_PAINT, DC, 0);     // 图形控件已经把WM_PAINT消息内容已经填好,就等程序员填写Paint函数加上真正要执行的内容。
              RestoreDC(DC, SaveIndex);     // API,恢复父控件的DC
              Exclude(FControlState, csPaintCopy); // 画完之后,去除标记
            end;
          Inc(I); // 下一个图形控件
        end;
      end;
    end;
    
    procedure TGraphicControl.WMPaint(var Message: TWMPaint);
    begin
      if Message.DC <> 0 then
      begin
        Canvas.Lock;
        try
          Canvas.Handle := Message.DC; // DC也是一个Handle。两者的类型都是HDC。important 借用了父类的DC
          try
            Paint; // 虚函数,直接调用自己的覆盖函数,不用管子控件,这一点与TCustomControl完全不一样。同时它也没有PaintWindow函数
          finally
            Canvas.Handle := 0; // super,画完了要清零,也许下次WM_Paint消息传来的DC不一致了
          end;
        finally
          Canvas.Unlock;
        end;
      end;
    end;
    
    procedure TCustomLabel.Paint;
    const
      Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
      WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
    var
      Rect, CalcRect: TRect;
      DrawStyle: Longint;
    begin
      with Canvas do
      begin
        if not Transparent then // 类属性
        begin
          Brush.Color := Self.Color;
          Brush.Style := bsSolid;
          FillRect(ClientRect); // TCanvas的类函数,TControl的类属性
        end;
        Brush.Style := bsClear;
        Rect := ClientRect; // TControl的类函数,正常情况下就是0,0,Width,Height
        { DoDrawText takes care of BiDi alignments }
        DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
        { Calculate vertical layout }
        // 如果是不是顶上的对齐方式,就要重新计算绘制区域
        if FLayout <> tlTop then
        begin
          CalcRect := Rect;
          DoDrawText(CalcRect, DrawStyle or DT_CALCRECT); // 增加一个风格,计算需要绘制的区域
          if FLayout = tlBottom then // 垂直居下
            OffsetRect(Rect, 0, Height - CalcRect.Bottom) // API
          else // 垂直居中
            OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
        end;
        // 根据重新计算过的区域绘制
        DoDrawText(Rect, DrawStyle); // super 问题:为什么画两遍?回答:1. 区域有可能被改变 2.此时的绘制风格不包含DT_CALCRECT
      end;
    end;
    
    procedure TCustomLabel.DoDrawText(var Rect: TRect; Flags: Longint);
    var
      Text: string;
    begin
      Text := GetLabelText; // 类函数,简单返回Caption字符串
      // 计算真正的文字长度(增加一格)
      if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and (Text[1] = '&') and (Text[2] = #0)) then
        Text := Text + ' ';
      // 没有前缀,则设置Windows标志位
      if not FShowAccelChar then Flags := Flags or DT_NOPREFIX;
      Flags := DrawTextBiDiModeFlags(Flags); // TControl的类函数,如有必要颠倒文字的方向标识符
      // 说到底,还是依靠Canvas的字体来绘制文字
      Canvas.Font := Font; // 将TLabel的Font属性赋值给TLabel内包含的Canvas的字体
      if not Enabled then
      begin
        OffsetRect(Rect, 1, 1); // API
        Canvas.Font.Color := clBtnHighlight; // 白亮色
        DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); // API
        OffsetRect(Rect, -1, -1); // API
        Canvas.Font.Color := clBtnShadow;    // 加阴影
        DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); // API
      end
      // 一般走这里
      else
        DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); // API,真正绘制文字!
    end;
    

    ---------------------------------------------------------------
    总结1:
    改变TLabel的属性特别简单,纯语言层面赋值即可。但是还要想办法把这个新值绘制到Window窗口上,不管这个窗口是真的Windows控件还是假的Windows控件。这个过程需要发两次消息,第一个消息WM_SETTEXT设置Windows窗口标题(此时TControl冒充了一个Windows句柄窗口,总之Delphi有办法达到这一点)第二个消息CM_TEXTCHANGED根据TLabel事先设置的属性(或者默认的属性)来重新计算文字宽度,上下对齐等等(这中间有些不重要的计算函数没有列出)。最后系统空闲时发现Windows窗口(Form1)有无效区域,于是发WM_PAINT给Form1(因为Label1不是一个实际具有句柄的Windows窗口,它的无效区域算在是Form1窗口上的,所以也代收了WM_Paint消息),才能把Form1.Label1.Caption重绘出效果。

    总结2:
    另外,绘制TLabel最关键的是TLabel.Paint;函数,可以发现API,即DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);使用的句柄是Canvas.Handle。而这个Canvas.Handle是TGraphicControl.WMPaint函数里,由消息传来的父函数的DC句柄,即 Canvas.Handle := Message.DC; 所有图形控件都不用操心这个问题,都由TGraphicControl一手包办了,真不是一般的方便啊。顺便想知道,1995年的时候,那些Borland的神人是怎么设计出这些框架的,是怎么会如此深刻理解OO的(包括它的不足),是怎么深刻理解Windows运行机制并合理安排和使用上千个API,并能做到游刃有余的?真的不可思议。

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

    不过我不明白的是,
    TCustomLabel.CMTextChanged函数里调用了Invalidate;和TControl.SetBounds调用了Invalidate;,这不是重复了吗?
    TControl.SetBounds里的InvalidateControl(Visible, False);和Invalidate;貌似也重复。
    TCustomLabel.AdjustBounds;里调用了DoDrawText和TCustomLabel.Paint;调用了DoDrawText,不是又重复了吗?

    还有一个疑问:
    procedure TCustomLabel.CMTextChanged(var Message: TMessage);
    begin
    Invalidate; // 调用TControl.Invalidate;使其图像失效
    AdjustBounds; // 类函数,看看有没有必要调整大小和边框
    end;
    一旦Invalidate;使得部分区域失效以后,会不会WM_Paint抢在AdjustBounds;函数之前工作啊?

  • 相关阅读:
    处理字符串拼接成想要的数组
    json 压缩中文不转码
    MySQL主从同步机制及同步中的问题处理
    mysql主从复制亲测,以及注意事项
    windows下mysql和linux下mysql主从配置
    拯救U盘之——轻松修复U盘“无法访问”的故障
    MUI框架开发HTML5手机APP(一)--搭建第一个手机APP
    UI之富文本编辑器-UEditor
    弹性布局详解——5个div让你学会弹性布局
    内置函数:min 用法
  • 原文地址:https://www.cnblogs.com/findumars/p/4120113.html
Copyright © 2011-2022 走看看