一句话改变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; 这两个事件也是类似。

posted @ 2015-08-26 17:32  findumars  Views(678)  Comments(0Edit  收藏  举报