一行代码设置TLabel.Caption的前世今生

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

  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;

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;

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;

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;