zoukankan      html  css  js  c++  java
  • TForm的显示过程

    新建一个空窗体项目,然后运行,此时首先运行:

    procedure TApplication.Run;
    begin
      FRunning := True;
      try
        AddExitProc(DoneApplication);
        if FMainForm <> nil then
        begin
          case CmdShow of
            SW_SHOWMINNOACTIVE: FMainForm.FWindowState := wsMinimized;
            SW_SHOWMAXIMIZED: MainForm.WindowState := wsMaximized;
          end;
          if FShowMainForm then
            if FMainForm.FWindowState = wsMinimized then
              Minimize else
              FMainForm.Visible := True;
          repeat
            try
              HandleMessage;
            except
              HandleException(Self);
            end;
          until Terminated;
        end;
      finally
        FRunning := False;
      end;
    end;
    

    调用 MainForm.WindowState := wsMaximized;
    其中 类属性WindowState调用SetWindowState
    调用 FMainForm.Visible := True;
    其中 类属性Visible调用SetVisible虚函数,间接调用TControl.SetVisible(相当于UpdateWindow API)

    第一个步骤:

    procedure TCustomForm.SetWindowState(Value: TWindowState);
    const
      ShowCommands: array[TWindowState] of Integer = (SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED);
    begin
      if FWindowState <> Value then
      begin
        FWindowState := Value;
        if not (csDesigning in ComponentState) and Showing then
          ShowWindow(Handle, ShowCommands[Value]);
      end;
    end;

    第二个步骤::

    procedure TCustomForm.SetVisible(Value: Boolean);
    begin
      if fsCreating in FFormState then
        if Value then
          Include(FFormState, fsVisible) else
          Exclude(FFormState, fsVisible)
      else
      begin
        if Value and (Visible <> Value) then SetWindowToMonitor;
        inherited Visible := Value;
      end;
    end;
    
    procedure TControl.SetVisible(Value: Boolean);
    begin
      if FVisible <> Value then
      begin
        VisibleChanging;
        FVisible := Value;
        Perform(CM_VISIBLECHANGED, Ord(Value), 0);
        RequestAlign;
      end;
    end;
    

     然后故事就长了:

    procedure TWinControl.CMVisibleChanged(var Message: TMessage);
    begin
      if not FVisible and (Parent <> nil) then RemoveFocus(False);
      if not (csDesigning in ComponentState) or
        (csNoDesignVisible in ControlStyle) then UpdateControlState;
    end;
    
    procedure TWinControl.UpdateControlState;
    var
      Control: TWinControl;
    begin
      Control := Self;
      while Control.Parent <> nil do
      begin
        Control := Control.Parent;
        if not Control.Showing then Exit;
      end;
      if (Control is TCustomForm) or (Control.FParentWindow <> 0) then UpdateShowing;
    end;
    
    procedure TWinControl.UpdateShowing;
    var
      ShowControl: Boolean;
      I: Integer;
    begin
      ShowControl := (FVisible or (csDesigning in ComponentState) and
        not (csNoDesignVisible in ControlStyle)) and
        not (csReadingState in ControlState);
      if ShowControl then
      begin
        if FHandle = 0 then CreateHandle;
        if FWinControls <> nil then
          for I := 0 to FWinControls.Count - 1 do
            TWinControl(FWinControls[I]).UpdateShowing;
      end;
      if FHandle <> 0 then
        if FShowing <> ShowControl then
        begin
          FShowing := ShowControl;
          try
            Perform(CM_SHOWINGCHANGED, 0, 0);
          except
            FShowing := not ShowControl;
            raise;
          end;
        end;
    end;
    
    procedure TWinControl.CMShowingChanged(var Message: TMessage);
    const
      ShowFlags: array[Boolean] of Word = (
        SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_HIDEWINDOW,
        SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_SHOWWINDOW);
    begin
      SetWindowPos(FHandle, 0, 0, 0, 0, 0, ShowFlags[FShowing]);
    end;
    

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

    第三步,调用了ShowWindow API和SetWindowPos API以后(不知道这两个API那个更重要),当系统空闲时(因为没发现调用UpdateWindow API),Windows先擦除Form1的背景,后向Form1发WM_PAINT消息,由TCustomForm接收:

    procedure TWinControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
    begin
      with ThemeServices do
      if ThemesEnabled and Assigned(Parent) and (csParentBackground in FControlStyle) then
        begin
          { Get the parent to draw its background into the control's background. }
          DrawParentBackground(Handle, Message.DC, nil, False);
        end
        else
        begin
          { Only erase background if we're not doublebuffering or painting to memory. }
          if not FDoubleBuffered or
             (TMessage(Message).wParam = TMessage(Message).lParam) then
            FillRect(Message.DC, ClientRect, FBrush.Handle);
        end;
    
      Message.Result := 1;
    end;
    

    擦除背景绝对重要,只有擦除了背景,才能在上面作画,否则作画全部无效:

    procedure TCustomForm.WMPaint(var Message: TWMPaint);
    var
      DC: HDC;
      PS: TPaintStruct;
    begin
      if not IsIconic(Handle) then
      begin
        ControlState := ControlState + [csCustomPaint];
        inherited;
        ControlState := ControlState - [csCustomPaint];
      end
      else
      begin
        DC := BeginPaint(Handle, PS);
        DrawIcon(DC, 0, 0, GetIconHandle);
        EndPaint(Handle, PS);
      end;
    end;

    在TWinControl.WMPaint函数里下调试点:

    procedure TWinControl.WMPaint(var Message: TWMPaint);
    var
      DC, MemDC: HDC;
      MemBitmap, OldBitmap: HBITMAP;
      PS: TPaintStruct;
    begin
      if not FDoubleBuffered or (Message.DC <> 0) then
      begin
        if not (csCustomPaint in ControlState) and (ControlCount = 0) then
          inherited
        else
          PaintHandler(Message);
      end
      else
      begin
        DC := GetDC(0);
        MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
        ReleaseDC(0, DC);
        MemDC := CreateCompatibleDC(0);
        OldBitmap := SelectObject(MemDC, MemBitmap);
        try
          DC := BeginPaint(Handle, PS);
          Perform(WM_ERASEBKGND, MemDC, MemDC);
          Message.DC := MemDC;
          WMPaint(Message);
          Message.DC := 0;
          BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
          EndPaint(Handle, PS);
        finally
          SelectObject(MemDC, OldBitmap);
          DeleteDC(MemDC);
          DeleteObject(MemBitmap);
        end;
      end;
    end;
    

    很明显执行的是 not FDoubleBuffered逻辑,说明TForm的双缓冲默认是关闭的。然后执行PaintHandler

    procedure TWinControl.PaintHandler(var Message: TWMPaint);
    var
      I, Clip, SaveIndex: Integer;
      DC: HDC;
      PS: TPaintStruct;
    begin
      DC := Message.DC;
      if DC = 0 then DC := BeginPaint(Handle, PS);
      try
        if FControls = nil then PaintWindow(DC) else
        begin
          SaveIndex := SaveDC(DC);
          Clip := SimpleRegion;
          for I := 0 to FControls.Count - 1 do
            with TControl(FControls[I]) do
              if (Visible or (csDesigning in ComponentState) and
                not (csNoDesignVisible in ControlStyle)) and
                (csOpaque in ControlStyle) then
              begin
                Clip := ExcludeClipRect(DC, Left, Top, Left + Width, Top + Height);
                if Clip = NullRegion then Break;
              end;
          if Clip <> NullRegion then PaintWindow(DC);
          RestoreDC(DC, SaveIndex);
        end;
        PaintControls(DC, nil);
      finally
        if Message.DC = 0 then EndPaint(Handle, PS);
      end;
    end;
    

    因为是空窗体,所以执行PaintWindow(如有子控件执行PaintControls),即:

    procedure TCustomForm.PaintWindow(DC: HDC);
    begin
      FCanvas.Lock;
      try
        FCanvas.Handle := DC;
        try
          if FDesigner <> nil then FDesigner.PaintGrid else Paint;
        finally
          FCanvas.Handle := 0;
        end;
      finally
        FCanvas.Unlock;
      end;
    end;
    

    最后执行Paint

    procedure TCustomForm.Paint;
    begin
      if Assigned(FOnPaint) then FOnPaint(Self);
    end;
    

    然后就通过FOnPaint自动调用了程序员定义的事件。

    总结:TForm和TCustomControl有点差不多,都各自包含了一个Canvas,属于自绘控件,至于它们的显示函数的区别如下:
    WMPaint函数一样加上了csCustomPaint风格,只是TForm在窗口最小化的情况下是绘制图标 (入口函数,毕竟Windows直接把消息发给这个函数)
    PaintWindow函数完全一样(除了TForm在设计期间要显示格子)。
    Paint函数略有点不一样,在TCustomControl里完全空函数,反正它就是抽象类,等着被继承和覆盖;在TForm里有内容,即直接调用程序员函数

    我的另一篇文章,注释比较详细,可一并参考:一行代码设置TForm颜色的前世今生
    http://www.cnblogs.com/findumars/p/4117783.html

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

    其中有意思的一个小技巧是调用父类属性:
    TCustomForm.SetVisible(Value: Boolean);函数里,调用父类的属性居然可以这样调用:
    inherited Visible := Value;
    如果不写inherited,就变成调用本类的属性了,就会调用不同的Set函数,这样效果就完全不一样了。

  • 相关阅读:
    多尺度双边滤波及基于小波变换的非线性扩散
    yum安装CentOS7+nginx+php7.3+mysql5.7
    python学习之特殊魔法__getattr__,__getattribute__
    python学习之特殊魔法__get__,__set__,__delete__
    python学习之装饰器
    python学习之私有属性
    python学习之包装与授权
    python学习之生成器(generator)
    python学习之运用特殊方法,定制类
    python学习之创建迭代器对象
  • 原文地址:https://www.cnblogs.com/findumars/p/4129237.html
Copyright © 2011-2022 走看看