首页 > 代码库 > TForm的自绘过程

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向TForm1发WM_PAINT消息,由TCustomForm接收:

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;

 

TForm的自绘过程