zoukankan      html  css  js  c++  java
  • 一句话改变TWinControl控件的left坐标的前世今生(入口函数是SetBounds,然后调用SetWindowPos起作用,并发消息更新Delphi的left属性值)

    Delphi的重要属性,主要是Enable,  Visible, Color, left等等。这里分析left,因为TWinControl里有些覆盖函数的原因,虽然起点都是TControl.SetLeft()函数,但是图形控件和Win控件走的是不一样的路线。这里是测试TWinControl的left代码:

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      panel1.Left:=panel1.Left-10;
    end;

    由于left是TControl的公用属性,它的write属性是SetLeft,从这里开始追踪,这是跟踪分析代码:

    procedure TControl.SetLeft(Value: Integer);
    begin
      SetBounds(Value, FTop, FWidth, FHeight); // 虚函数,本类有覆盖函数
      Include(FScalingFlags, sfLeft);
    end;
    
    procedure TWinControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
    var
      WindowPlacement: TWindowPlacement; // Windows结构类型,包含最大化最小化窗口位置等6项内容
    begin
      // 覆盖函数
      if (ALeft <> FLeft) or (ATop <> FTop) or (AWidth <> FWidth) or (AHeight <> FHeight) then
      begin
        if HandleAllocated and not IsIconic(FHandle) then // API
          // 此函数会自动触发WM_WINDOWPOSCHANGING消息和WM_WINDOWPOSCHANGED消息,见MSDN
          SetWindowPos(FHandle, 0, ALeft, ATop, AWidth, AHeight, SWP_NOZORDER + SWP_NOACTIVATE) // API
        end;
        // super 手法:前面使用API设置了真实的Windows窗口属性和Delphi控件属性后,可放心大胆的调用一些函数,
        // 不是TControl已经提供了通用逻辑,就是它自己定义了一些特殊的函数,可随便使用,直接产生效果,而不再依赖别人来完成某件事情。
        UpdateAnchorRules; // TControl类函数,通用函数
        RequestAlign; // TControl类函数,通用函数
      end;
    end;

    碰到SetWindowPos函数时,执行前,系统向对应句柄的窗口分别发送WM_WINDOWPOSCHANGING消息,事后发送WM_WINDOWPOSCHANGED,可以要充分利用这两个消息达到目的。首先执行WM_WINDOWPOSCHANGING消息函数:

    procedure TWinControl.WMWindowPosChanging(var Message: TWMWindowPosChanging);
    begin
      // important 在API改变窗口大小之前,通过这个消息给予程序员准确控制的机会
      // TControl没有这个函数
      // 所有Win控件都可使用这段代码,只有Form覆盖了这个函数(也仅仅是三明治手法)
      // wParam用不上,lParam传递结构
      if ComponentState * [csReading, csDestroying] = [] then
        with Message.WindowPos^ do // 消息内含的指针,包含7项内容
          if (flags and SWP_NOSIZE = 0) // 如果没有SWP_NOSIZE选项。SWP_NOSIZE = 保持当前大小,忽略cx cy
          and not CheckNewSize(cx, cy)  // 类函数,检测并给予程序员一系列的机会与原来的属性值一起控制cx和cy的机会。但也有可能不允许改变cx和cy
          then
            flags := flags or SWP_NOSIZE; // 如果不允许改变窗口大小,就加上标志位
      // 再多给一次机会
      inherited; // fixme 好像没用 
    end;

    然后真正执行SetWindowPos API函数,真正调整了窗口的位置。最后再执行WM_WINDOWCHANGED消息函数:

    procedure TWinControl.WMWindowPosChanged(var Message: TWMWindowPosChanged);
    var
      Framed, Moved, Sized: Boolean;
    begin
      // 三明治手法,这里使边框失效
      // 判断是否有边框,是否移动了,是否改变了尺寸
      Framed := FCtl3D and (csFramed in ControlStyle) and (Parent <> nil) and (Message.WindowPos^.flags and SWP_NOREDRAW = 0);
      Moved := (Message.WindowPos^.flags and SWP_NOMOVE = 0) and IsWindowVisible(FHandle); // API
      Sized := (Message.WindowPos^.flags and SWP_NOSIZE = 0) and IsWindowVisible(FHandle);
      // 如果有边框,并且已经移动或者改变了尺寸,那么使边框无效
      if Framed and (Moved or Sized) then InvalidateFrame;  // 类函数 fixme 这不是重复了吗?
      // 仅仅调整边框不够,更主要是调整控件自己的位置
      if not (csDestroyingHandle in ControlState) then UpdateBounds; // 类函数,使用API调整控件在屏幕上的位置
    
      inherited; // super 三明治手法,调用程序员潜在的消息函数,并重新计算最大化最小化的限制和坞里的尺寸
    
      // fixme 根据消息的内容,再次使边框无效(如果有显示或隐藏标记的话)
      if Framed and ((Moved or Sized) or (Message.WindowPos^.flags and (SWP_SHOWWINDOW or SWP_HIDEWINDOW) <> 0)) then
        InvalidateFrame; // 类函数,简单调用API
    end;

    特别注意,TControl没有WM_WINDOWPOSCHANGING的消息函数,所以它是通过WM_WINDOWPOSCHANGED消息函数来移动eft坐标的。这里为了加强印象,不妨对比一下:

    procedure TControl.WMWindowPosChanged(var Message: TWMWindowPosChanged);
    begin
      // 先执行潜在的程序员消息函数
      // super 这里其实不会是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;

    可以发现,TWinControl使用了三明治手法,增加了对边框的处理。

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

    VCL根据以上功能,提供了OnSize事件。但是各自控件是否发布这个事件,就要看它自己了。事实上,只有少数几个控件,比如TPanel,TScrollBox,TCustomForm,TControlBar一共4个类发布了这个事件。

        FOnResize: TNotifyEvent;
        property OnResize: TNotifyEvent read FOnResize write FOnResize;
    
    procedure TControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
    begin
      // 虚函数,TWinControl有覆盖函数 
      if CheckNewSize(AWidth, AHeight) and // TControl的类函数,重新计算长宽
        ((ALeft <> FLeft) or (ATop <> FTop) or (AWidth <> FWidth) or (AHeight <> FHeight)) then // 有一个不等就要重新计算和排列
      begin
        InvalidateControl(Visible, False); // TControl的类函数,非虚函数,第二个参数表示暂时设置当前控件是透明的。fixme 好像重复了,且也不明白什么意思
        FLeft := ALeft;
        FTop := ATop;
        FWidth := AWidth;
        FHeight := AHeight;
        UpdateAnchorRules; // TControl的类函数,坐标和长宽设置完了,就要重新铆接一下
        Invalidate; // TControl的类函数,调用TControl.InvalidateControl,再调用API声明无效区域
    
        Perform(WM_WINDOWPOSCHANGED, 0, 0); // 就这一处使用。它比WM_SIZE和WM_MOVE更高效。
        RequestAlign; // TControl的虚函数,各WinControl的子类可自己改写,比如TCustomForm就改写了,但Win控件没有改写
        if not (csLoading in ComponentState) then Resize; // 这里调用!TControl的虚函数,简单调用程序员事件。子类一般不需要改写它。
      end;
    end;
    
    procedure TWinControl.WMSize(var Message: TWMSize);
    begin
      UpdateBounds; // 类函数
      inherited;
      Realign; // 类函数
      if not (csLoading in ComponentState) then Resize;
    end;
    
    procedure TControl.Resize;
    begin
      if Assigned(FOnResize) then FOnResize(Self);
    end;

    FOnCanResize: TCanResizeEvent; 和 FOnConstrainedResize: TConstrainedResizeEvent; 这两个事件也是类似。

  • 相关阅读:
    chrome developer tool—— 断点调试篇
    VUE路由传参
    CentOS-yum安装Docker环境(含:常用命令)
    CentOS-yum安装chrome+chromeDriver+xvfb
    CentOS-Docker搭建MinIO(单点)
    CentOS-Docker搭建Nextcloud
    CentOS-Docker搭建Nacos-v1.1.4(单点)
    CentOS-Docker搭建Kafka(单点,含:zookeeper、kafka-manager)
    CentOS-yum安装Nginx
    CentOS-磁盘扩容挂载目录
  • 原文地址:https://www.cnblogs.com/findumars/p/4761155.html
Copyright © 2011-2022 走看看