35、TApplication创建的主窗体
|
Application.CreateForm(TForm1, Form1); procedure TApplication.CreateForm(InstanceClass: TComponentClass; var Reference); var Instance: TComponent; begin Instance := TComponent(InstanceClass.NewInstance); TComponent(Reference) := Instance; try Instance.Create(Self); except TComponent(Reference) := nil; raise; end; if (FMainForm = nil) and (Instance is TForm) then begin TForm(Instance).HandleNeeded; FMainForm := TForm(Instance); end; end;
constructor TWinControl.Create(AOwner: TComponent); begin inherited Create(AOwner); {$IFDEF LINUX} FObjectInstance := WinUtils.MakeObjectInstance(MainWndProc); {$ENDIF} {$IFDEF MSWINDOWS} FObjectInstance := Classes.MakeObjectInstance(MainWndProc); //设置回调函数 {$ENDIF} FBrush := TBrush.Create; FBrush.Color := FColor; FParentCtl3D := True; FTabOrder := -1; FImeMode := imDontCare; if SysLocale.PriLangID = LANG_JAPANESE then FImeName := '' else FImeName := Screen.DefaultIme; FUseDockManager := False; FBevelEdges := [beLeft, beTop, beRight, beBottom]; FBevelInner := bvRaised; FBevelOuter := bvLowered; FBevelWidth := 1; FHelpType := htContext; end;
constructor TControl.Create(AOwner: TComponent); begin inherited Create(AOwner); FWindowProc := WndProc; … end;
TControl = class(TComponent) private FParent: TWinControl; FWindowProc: TWndMethod; … end;
procedure TWinControl.MainWndProc(var Message: TMessage); begin try try WindowProc(Message); finally FreeDeviceContexts; FreeMemoryContexts; end; except Application.HandleException(Self); end; end;
申明： procedure MainWndProc(var Message: TMessage); 不希望程序员覆盖，但是可以覆盖WindowProc方法。 TWinCtrol=class(TControl) … procedure WndProc(var Message: TMessage); override; … end; TForm(Instance).HandleNeeded; 其实调用的是TWinControl.HandleNeeded; procedure TWinControl.HandleNeeded; begin if FHandle = 0 then begin if Parent <> nil then Parent.HandleNeeded; CreateHandle; end; end;
procedure TWinControl.CreateHandle; var I: Integer; begin if FHandle = 0 then begin CreateWnd; SetProp(FHandle, MakeIntAtom(ControlAtom), THandle(Self)); SetProp(FHandle, MakeIntAtom(WindowAtom), THandle(Self)); if Parent <> nil then SetWindowPos(FHandle, Parent.PrecedingWindow(Self), 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE); for I := 0 to ControlCount - 1 do Controls[I].UpdateAnchorRules; end; end; procedure TCustomForm.CreateWnd; var ClientCreateStruct: TClientCreateStruct; begin inherited CreateWnd; if NewStyleControls then if BorderStyle <> bsDialog then SendMessage(Handle, WM_SETICON, 1, GetIconHandle) else SendMessage(Handle, WM_SETICON, 1, 0); if not (csDesigning in ComponentState) then case FormStyle of fsMDIForm: begin with ClientCreateStruct do begin idFirstChild := $FF00; hWindowMenu := 0; if FWindowMenu <> nil then hWindowMenu := FWindowMenu.Handle; end; FClientHandle := Windows.CreateWindowEx(WS_EX_CLIENTEDGE, 'MDICLIENT', nil, WS_CHILD or WS_VISIBLE or WS_GROUP or WS_TABSTOP or WS_CLIPCHILDREN or WS_HSCROLL or WS_VSCROLL or WS_CLIPSIBLINGS or MDIS_ALLCHILDSTYLES, 0, 0, ClientWidth, ClientHeight, Handle, 0, HInstance, @ClientCreateStruct); {$IFDEF LINUX} FClientInstance := WinUtils.MakeObjectInstance(ClientWndProc); {$ENDIF} {$IFDEF MSWINDOWS} FClientInstance := Classes.MakeObjectInstance(ClientWndProc);//设置回调函数 {$ENDIF} FDefClientProc := Pointer(GetWindowLong(FClientHandle, GWL_WNDPROC)); SetWindowLong(FClientHandle, GWL_WNDPROC, Longint(FClientInstance)); end; fsStayOnTop: SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); end; end;
TWincontrol=class(TControl) … procedure CreateWnd; virtual; … end;
procedure TWinControl.CreateWnd; var Params: TCreateParams; TempClass: TWndClass; ClassRegistered: Boolean; begin CreateParams(Params);//设定窗口注册属性，虚拟方法 with Params do begin if (WndParent = 0) and (Style and WS_CHILD <> 0) then if (Owner <> nil) and (csReading in Owner.ComponentState) and (Owner is TWinControl) then WndParent := TWinControl(Owner).Handle else raise EInvalidOperation.CreateFmt(SParentRequired, [Name]); FDefWndProc := WindowClass.lpfnWndProc; ClassRegistered := GetClassInfo(WindowClass.hInstance, WinClassName, TempClass); if not ClassRegistered or (TempClass.lpfnWndProc <> @InitWndProc) then begin if ClassRegistered then Windows.UnregisterClass(WinClassName, WindowClass.hInstance); WindowClass.lpfnWndProc := @InitWndProc; WindowClass.lpszClassName := WinClassName; if Windows.RegisterClass(WindowClass) = 0 then RaiseLastOSError; end; CreationControl := Self; CreateWindowHandle(Params); if FHandle = 0 then RaiseLastOSError; if (GetWindowLong(FHandle, GWL_STYLE) and WS_CHILD <> 0) and (GetWindowLong(FHandle, GWL_ID) = 0) then SetWindowLong(FHandle, GWL_ID, FHandle); end; StrDispose(FText); FText := nil; UpdateBounds; Perform(WM_SETFONT, FFont.Handle, 1); if AutoSize then AdjustSize; end;
procedure TWinControl.CreateWindowHandle(const Params: TCreateParams); begin with Params do FHandle := CreateWindowEx(ExStyle, WinClassName, Caption, Style, X, Y, Width, Height, WndParent, 0, WindowClass.hInstance, Param); end;
TWinControl = class(TControl) … procedure CreateParams(var Params: TCreateParams); virtual; |