首页 > 代码库 > 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的自绘过程
声明:以上内容来自用户投稿及互联网公开渠道收集整理发布,本网站不拥有所有权,未作人工编辑处理,也不承担相关法律责任,若内容有误或涉及侵权可进行投诉: 投诉/举报 工作人员会在5个工作日内联系你,一经查实,本站将立刻删除涉嫌侵权内容。