• 研究一下FBrush,它是从TWinControl才有的属性(可能是因为需要句柄)——发现{$R *.dfm}在运行期执行,而且很有深意,读到属性后赋值还会触发事件,这些无法在VCL代码里直接看到


    定义和创建:

    TWinControl = class(TControl)
    private
      FBrush: TBrush;
    end;
    
    constructor TWinControl.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
      FObjectInstance := Classes.MakeObjectInstance(MainWndProc);
      FBrush := TBrush.Create;
      FBrush.Color := FColor;
      FParentCtl3D := True;
      FTabOrder := -1;
    end;

    三处使用:

    procedure TWinControl.DefaultHandler(var Message);
    begin
      if FHandle <> 0 then
      begin
        with TMessage(Message) do
        begin
          if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
          begin
            Result := Parent.Perform(Msg, WParam, LParam);
            if Result <> 0 then Exit;
          end;
          case Msg of
            WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
              Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
            CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
              begin
                SetTextColor(WParam, ColorToRGB(FFont.Color));
                SetBkColor(WParam, ColorToRGB(FBrush.Color));
                Result := FBrush.Handle; // 使用完了,还要返回Brush的句柄。这是消息的Result,不是函数的
              end;
          else
            if Msg = RM_GetObjectInstance then
              Result := Integer(Self)
            else
            begin
              if Msg <> WM_PAINT then
              Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
            end;
          end;
          if Msg = WM_SETTEXT then
            SendDockNotification(Msg, WParam, LParam);
        end;
      end
      else
        inherited DefaultHandler(Message);
    end;
    
    procedure TWinControl.CMColorChanged(var Message: TMessage);
    begin
      inherited;
      FBrush.Color := FColor; // 改变刷子的颜色
      NotifyControls(CM_PARENTCOLORCHANGED);
    end;
    
    procedure TWinControl.WMNCPaint(var Message: TMessage);
    const
      InnerStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENINNER, BDR_RAISEDINNER, 0);
      OuterStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENOUTER, BDR_RAISEDOUTER, 0);
      EdgeStyles: array[TBevelKind] of Integer = (0, 0, BF_SOFT, BF_FLAT);
      Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0);
    var
      DC: HDC;
      RC, RW, SaveRW: TRect;
      EdgeSize: Integer;
      WinStyle: Longint;
    begin
      { Get window DC that is clipped to the non-client area }
      if (BevelKind <> bkNone) or (BorderWidth > 0) then
      begin
        DC := GetWindowDC(Handle);
        try
          Windows.GetClientRect(Handle, RC);
          GetWindowRect(Handle, RW);
          MapWindowPoints(0, Handle, RW, 2);
          OffsetRect(RC, -RW.Left, -RW.Top);
          ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
          { Draw borders in non-client area }
          SaveRW := RW;
          InflateRect(RC, BorderWidth, BorderWidth);
          RW := RC;
          if BevelKind <> bkNone then
          begin
            EdgeSize := 0;
            if BevelInner <> bvNone then Inc(EdgeSize, BevelWidth);
            if BevelOuter <> bvNone then Inc(EdgeSize, BevelWidth);
            with RW do
            begin
              WinStyle := GetWindowLong(Handle, GWL_STYLE);
              if beLeft in BevelEdges then Dec(Left, EdgeSize);
              if beTop in BevelEdges then Dec(Top, EdgeSize);
              if beRight in BevelEdges then Inc(Right, EdgeSize);
              if (WinStyle and WS_VSCROLL) <> 0 then Inc(Right, GetSystemMetrics(SM_CYVSCROLL));
              if beBottom in BevelEdges then Inc(Bottom, EdgeSize);
              if (WinStyle and WS_HSCROLL) <> 0 then Inc(Bottom, GetSystemMetrics(SM_CXHSCROLL));
            end;
            DrawEdge(DC, RW, InnerStyles[BevelInner] or OuterStyles[BevelOuter],
              Byte(BevelEdges) or EdgeStyles[BevelKind] or Ctl3DStyles[Ctl3D] or BF_ADJUST);
          end;
          IntersectClipRect(DC, RW.Left, RW.Top, RW.Right, RW.Bottom);
          RW := SaveRW;
          { Erase parts not drawn }
          OffsetRect(RW, -RW.Left, -RW.Top);
          Windows.FillRect(DC, RW, Brush.Handle); // 使用刷子绘制非客户区
        finally
          ReleaseDC(Handle, DC);
        end;
      end;
    
      inherited;
    
      if ThemeServices.ThemesEnabled and (csNeedsBorderPaint in ControlStyle) then
        ThemeServices.PaintBorder(Self, False);
    end;

    在TForm里也有应用:

    procedure TCustomForm.WMIconEraseBkgnd(var Message: TWMIconEraseBkgnd);
    begin
      if FormStyle = fsMDIChild then
      if (FormStyle = fsMDIChild) and not (csDesigning in ComponentState) then
        FillRect(Message.DC, ClientRect, Application.MainForm.Brush.Handle)
      else inherited;
    end;
    
    procedure TCustomForm.CMColorChanged(var Message: TMessage);
    begin
      inherited;
      if FCanvas <> nil then FCanvas.Brush.Color := Color;
    end;

    颜色改变之后,重设Brush的颜色是靠TWinControl.CMColorChanged。那么Brush第一次正确设置颜色是在何处(不是指创建TWinControl时的-16777201值)呢?经过研究,回答如下:

    应该是这样的:读取窗体是运行时,不是编译时

    你的窗体代码设置了color,那个是个属性,会触发属性的set方法

    你说的确实有道理。不过 {$R *.dfm}到底干了哪些事情啊?看来不是简单读数据,而且也会触发事件的
    关键是,运行期读取到数据以后,也要进行:=赋值的,此时就会触发Set方法,Set方法里发送CM_COLORCHANGED消息

    编译器只是简单加进exe,甚至dfm错了都发现不了
    经常会出现vcl版本不对,编译通过,但是dfm不对,运行出错

    次序就是这样: Create --> Load Properties --> SetColor --> CM_COLORCHANGED

    总结:基本明白了,确实在VCL里见不到直接的颜色赋值语句。那是因为在运行期执行{$R *.dfm}的时候,读取到新的颜色值以后,同样要要给Color属性赋值(即dfm里存储的颜色)。这样就会触发SetColor函数,从而触发CM_COLORCHANGED。整个过程被{$R *.dfm}隐藏了,在VCL里无法直接看到。但是需要注意,整个过程是在运行期完成的,不是在编译期。

  • 相关阅读:
    HttpWebRequest的GetResponse或GetRequestStream偶尔超时 + 总结各种超时死掉的可能和相应的解决办法
    如何制作一个没有任何窗体的,隐藏在后台的程序
    ActiveMQ持久化消息(转)
    ActiveMQ发布订阅模式(转)
    .Net平台下ActiveMQ入门实例(转)
    SQL重复记录查询的几种方法(转)
    XML 解析中,如何排除控制字符
    事件委托
    margin重叠
    office web apps 部署-搭建域控服务器
  • 原文地址:https://www.cnblogs.com/findumars/p/5218682.html
Copyright © 2020-2023  润新知