新建一个空窗体项目,然后运行,此时首先运行:
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;
时间: 2024-10-31 04:32:00