{%MainUnit ../forms.pp} {****************************************************************************** TCustomForm ****************************************************************************** ***************************************************************************** * * * This file is part of the Lazarus Component Library (LCL) * * * * See the file COPYING.modifiedLGPL, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** } { $DEFINE CHECK_POSITION} { TCustomForm } {------------------------------------------------------------------------------ TCustomForm ClientWndProc ------------------------------------------------------------------------------} Procedure TCustomForm.ClientWndProc(var Message: TLMessage); procedure CallDefault; begin { with Message do Result := CallWindowProc(FDefClientProc, ClientHandle, Msg, wParam, lParam); } end; begin with Message do case Msg of LM_NCHITTEST: begin CallDefault; if Result = HTCLIENT then Result := HTTRANSPARENT; end; LM_ERASEBKGND: begin // Not sure if this will work real good. //Canvas.FillRect(ClientRect); Result := 1; end; else CallDefault; end; end; {------------------------------------------------------------------------------ procedure TCustomForm.CloseModal; ------------------------------------------------------------------------------} procedure TCustomForm.CloseModal; var CloseAction: TCloseAction; begin try CloseAction := caNone; if CloseQuery then begin CloseAction := caHide; DoClose(CloseAction); end; case CloseAction of caNone: ModalResult := 0; caFree: Release; end; if CloseAction <> caNone then TWSCustomFormClass(WidgetSetClass).CloseModal(Self); except ModalResult := 0; Application.HandleException(Self); end; end; {------------------------------------------------------------------------------ Method: TCustomForm.BeforeDestruction Params: None Returns: Nothing Gets called before the destruction of the object ------------------------------------------------------------------------------} procedure TCustomForm.BeforeDestruction; begin GlobalNameSpace.BeginWrite; Destroying; Screen.FSaveFocusedList.Remove(Self); RemoveFixupReferences(Self, ''); //if FOleForm <> nil then FOleForm.OnDestroy; if FormStyle <> fsMDIChild then Hide; DoDestroy; inherited BeforeDestruction; end; {------------------------------------------------------------------------------ Method: TCustomForm.Destroy Params: None Returns: Nothing Destructor for the class. ------------------------------------------------------------------------------} destructor TCustomForm.Destroy; var HandlerType: TFormHandlerType; begin //DebugLn('[TCustomForm.Destroy] A ',Name,':',ClassName); if not (csDestroying in ComponentState) then GlobalNameSpace.BeginWrite; try FreeThenNil(FMenu); FreeThenNil(FIcon); Screen.RemoveForm(Self); FreeThenNil(FActionLists); for HandlerType:=Low(FFormHandlers) to High(FFormHandlers) do FreeThenNil(FFormHandlers[HandlerType]); //DebugLn('[TCustomForm.Destroy] B ',Name,':',ClassName); inherited Destroy; //DebugLn('[TCustomForm.Destroy] END ',Name,':',ClassName); finally GlobalNameSpace.EndWrite; end; end; {------------------------------------------------------------------------------ Method: TCustomForm.FocusControl Params: None Returns: Nothing ------------------------------------------------------------------------------} Procedure TCustomForm.FocusControl(WinControl : TWinControl); var WasActive: Boolean; begin WasActive := FActive; SetActiveControl(WinControl); if not WasActive then SetFocus; End; {------------------------------------------------------------------------------ Method: TCustomForm.Notification ------------------------------------------------------------------------------} Procedure TCustomForm.Notification(AComponent: TComponent; Operation: TOperation); Begin inherited Notification(AComponent,Operation); case Operation of opInsert: begin if AComponent is TCustomActionList then begin if FActionLists=nil then FActionLists:=TList.Create; FActionLists.Add(AComponent); end else if not (csLoading in ComponentState) and (Menu = nil) and (AComponent.Owner=Self) and (AComponent is TMainMenu) then Menu:=TMainMenu(AComponent); end; opRemove: begin if (FActionLists<>nil) and (AComponent is TCustomActionList) then FActionLists.Remove(AComponent) else begin if Menu = AComponent then Menu := nil; //if WindowMenu = AComponent then WindowMenu := nil; //if ObjectMenuItem = AComponent then ObjectMenuItem := nil; end; if FActiveControl=AComponent then begin {$IFDEF VerboseFocus} debugln('TCustomForm.Notification opRemove FActiveControl=',DbgSName(AComponent)); {$ENDIF} FActiveControl:=nil; end; if AComponent=FDefaultControl then FDefaultControl:=nil; if AComponent=FCancelControl then FCancelControl:=nil; end; end; if FDesigner<>nil then FDesigner.Notification(AComponent,Operation); End; {------------------------------------------------------------------------------ Method: TCustomForm.IconChanged ------------------------------------------------------------------------------} procedure TCustomForm.IconChanged(Sender: TObject); begin if HandleAllocated then TWSCustomFormClass(WidgetSetClass).SetIcon(Self, GetIconHandle); end; {------------------------------------------------------------------------------ function TCustomForm.IsKeyPreviewStored: boolean; ------------------------------------------------------------------------------} function TCustomForm.IsKeyPreviewStored: boolean; begin Result:=FKeyPreview=true; end; procedure TCustomForm.SetCancelControl(NewControl: TControl); var OldCancelControl: TControl; begin if NewControl <> FCancelControl then begin OldCancelControl:=FCancelControl; FCancelControl := NewControl; // notify old control if OldCancelControl<>nil then OldCancelControl.UpdateRolesForForm; // notify new control if FCancelControl<>nil then FCancelControl.UpdateRolesForForm; end; end; procedure TCustomForm.SetDefaultControl(NewControl: TControl); var OldDefaultControl: TControl; begin if NewControl <> FDefaultControl then begin OldDefaultControl:=FDefaultControl; FDefaultControl := NewControl; // notify old control if OldDefaultControl<>nil then OldDefaultControl.UpdateRolesForForm; // notify new control if FDefaultControl<>nil then FDefaultControl.UpdateRolesForForm; // maybe active default control changed if FActiveDefaultControl = nil then begin if OldDefaultControl <> nil then OldDefaultControl.ActiveDefaultControlChanged(nil); if FDefaultControl <> nil then FDefaultControl.ActiveDefaultControlChanged(nil); end; end; end; {------------------------------------------------------------------------------ Method: TCustomForm.SetIcon Params: the new icon ------------------------------------------------------------------------------} procedure TCustomForm.SetIcon(AValue: TIcon); begin if FIcon=nil then begin FIcon:=TIcon.Create; FIcon.OnChange := @IconChanged; end; FIcon.Assign(AValue); end; {------------------------------------------------------------------------------ procedure TCustomForm.SetModalResult(const AValue: TModalResult); ------------------------------------------------------------------------------} procedure TCustomForm.SetModalResult(const AValue: TModalResult); begin if FModalResult=AValue then exit; FModalResult:=AValue; end; {------------------------------------------------------------------------------ Method: TCustomForm.IsIconStored Returns: if form icon should be stored in the stream ------------------------------------------------------------------------------} function TCustomForm.IsIconStored: Boolean; begin Result := IsForm and (Icon<>nil); end; {------------------------------------------------------------------------------ Method: TCustomForm.GetIconHandle Returns: handle of form icon ------------------------------------------------------------------------------} function TCustomForm.GetIconHandle: HICON; begin //DebugLn('[TCustomForm.GetIconHandle] ',ClassName,' ',FIcon<>nil); if (FIcon<>nil) and (not Icon.Empty) then Result := FIcon.Handle else Result := Application.GetIconHandle; end; {------------------------------------------------------------------------------ Method: TCustomForm.SetFocus ------------------------------------------------------------------------------} Procedure TCustomForm.SetFocus; procedure RaiseCannotFocus; var s: String; begin s:='[TCustomForm.SetFocus] '+Name+':'+ClassName+' '+rsCanNotFocus; {$IFDEF VerboseFocus} RaiseGDBException(s); {$ELSE} raise EInvalidOperation.Create(s); {$ENDIF} end; Begin {$IFDEF VerboseFocus} DebugLn('TCustomForm.SetFocus ',Name,':',ClassName); {$ENDIF} if not FActive then begin if not (IsControlVisible and Enabled) then RaiseCannotFocus; SetWindowFocus; end; end; {------------------------------------------------------------------------------ TCustomForm SetVisible ------------------------------------------------------------------------------} Procedure TCustomForm.SetVisible(Value : boolean); Begin if (Value=(fsVisible in FFormState)) and (Visible=Value) then exit; //DebugLn('[TCustomForm.SetVisible] START ',Name,':',ClassName,' Old=',Visible,' New=',Value,' ',(fsCreating in FFormState),' ',FormUpdating); if Value then Include(FFormState, fsVisible) else Exclude(FFormState, fsVisible); //DebugLn('TCustomForm.SetVisible ',Name,':',ClassName,' FormUpdating=',FormUpdating,' fsCreating=',fsCreating in FFormState); if (fsCreating in FFormState) {or FormUpdating} then // will be done when finished loading else begin inherited Visible:=Value; end; //DebugLn('[TCustomForm.SetVisible] END ',Name,':',ClassName,' ',Value,' ',(fsCreating in FFormState),' ',FormUpdating,' ',Visible); end; {------------------------------------------------------------------------------ procedure TCustomForm.SetWindowFocus; ------------------------------------------------------------------------------} procedure TCustomForm.SetWindowFocus; var NewFocusControl: TWinControl; begin if [csLoading,csDestroying]*ComponentState<>[] then exit; if (FActiveControl <> nil) and (FDesigner = nil) then NewFocusControl := FActiveControl else NewFocusControl := Self; {$IFDEF VerboseFocus} DebugLn('TCustomForm.SetWindowFocus ',Name,':',Classname , ' NewFocusControl=',NewFocusControl.Name,':',NewFocusControl.ClassName, ' HndAlloc=',dbgs(NewFocusControl.HandleAllocated)); {$ENDIF} if (not NewFocusControl.HandleAllocated) or (not NewFocusControl.Visible) or (not NewFocusControl.Enabled) then exit; LCLIntf.SetFocus(NewFocusControl.Handle); if GetFocus = NewFocusControl.Handle then NewFocusControl.Perform(CM_UIACTIVATE, 0, 0); end; {------------------------------------------------------------------------------ Method: TCustomForm.WMShowWindow Params: Msg: The showwindow message Returns: nothing ShowWindow event handler. ------------------------------------------------------------------------------} procedure TCustomForm.WMShowWindow(var message: TLMShowWindow); function FindFirstControl: TWinControl; var List: TFPList; I: Integer; begin List := TFPList.Create; Result := nil; try GetTabOrderList(List); for I := 0 to List.Count - 1 do begin if TObject(List.Items[0]) is TWinControl then begin Result := TWinControl(List.Items[0]); exit; end; end; finally List.Free; end; end; begin {$IFDEF VerboseFocus} DbgOut('TCustomForm.WMShowWindow A ',Name,':'+ClassName+' fsShowing='+dbgs(fsShowing in FFormState)+' Msg.Show='+dbgs(Message.Show)); if FActiveControl<>nil then begin DbgOut(' FActiveControl=',FActiveControl.Name,':',FActiveControl.ClassName,' HandleAllocated=',dbgs(FActiveControl.HandleAllocated)); end else begin DbgOut(' FActiveControl=nil'); end; DebugLn(''); {$ENDIF} if (fsShowing in FFormState) then exit; Include(FFormState, fsShowing); try // only fire event if reason is not some other window hide/showing etc. if Message.Status = 0 then begin if Message.Show then begin if FActiveControl = nil then begin FActiveControl := FindFirstControl; {$IFDEF VerboseFocus} DebugLn('TCustomForm.WMShowWindow Set FActiveControl := FindFirstControl = ',DbgSName(FActiveControl)); {$ENDIF} end; if ([csLoading,csDestroying]*ComponentState=[]) and (FActiveControl<>nil) and FActiveControl.HandleAllocated and FActiveControl.Visible and FActiveControl.Enabled then begin {$IFDEF VerboseFocus} DebugLn('TCustomForm.WMShowWindow SetFocus ',DbgSName(FActiveControl)); {$ENDIF} LCLIntf.SetFocus(FActiveControl.Handle); end; DoShow; end else begin DoHide; end; end; finally Exclude(FFormState, fsShowing); end; end; {------------------------------------------------------------------------------ Method: TCustomForm.WMActivate Params: Msg: When the form is Activated Returns: nothing Activate event handler. ------------------------------------------------------------------------------} procedure TCustomForm.WMActivate(var Message : TLMActivate); begin {$IFDEF VerboseFocus} DebugLn('TCustomForm.WMActivate A ',Name,':',ClassName,' Msg.Active=',dbgs(Message.Active)); {$ENDIF} if (FormStyle <> fsMDIForm) or (csDesigning in ComponentState) then SetActive(Message.Active {<> WA_INACTIVE}); FActive:=true; Activate; if Application<>nil then Application.Activate; end; {------------------------------------------------------------------------------ Method: TCustomForm.WMDeactivate Params: Msg: When the form is deactivated (loses focus within application) Returns: nothing Form deactivation (losing focus within application) event handler. ------------------------------------------------------------------------------} procedure TCustomForm.WMDeactivate(var Message : TLMActivate); begin FActive:=false; if Application<>nil then Application.Deactivate; Deactivate; end; {------------------------------------------------------------------------------ Method: TCustomForm.Activate Params: none Returns: nothing Activation form methode event handler. ------------------------------------------------------------------------------} procedure TCustomForm.Activate; begin if Assigned(FOnActivate) then FOnActivate(Self); end; {------------------------------------------------------------------------------ procedure TCustomForm.ActiveChanged; ------------------------------------------------------------------------------} procedure TCustomForm.ActiveChanged; begin end; {------------------------------------------------------------------------------ Method: TCustomForm.Deactivate Params: none Returns: nothing Form deactivation (losing focus within application) event handler. ------------------------------------------------------------------------------} procedure TCustomForm.Deactivate; begin if Assigned(FOnDeactivate) then FOnDeactivate(Self); end; {------------------------------------------------------------------------------ Method: TCustomForm.WMPaint Params: Msg: The paint message Returns: nothing Paint event handler. ------------------------------------------------------------------------------} procedure TCustomForm.WMPaint(var Message: TLMPaint); begin //DebugLn('[TCustomForm.WMPaint] ',Name,':',ClassName); inherited WMPaint(Message); //DebugLn('[TCustomForm.WMPaint] END ',Name,':',ClassName); end; {------------------------------------------------------------------------------ Method: TCustomForm.WMSize Params: Msg: The Size message Returns: nothing Resize event handler. ------------------------------------------------------------------------------} procedure TCustomForm.WMSize(var Message: TLMSize); var OldState: TWindowState; begin {$IFDEF CHECK_POSITION} DebugLn('[TCustomForm.WMSize] ',DbgSName(Self),' Message.SizeType=',dbgs(Message.SizeType),' Message.Width=',dbgs(Message.Width),' Message.Height=',dbgs(Message.Height)); {$ENDIF} Assert(False, 'Trace:WMSIZE in TCustomForm'); if not (csDesigning in ComponentState) then begin OldState:=FWindowState; Case (Message.SizeType and not SIZE_SourceIsInterface) of SIZENORMAL : if Showing then FWindowState := wsNormal; SIZEICONIC : begin if Showing then FWindowState := wsMinimized; if Application.MainForm = Self then Application.Minimize; end; SIZEFULLSCREEN: if Showing then FWindowState := wsMaximized; end; if OldState<>FWindowState then begin if Assigned(OnWindowStateChange) then OnWindowStateChange(Self); end; end; inherited WMSize(Message); if (Message.SizeType and not Size_SourceIsInterface) = Size_Restored then begin FRestoredLeft := Left; FRestoredTop := Top; FRestoredWidth := Width; FRestoredHeight := Height; //DebugLn('[TCustomForm.WMSize] saving restored bounds ',DbgSName(Self),' ',dbgs(FRestoredWidth),'x',dbgs(FRestoredHeight)); end; End; procedure TCustomForm.AddHandler(HandlerType: TFormHandlerType; const Handler: TMethod; AsLast: Boolean); begin if Handler.Code=nil then RaiseGDBException('TCustomForm.AddHandler'); if FFormHandlers[HandlerType]=nil then FFormHandlers[HandlerType]:=TMethodList.Create; FFormHandlers[HandlerType].Add(Handler,AsLast); end; procedure TCustomForm.RemoveHandler(HandlerType: TFormHandlerType; const Handler: TMethod); begin FFormHandlers[HandlerType].Remove(Handler); end; {------------------------------------------------------------------------------ Method: TCustomForm.DefocusControl Params: Control: the control which is to be defocused Removing: is it to be defocused because it is being removed? Returns: nothing Updates ActiveControl if it is to be defocused ------------------------------------------------------------------------------} procedure TCustomForm.DefocusControl(Control: TWinControl; Removing: Boolean); begin if Control.ContainsControl(FActiveControl) then begin {$IFDEF VerboseFocus} debugln('TCustomForm.DefocusControl Control=',DbgSName(Control),' FActiveControl=',DbgSName(FActiveControl)); {$ENDIF} ActiveControl := nil; end; end; {------------------------------------------------------------------------------ Method: TCustomForm.DoCreate Params: none Returns: nothing Calls user handler ------------------------------------------------------------------------------} procedure TCustomForm.DoCreate; begin LockRealizeBounds; if Assigned(FOnCreate) then FOnCreate(Self); FFormHandlers[fhtCreate].CallNotifyEvents(Self); UnlockRealizeBounds; end; {------------------------------------------------------------------------------ Method: TCustomForm.DoClose Params: none Returns: nothing Calls user handler ------------------------------------------------------------------------------} procedure TCustomForm.DoClose(var CloseAction: TCloseAction); var i: LongInt; begin if Assigned(FOnClose) then FOnClose(Self, CloseAction); i:=FFormHandlers[fhtClose].Count; while FFormHandlers[fhtClose].NextDownIndex(i) do TCloseEvent(FFormHandlers[fhtClose][i])(Self,CloseAction); //DebugLn('TCustomForm.DoClose ',DbgSName(Self),' ',dbgs(ord(CloseAction))); end; {------------------------------------------------------------------------------ Method: TCustomForm.DoDestroy Params: none Returns: nothing Calls user handler ------------------------------------------------------------------------------} procedure TCustomForm.DoDestroy; begin if Assigned(FOnDestroy) then FOnDestroy(Self); end; {------------------------------------------------------------------------------ procedure TCustomForm.SetActive(AValue: Boolean); ------------------------------------------------------------------------------} procedure TCustomForm.SetActive(AValue: Boolean); begin FActive := AValue; //if FActiveOleControl <> nil then // FActiveOleControl.Perform(CM_DOCWINDOWACTIVATE, WParam(Ord(Value)), 0); if FActive then begin if (ActiveControl = nil) and not (csDesigning in ComponentState) then ActiveControl := FindNextControl(nil, True, True, False); //MergeMenu(True); SetWindowFocus; end; end; {------------------------------------------------------------------------------ Method: TCustomForm.DoHide Params: none Returns: nothing Calls user handler ------------------------------------------------------------------------------} procedure TCustomForm.DoHide; begin if Assigned(FOnHide) then FOnHide(Self); end; {------------------------------------------------------------------------------ Method: TCustomForm.DoShow Params: none Returns: nothing Calls user handler ------------------------------------------------------------------------------} procedure TCustomForm.DoShow; begin if Assigned(FOnShow) then FOnShow(Self); end; {------------------------------------------------------------------------------ procedure TCustomForm.EndFormUpdate; ------------------------------------------------------------------------------} procedure TCustomForm.EndFormUpdate; begin dec(FFormUpdateCount); if FFormUpdateCount=0 then begin Visible:=(fsVisible in FFormState); end; end; procedure TCustomForm.EnsureVisible(AMoveToTop: boolean = true); var newLeft, newTop: integer; begin newLeft := Left; newTop := Top; if newLeft + (Width div 2) > Screen.Width then newLeft := Screen.Width - Width; if newLeft < 0 then newLeft := 0; if newTop + (Height div 2) + 24 > Screen.Height then newTop := Screen.Height - Height - 24; if newTop < 0 then newTop := 0; SetBounds(newLeft, newTop, Width, Height); if AMoveToTop then ShowOnTop else Show; end; {------------------------------------------------------------------------------ function TCustomForm.FormUpdating: boolean; ------------------------------------------------------------------------------} function TCustomForm.FormUpdating: boolean; begin Result:=FFormUpdateCount>0; end; {------------------------------------------------------------------------------ Method: TCustomForm.GetChildren Params: Proc - see fcl/inc/writer.inc Root Returns: nothing Adds component to children list which have no parent. (TWinControl only lists components with parents) ------------------------------------------------------------------------------} procedure TCustomForm.GetChildren(Proc: TGetChildProc; Root: TComponent); var I: Integer; OwnedComponent: TComponent; begin inherited GetChildren(Proc, Root); if Root = Self then for I := 0 to ComponentCount - 1 do begin OwnedComponent := Components[I]; if OwnedComponent.HasParent = False then Proc(OwnedComponent); end; end; {------------------------------------------------------------------------------ Method: TCustomForm.PaintWindow Params: none Returns: nothing Calls user handler ------------------------------------------------------------------------------} Procedure TCustomForm.PaintWindow(DC : Hdc); begin // FCanvas.Lock; try Canvas.Handle := DC; //DebugLn('[TCustomForm.PaintWindow] ',ClassName,' DC=',DbgS(DC,8),' ',DbgS(FCanvas.Handle,8)); try if FDesigner <> nil then FDesigner.PaintGrid else Paint; finally Canvas.Handle := 0; end; finally // FCanvas.Unlock; end; end; {------------------------------------------------------------------------------ Method: TCustomForm.RequestAlign Params: none Returns: nothing Calls user handler ------------------------------------------------------------------------------} Procedure TCustomForm.RequestAlign; Begin if Parent = nil then begin //Screen.AlignForm(Self); end else inherited RequestAlign; end; {------------------------------------------------------------------------------ TCustomForm SetDesigner ------------------------------------------------------------------------------} Procedure TCustomForm.SetDesigner(Value : TIDesigner); Begin FDesigner := Value; end; {------------------------------------------------------------------------------ procedure TCustomForm.SetZOrder(Topmost: Boolean); ------------------------------------------------------------------------------} procedure TCustomForm.SetZOrder(Topmost: Boolean); begin if Parent=nil then begin if TopMost and HandleAllocated then begin if (Screen.GetCurrentModalForm<>nil) and (Screen.GetCurrentModalForm<>Self) then exit; //TODO: call TWSCustomFormClass(Widgetset).SetZORder. Screen.MoveFormToZFront(Self); SetForegroundWindow(Handle); end; end else inherited SetZOrder(Topmost); end; procedure TCustomForm.SetParent(NewParent: TWinControl); begin if Parent=NewParent then exit; if HandleAllocated then DestroyHandle; inherited SetParent(NewParent); if (Parent=nil) and Visible then HandleNeeded; end; {------------------------------------------------------------------------------ procedure TCustomForm.VisibleChanging; ------------------------------------------------------------------------------} procedure TCustomForm.VisibleChanging; begin //if (FormStyle = fsMDIChild) and Visible then // raise EInvalidOperation.Create(SMDIChildNotVisible); inherited VisibleChanging; end; {------------------------------------------------------------------------------ TCustomForm WndProc ------------------------------------------------------------------------------} procedure TCustomForm.WndProc(Var TheMessage : TLMessage); var FocusHandle : HWND; MenuItem : TMenuItem; begin with TheMessage do case Msg of LM_ACTIVATE, LM_SETFOCUS, LM_KILLFOCUS: begin if not FocusMessages then Exit; if (Msg = LM_SetFocus) and not (csDesigning in ComponentState) then begin FocusHandle := 0; if FormStyle = fsMDIFORM then begin // ToDo end else begin if (FActiveControl <> nil) and (FActiveControl <> Self) and FActiveControl.Visible and FActiveControl.Enabled and ([csLoading,csDestroying]*ComponentState=[]) and not FActiveControl.ParentDestroyingHandle then begin // get or create handle of FActiveControl FocusHandle := FActiveControl.Handle; //debugln('TCustomForm.WndProc A ',DbgSName(Self),' FActiveControl=',DbgSName(FActiveControl),' FocusHandle=',dbgs(FocusHandle)); end; end; TheMessage.Result:=0; if FocusHandle <> 0 then begin {$IFDEF VerboseFocus} DebugLn('[TCustomForm.WndProc] ',Name,':',ClassName); {$ENDIF} LCLIntf.SetFocus(FocusHandle); Exit; end; end; end; CM_EXIT: begin //TODO: deal with docking if HostDockSite <> nil then DeActivate; end; CM_ENTER: begin //TODO: Deal with docking if HostDockSite <> nil then Activate; end; LM_WINDOWPOSCHANGING: if ([csLoading, csDesigning] * ComponentState = [csLoading]) then begin if (Position in [poDefault, poDefaultPosOnly]) and (WindowState <> wsMaximized) then with PWindowPos(TheMessage.lParam)^ do flags := flags or SWP_NOMOVE; if (Position in [poDefault, poDefaultSizeOnly]) and (BorderStyle in [bsSizeable, bsSizeToolWin]) then with PWindowPos(TheMessage.lParam)^ do flags := flags or SWP_NOSIZE; end; LM_DRAWITEM: with PDrawItemStruct(TheMessage.LParam)^ do begin if (CtlType = ODT_MENU) and Assigned(Menu) then begin MenuItem := Menu.FindItem(itemID, fkCommand); if MenuItem <> nil then begin Exit; end; end; end; end; inherited WndProc(TheMessage); end; function TCustomForm.VisibleIsStored: boolean; begin Result:=Visible; end; function TCustomForm.ColorIsStored: boolean; begin Result:=(Color<>clBtnFace); end; procedure TCustomForm.DoSendBoundsToInterface; begin inherited DoSendBoundsToInterface; if WindowState=wsNormal then begin FRestoredLeft:=Left; FRestoredTop:=Top; FRestoredWidth:=Width; FRestoredHeight:=Height; end; end; procedure TCustomForm.DoDock(NewDockSite: TWinControl; var ARect: TRect); begin if (NewDockSite<>HostDockSite) then begin end; inherited DoDock(NewDockSite, ARect); end; function TCustomForm.GetFloating: Boolean; begin Result := (HostDockSite = nil) and (FloatingDockSiteClass = ClassType); end; procedure TCustomForm.CMActionExecute(var Message: TLMessage); begin if DoExecuteAction(TBasicAction(Message.LParam)) then Message.Result := 1; end; procedure TCustomForm.CMActionUpdate(var Message: TLMessage); begin if DoUpdateAction(TBasicAction(Message.LParam)) then Message.Result := 1; end; function TCustomForm.DoExecuteAction(ExeAction: TBasicAction): boolean; function ProcessExecute(Control: TControl): Boolean; begin Result := (Control <> nil) and Control.ExecuteAction(ExeAction); end; function TraverseClients(Container: TWinControl): Boolean; var I: Integer; Control: TControl; begin if Container.Showing then for I := 0 to Container.ControlCount - 1 do begin Control := Container.Controls[I]; if Control.Visible and ProcessExecute(Control) or (Control is TWinControl) and TraverseClients(TWinControl(Control)) then begin Result := True; exit; end; end; Result := False; end; begin Result := false; if (csDesigning in ComponentState) or (not Showing) then exit; if ProcessExecute(ActiveControl) or ProcessExecute(Self) or TraverseClients(Self) then Result := true; end; function TCustomForm.DoUpdateAction(TheAction: TBasicAction): boolean; function ProcessUpdate(Control: TControl): Boolean; begin Result := (Control <> nil) and Control.UpdateAction(TheAction); end; function TraverseClients(Container: TWinControl): Boolean; var I: Integer; Control: TControl; begin if Container.Showing then for I := 0 to Container.ControlCount - 1 do begin Control := Container.Controls[I]; if Control.Visible and ProcessUpdate(Control) or (Control is TWinControl) and TraverseClients(TWinControl(Control)) then begin Result := True; exit; end; end; Result := False; end; begin Result:=false; if (csDesigning in ComponentState) or not Showing then exit; // Find a target for given Command (Message.LParam). if ProcessUpdate(ActiveControl) or ProcessUpdate(Self) or TraverseClients(Self) then Result:=true; end; procedure TCustomForm.UpdateActions; procedure RecursiveInitiate(Container: TWinControl); var i: Integer; CurControl: TControl; begin if not Container.Showing then exit; //DebugLn(['RecursiveInitiate ',DbgSName(Container)]); for i := 0 to Container.ControlCount - 1 do begin CurControl := Container.Controls[i]; if (csActionClient in CurControl.ControlStyle) and CurControl.Visible then CurControl.InitiateAction; if CurControl is TWinControl then RecursiveInitiate(TWinControl(CurControl)); end; end; var I: Integer; begin if (csDesigning in ComponentState) or (not Showing) then exit; // update this form InitiateAction; // update main menu's top-most items if Menu <> nil then for I := 0 to Menu.Items.Count - 1 do with Menu.Items[I] do begin //DebugLn(['TCustomForm.UpdateActions ',Name,' Visible=',Visible]); if Visible then InitiateAction; end; // update all controls RecursiveInitiate(Self); end; {------------------------------------------------------------------------------ TCustomForm SetMenu ------------------------------------------------------------------------------} Procedure TCustomForm.SetMenu(Value : TMainMenu); var I: Integer; begin if FMenu=Value then exit; if Value <> nil then for I := 0 to Screen.FormCount - 1 do if (Screen.Forms[I].Menu = Value) and (Screen.Forms[I] <> Self) then raise EInvalidOperation.CreateFmt(sDuplicateMenus, [Value.Name]); if FMenu<>nil then FMenu.Parent:=nil; if (csDestroying in ComponentState) or ((Value <> nil) and (csDestroying in Value.ComponentState)) then Value := nil; FMenu := Value; if FMenu<>nil then begin FMenu.Parent:=Self; if HandleAllocated then begin FMenu.HandleNeeded; WidgetSet.AttachMenuToWindow(FMenu); end; end; end; {------------------------------------------------------------------------------} { TCustomForm SetBorderIcons } {------------------------------------------------------------------------------} procedure TCustomForm.SetBorderIcons(NewIcons: TBorderIcons); begin if FBorderIcons = NewIcons then exit; FBorderIcons := NewIcons; if HandleAllocated then TWSCustomFormClass(WidgetSetClass).SetBorderIcons(Self, NewIcons); end; {------------------------------------------------------------------------------} { TCustomForm SetFormBorderStyle } {------------------------------------------------------------------------------} procedure TCustomForm.SetFormBorderStyle(NewStyle: TFormBorderStyle); var AdaptBorderIcons: boolean; begin if FFormBorderStyle = NewStyle then exit; //TODO: Finish SETBORDERSTYLE AdaptBorderIcons := not (csLoading in ComponentState) and (BorderIcons=DefaultBorderIcons[FFormBorderStyle]); FFormBorderStyle := NewStyle; // if Form had default border icons before change, it should keep the default if AdaptBorderIcons then BorderIcons := DefaultBorderIcons[FFormBorderStyle]; Include(FFormState,fsBorderStyleChanged); // ToDo: implement it. // We can not use inherited SetBorderStyle(NewStyle), // because TBorderSTyle <> TFormBorderSTyle; if HandleAllocated then TWSCustomFormClass(WidgetSetClass).SetFormBorderStyle(Self, NewStyle); end; {------------------------------------------------------------------------------} { TCustomForm UpdateWindowState } {------------------------------------------------------------------------------} Procedure TCustomForm.UpdateWindowState; Begin //TODO: Finish UpdateWindowState Assert(False, 'Trace:TODO: [TCustomForm.UpdateWindowState]'); end; {------------------------------------------------------------------------------} { TCustomForm SetWindowState } {------------------------------------------------------------------------------} 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.SetRestoredBounds(ALeft, ATop, AWidth, AHeight: integer); var prevWindowState: TWindowState; begin // temporarily go to normal window state to store restored bounds prevWindowState := WindowState; WindowState := wsNormal; SetBounds(ALeft, ATop, AWidth, AHeight); WindowState := prevWindowState; end; {------------------------------------------------------------------------------} { TCustomForm SetActiveControl } {------------------------------------------------------------------------------} Procedure TCustomForm.SetActiveControl(AWinControl: TWinControl); Begin if FActiveControl <> AWinControl then begin if (AWinControl<>nil) then begin if (AWinControl=Self) or (GetParentForm(AWinControl)<>Self) or ((not (csLoading in ComponentState)) and (not AWinControl.CanFocus)) then begin DebugLn('TCustomForm.SetActiveControl ',DbgSName(Self),' AWinControl=',DbgSName(AWinControl),' GetParentForm(AWinControl)=',DbgSName(GetParentForm(AWinControl)),' csLoading=',dbgs(csLoading in ComponentState),' AWinControl.CanFocus=',dbgs((AWinControl<>nil) and AWinControl.CanFocus)); {$IFDEF VerboseFocus} RaiseGDBException(SCannotFocus); {$ELSE} raise EInvalidOperation.Create(SCannotFocus); {$ENDIF} end; end; {$IFDEF VerboseFocus} DbgOut('TCustomForm.SetActiveControl ',Name,':',ClassName,' FActive=',DbgS(FActive)); if FActiveControl<>nil then DebugLn(' OldActiveControl=',DbgSName(FActiveControl)) else DebugLn(' OldActiveControl=nil'); if AWinControl<>nil then DebugLn(' NewActiveControl=',DbgSName(AWinControl)) else DebugLn(' NewActiveControl=nil'); {$ENDIF} FActiveControl := AWinControl; if ([csLoading,csDestroying]*ComponentState=[]) then begin if FActive then SetWindowFocus; ActiveChanged; end; end; end; procedure TCustomForm.SetActiveDefaultControl(AControl: TControl); var lPrevControl: TControl; begin if AControl = FActiveDefaultControl then exit; lPrevControl := FActiveDefaultControl; FActiveDefaultControl := AControl; // notify previous active default control that he has lost "default-ness" if lPrevControl <> nil then lPrevControl.ActiveDefaultControlChanged(AControl); // notify default control that it may become/lost active default again if (FDefaultControl <> nil) and (FDefaultControl <> lPrevControl) then FDefaultControl.ActiveDefaultControlChanged(AControl); end; {------------------------------------------------------------------------------ TCustomForm SetFormStyle ------------------------------------------------------------------------------} Procedure TCustomForm.SetFormStyle(Value : TFormStyle); var OldFormStyle: TFormStyle; Begin if FFormStyle = Value then exit; if (Value in [fsMDIChild, fsMDIForm]) then raise Exception.Create('TCustomForm.SetFormStyle MDI forms are not implemented yet'); OldFormStyle:=FFormStyle; FFormStyle := Value; Include(FFormState,fsFormStyleChanged); if FFormStyle=fsSplash then begin BorderStyle:=bsNone; end else if OldFormStyle=fsSplash then begin BorderStyle:=bsSizeable; end; end; {------------------------------------------------------------------------------ TCustomForm SetPosition ------------------------------------------------------------------------------} procedure TCustomForm.SetPosition(Value : TPosition); begin if Value <> FPosition then begin FPosition := Value; UpdateControlState; end; end; procedure TCustomForm.SetShowInTaskbar(Value: TShowInTaskbar); begin if Value = FShowInTaskbar then exit; FShowInTaskbar := Value; if HandleAllocated then TWSCustomFormClass(WidgetSetClass).SetShowInTaskbar(Self, Value); end; {------------------------------------------------------------------------------ TCustomForm Constructor ------------------------------------------------------------------------------} constructor TCustomForm.Create(AOwner : TComponent); begin //DebugLn('[TCustomForm.Create] A Class=',Classname); FShowInTaskbar := stDefault; GlobalNameSpace.BeginWrite; try BeginFormUpdate; try CreateNew(AOwner, 1); //DebugLn('[TCustomForm.Create] B Class=',Classname); if (ClassType <> TForm) and not (csDesigning in ComponentState) then begin Include(FFormState, fsCreating); try //DebugLn('[TCustomForm.Create] C Class=',Classname); if not InitResourceComponent(Self, TForm) then begin //DebugLn('[TCustomForm.Create] Resource '''+ClassName+''' not found'); //DebugLn('This is for information purposes only. This is not critical at this time.'); // MG: Ignoring is best at the moment. (Delphi raises an exception.) end; //DebugLn('[TCustomForm.Create] D Class=',Classname); DoCreate; //DebugLn('[TCustomForm.Create] E Class=',Classname); finally Exclude(FFormState, fsCreating); end; end; finally EndFormUpdate; end; finally GlobalNameSpace.EndWrite; end; //DebugLn('[TCustomForm.Create] END Class=',Classname); end; {------------------------------------------------------------------------------ constructor TCustomForm.CreateNew(AOwner: TComponent; Num : Integer); ------------------------------------------------------------------------------} constructor TCustomForm.CreateNew(AOwner: TComponent; Num : Integer); begin Include(FFormState,fsFirstShow); //DebugLn('[TCustomForm.CreateNew] Class=',Classname); BeginFormUpdate; FBorderIcons := [biSystemMenu, biMinimize, biMaximize]; // set border style before handle is allocated if not (fsBorderStyleChanged in FFormState) then FFormBorderStyle:= bsSizeable; // set form style before handle is allocated if not (fsFormStyleChanged in FFormState) then FFormStyle:= fsNormal; inherited Create(AOwner); Visible := False; fCompStyle:= csForm; FMenu:= nil; ControlStyle := ControlStyle + [csAcceptsControls, csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks]; SetInitialBounds(0,0,320,240); ParentColor := False; ParentFont := False; Ctl3D := True; FWindowState := wsNormal; FIcon := TIcon.Create; FKeyPreview := False; Color := clBtnFace; FloatingDockSiteClass := TWinControlClass(ClassType); Screen.AddForm(Self); EndFormUpdate; End; {------------------------------------------------------------------------------ TCustomForm CreateParams ------------------------------------------------------------------------------} procedure TCustomForm.CreateParams(var Params : TCreateParams); begin inherited CreateParams(Params); with Params do begin if (Parent = nil) {and (ParentWindow = 0)} then begin // WndParent := Application.Handle; { TODO : No application handle } Style := Style and not Cardinal(WS_GROUP or WS_TABSTOP); if Parent=nil then Style := Style and not Cardinal(WS_CHILD); end; end; end; {------------------------------------------------------------------------------ TCustomForm Method Close ------------------------------------------------------------------------------} Procedure TCustomForm.Close; var CloseAction: TCloseAction; begin if fsModal in FFormState then ModalResult := mrCancel else begin //DebugLn('TCustomForm.Close A ',DbgSName(Self)); if CloseQuery then begin if FormStyle = fsMDIChild then begin //if biMinimize in BorderIcons then // CloseAction := caMinimize //else CloseAction := caNone; end else begin CloseAction := caHide; end; //DebugLn('TCustomForm.Close B ',DbgSName(Self)); DoClose(CloseAction); if CloseAction <> caNone then begin //DebugLn('TCustomForm.Close C ',DbgSName(Self),' ',dbgs(ord(CloseAction))); if (Application.MainForm = Self) or (Self.IsParentOf(Application.MainForm)) then Application.Terminate else if CloseAction = caHide then Hide else if CloseAction = caMinimize then WindowState := wsMinimized else Release; end; end; end; end; {------------------------------------------------------------------------------ procedure TCustomForm.Release; ------------------------------------------------------------------------------} procedure TCustomForm.Release; begin if Application<>nil then Application.ReleaseComponent(Self) else Free; end; {------------------------------------------------------------------------------ TCustomForm Method CloseQuery ------------------------------------------------------------------------------} function TCustomForm.CloseQuery: boolean; //var i : integer; begin { Query children forms whether we can close } if FormStyle = fsMDIForm then begin { for i:= 0 to MDIChildCount - 1 do begin if not MDIChildren[i].CloseQuery then begin Result:= false; Exit; end; end;} end; Result := true; if Assigned(FOnCloseQuery) then FOnCloseQuery(Self, Result); end; {------------------------------------------------------------------------------ TCustomForm Method WMCloseQuery ------------------------------------------------------------------------------} procedure TCustomForm.WMCloseQuery(var Message: TLMessage); begin Close; // Always return 0, because we destroy the window ourselves Message.Result:= 0; end; {------------------------------------------------------------------------------ TCustomForm Method Hide ------------------------------------------------------------------------------} procedure TCustomForm.Hide; begin if (fsModal in FormState) and (ModalResult=0) then ModalResult := mrCancel; Visible := False; end; {------------------------------------------------------------------------------ procedure TCustomForm.Show; ------------------------------------------------------------------------------} procedure TCustomForm.Show; begin Visible:=true; end; {------------------------------------------------------------------------------ procedure TCustomForm.ShowOnTop; ------------------------------------------------------------------------------} procedure TCustomForm.ShowOnTop; begin Show; if WindowState=wsMinimized then WindowState:=wsNormal; BringToFront; //DebugLn('TCustomForm.ShowOnTop ',Name,':',ClassName,' ',Visible,' ',HandleAllocated,' ',csDesigning in ComponentState); end; function TCustomForm.NeedParentForAutoSize: Boolean; begin Result:=false; end; {------------------------------------------------------------------------------ TCustomForm Method IsForm ------------------------------------------------------------------------------} function TCustomForm.IsForm: Boolean; begin Result := true; end; function TCustomForm.GetPixelsPerInch: Longint; var ParentForm: TCustomForm; DC: HDC; begin if FPixelsPerInch=0 then begin if Parent<>nil then begin ParentForm:=GetParentForm(Self); if ParentForm<>nil then begin FPixelsPerInch:=ParentForm.PixelsPerInch; end; end; if FPixelsPerInch<=0 then begin if HandleAllocated then begin DC:=GetDC(Handle); FPixelsPerInch:=GetDeviceCaps(DC,LOGPIXELSX); ReleaseDC(Handle,DC); end else begin FPixelsPerInch:=Screen.PixelsPerInch; end; end; end; Result:=FPixelsPerInch; end; {------------------------------------------------------------------------------ function TCustomForm.IsHelpFileStored: boolean; ------------------------------------------------------------------------------} function TCustomForm.IsHelpFileStored: boolean; begin Result:=FHelpFile<>''; end; {------------------------------------------------------------------------------ TCustomForm Method SetFocusedControl Switch focus. ------------------------------------------------------------------------------} function TCustomForm.SetFocusedControl(Control: TWinControl): Boolean; var ParentForm: TCustomForm; begin Result := False; if (csDestroying in Control.ComponentState) then exit; if (Parent<>nil) then begin ParentForm:=GetParentForm(Self); if ParentForm<>nil then ParentForm.SetFocusedControl(Control); exit; end; // update FActiveControl if (FDesigner = nil) and (not (csLoading in ComponentState)) then if Control <> Self then FActiveControl := Control else FActiveControl := nil; // update Screen object Screen.FActiveControl := Control; Screen.FActiveCustomForm := Self; Screen.MoveFormToFocusFront(Self); if Self is TForm then Screen.FActiveForm := TForm(Self) else Screen.FActiveForm := nil; {$IFDEF VerboseFocus} DbgOut('TCustomForm.SetFocusedControl Self=',DbgSName(Self)); DbgOut(' Control=',DbgSName(Control),' Control.HandleAllocated=',dbgs(Control.HandleAllocated)); DebugLn(); {$ENDIF} Result:=true; if not (csFocusing in Control.ControlState) then begin // prevent looping Control.ControlState := Control.ControlState + [csFocusing]; try // change focus finally Control.ControlState := Control.ControlState - [csFocusing]; end; end; { Inc(FocusCount); // prevent looping if (csFocusing in Control.ControlState) then exit; Control.ControlState := Control.ControlState + [csFocusing]; try if Screen.FFocusedForm <> Self then begin if Screen.FFocusedForm <> nil then begin FocusHandle := Screen.FFocusedForm.Handle; Screen.FFocusedForm := nil; if not SendFocusMessage(FocusHandle, CM_DEACTIVATE) then Exit; end; Screen.FFocusedForm := Self; if not SendFocusMessage(Handle, CM_ACTIVATE) then Exit; end; if FFocusedWinControl = nil then FFocusedWinControl := Self; if FFocusedWinControl <> Control then begin while (FFocusedWinControl <> nil) and not FFocusedWinControl.ContainsControl(Control) do begin FocusHandle := FFocusedWinControl.Handle; FFocusedWinControl := FFocusedWinControl.Parent; if not SendFocusMessage(FocusHandle, CM_EXIT) then Exit; end; while FFocusedControl <> Control do begin TempControl := Control; while TempControl.Parent <> FFocusedControl do TempControl := TempControl.Parent; FFocusedControl := TempControl; if not SendFocusMessage(TempControl.Handle, CM_ENTER) then Exit; end; TempControl := Control.Parent; while TempControl <> nil do begin if TempControl is TScrollingWinControl then TScrollingWinControl(TempControl).AutoScrollInView(Control); TempControl := TempControl.Parent; end; Perform(CM_FOCUSCHANGED, 0, LParam(Control)); if (FActiveOleControl <> nil) and (FActiveOleControl <> Control) then FActiveOleControl.Perform(CM_UIDEACTIVATE, 0, 0); end; finally Control.ControlState := Control.ControlState - [csFocusing]; end; Screen.UpdateLastActive; Result := True; } end; {------------------------------------------------------------------------------} { TCustomForm Method WantChildKey } {------------------------------------------------------------------------------} function TCustomForm.WantChildKey(Child : TControl; var Message : TLMessage):Boolean; begin Result := False; end; function TCustomForm.IsShortCut(var Message: TLMKey): boolean; var I: integer; begin Result := false; if Assigned(FOnShortcut) then begin FOnShortcut(Message, Result); if Result then exit; end; if Assigned(FMenu) then begin Result := FMenu.IsShortCut(Message); if Result then exit; end; if Assigned(FActionLists) then begin for I := 0 to FActionLists.Count - 1 do begin Result := TCustomActionList(FActionLists.Items[I]).IsShortCut(Message); if Result then exit; end; end; end; {------------------------------------------------------------------------------ procedure TCustomForm.IntfHelp(AComponent: TComponent); Show help for control or menu item. This function is called by the interface. ------------------------------------------------------------------------------} procedure TCustomForm.IntfHelp(AComponent: TComponent); begin if csDesigning in ComponentState then exit; if AComponent is TControl then begin TControl(AComponent).ShowHelp; end else begin DebugLn('TCustomForm.IntfHelp TODO help for ',DbgSName(AComponent)); end; end; {------------------------------------------------------------------------------ Method: TCustomForm.CreateWnd Params: None Returns: Nothing Creates the interface object. ------------------------------------------------------------------------------} procedure TCustomForm.CreateWnd; begin //DebugLn('TCustomForm.CreateWnd START ',ClassName); FFormState:=FFormState-[fsBorderStyleChanged,fsFormStyleChanged]; inherited CreateWnd; FPixelsPerInch:=0; Assert(False, 'Trace:[TCustomForm.CreateWnd] FMenu.HandleNeeded'); if FMenu <> nil then begin FMenu.HandleNeeded; WidgetSet.AttachMenuToWindow(FMenu); end; // activate focus if visible if Visible then begin if (FActiveControl<>nil) and FActiveControl.HandleAllocated and FActiveControl.Visible and FActiveControl.Enabled and ([csLoading,csDestroying]*ComponentState=[]) then begin {$IFDEF VerboseFocus} DebugLn('TCustomForm.CreateWnd A ',FActiveControl.Name,':',FActiveControl.ClassName); {$ENDIF} LCLIntf.SetFocus(FActiveControl.Handle); end; end; //DebugLn('TCustomForm.CreateWnd END ',ClassName); end; procedure TCustomForm.DestroyWnd; begin if FMenu <> nil then begin FMenu.DestroyHandle; end; inherited DestroyWnd; end; procedure TCustomForm.Loaded; var Control: TWinControl; begin inherited Loaded; if FMenu<>nil then FMenu.HandleNeeded; if ActiveControl <> nil then begin Control := ActiveControl; {$IFDEF VerboseFocus} Debugln('TCustomForm.Loaded Self=',DbgSName(Self),' FActiveControl=',DbgSName(FActiveControl)); {$ENDIF} FActiveControl := nil; if Control.CanFocus then SetActiveControl(Control); end; //DebugLn('TCustomForm.Loaded ',Name,':',ClassName,' ',FormUpdating,' ',fsCreating in FFormState,' ',Visible,' ',fsVisible in FormState); if fsVisible in FormState then Visible:=true; end; {------------------------------------------------------------------------------ procedure TCustomForm.BeginFormUpdate; Called after all childs handles are created. ------------------------------------------------------------------------------} procedure TCustomForm.ChildHandlesCreated; begin inherited ChildHandlesCreated; if Parent=nil then ParentFormHandleInitialized; end; {------------------------------------------------------------------------------ procedure TCustomForm.BeginFormUpdate; ------------------------------------------------------------------------------} procedure TCustomForm.BeginFormUpdate; begin inc(FFormUpdateCount); end; {------------------------------------------------------------------------------ Method: TCustomForm.UpdateShowing Params: None Returns: Nothing Here the initial form left and top are determined. ------------------------------------------------------------------------------} procedure TCustomForm.UpdateShowing; var X, Y : integer; begin {$IFDEF CHECK_POSITION} DebugLn('[TCustomForm.UpdateShowing] A Class=',Name,':',Classname,' Pos=',DbgS(Left),',',DbgS(Top),' Visible=',DbgS(Visible)); {$ENDIF} { If the the form is about to show, calculate its metrics } if Visible then begin if Parent=nil then begin // first make sure X and Y are assigned X := Left; Y := Top; if (Position = poMainFormCenter) and (FormStyle = fsMDIChild) and (Self <> Application.Mainform) then begin X:= (Application.Mainform.ClientWidth - Width) div 2; Y:= (Application.Mainform.ClientHeight - Height) div 2; end else begin case Position of //TODO:poDefault, poDefaultPosOnly, poDefaultSizeOnly poScreenCenter, poDesktopCenter : begin X:= (Screen.Width - Width) div 2; Y:= (Screen.Height - Height) div 2; end; poMainFormCenter : if (Self <> Application.MainForm) then begin X:= ((Application.MainForm.Width - Width) div 2) + Application.MainForm.Left; Y:= ((Application.MainForm.Height - Height) div 2) + Application.MainForm.Top; end; poOwnerFormCenter : if (Owner is TCustomForm) then begin X:= ((TCustomForm(Owner).Width - Width) div 2) + TCustomForm(Owner).Left; Y:= ((TCustomForm(Owner).Height - Height) div 2) + TCustomForm(Owner).Top; end; end; end; if X < 0 then X := 0; if Y < 0 then Y := 0; SetBounds(X, Y, Width, Height); end; if (fsFirstShow in FFormState) then begin Exclude(FFormState,fsFirstShow); DoFirstShow; end; end; {$IFDEF CHECK_POSITION} DebugLn('[TCustomForm.UpdateShowing] B ',Name,':',Classname,' Pos=',DbgS(Left),',',DbgS(Top)); {$ENDIF} inherited UpdateShowing; {$IFDEF CHECK_POSITION} DebugLn('[TCustomForm.UpdateShowing] END ',Name,':',Classname,' Pos=',DbgS(Left),',',DbgS(Top)); {$ENDIF} end; procedure TCustomForm.DoFirstShow; begin FFormHandlers[fhtFirstShow].CallNotifyEvents(Self); end; {------------------------------------------------------------------------------} { TCustomForm ShowModal } {------------------------------------------------------------------------------} Function TCustomForm.ShowModal: Integer; procedure RaiseShowModalImpossible; begin DebugLn('TCustomForm.ShowModal Visible=',dbgs(Visible),' Enabled=',dbgs(Enabled), ' fsModal=',dbgs(fsModal in FFormState),' MDIChild=',dbgs(FormStyle = fsMDIChild)); raise EInvalidOperation.Create('TCustomForm.ShowModal impossible '); end; var //WindowList: Pointer; SaveFocusCount: Integer; //SaveCursor: TCursor; //SaveCount: Integer; ActiveWindow: HWnd; begin if Self=nil then raise EInvalidOperation.Create('TCustomForm.ShowModal Self=nil'); if Application.Terminated then ModalResult:=0; // cancel drags CancelDrag; // close popupmenus if ActivePopupMenu<>nil then ActivePopupMenu.Close; //DebugLn('[TCustomForm.ShowModal] START ',Classname); if Visible or not Enabled or (fsModal in FFormState) or (FormStyle = fsMDIChild) then RaiseShowModalImpossible; // Kill capture when opening another dialog if GetCapture <> 0 then SendMessage(GetCapture,LM_CANCELMODE,0,0); ReleaseCapture; Include(FFormState, fsModal); ActiveWindow := GetActiveWindow; SaveFocusCount := FocusCount; Screen.FSaveFocusedList.Insert(0, Screen.FFocusedForm); Screen.FFocusedForm := Self; Screen.MoveFormToFocusFront(Self); Screen.MoveFormToZFront(Self); ModalResult := 0; try Show; try TWSCustomFormClass(WidgetSetClass).ShowModal(Self); repeat { Delphi calls Application.HandleMessage But HandleMessage processes all pending events and then calls idle, which will wait for new messages. Under Win32 there is always a next message, so it works there. The LCL is OS independent, and so it uses a better way: } WidgetSet.AppProcessMessages; // process all events if Application.Terminated then ModalResult := mrCancel; if ModalResult <> 0 then begin CloseModal; if ModalResult<>0 then break; end; Application.Idle(true); until false; Result := ModalResult; if HandleAllocated and (GetActiveWindow <> Handle) then ActiveWindow := 0; finally Hide; // free handles to save resources and to reduce overhead in the interfaces // for bookkeeping changing between Show and ShowModal. // (e.g.: the gtk interface creates some specials on ShowModal, so the // combination ShowModal, Close, Show makes problems.) DestroyHandle; end; finally if Screen.FSaveFocusedList.Count > 0 then begin Screen.FFocusedForm := TCustomForm(Screen.FSaveFocusedList.First); Screen.FSaveFocusedList.Remove(Screen.FFocusedForm); end else Screen.FFocusedForm := nil; Exclude(FFormState, fsModal); FocusCount := SaveFocusCount; //DebugLn('TCustomForm.ShowModal ',dbgs(ActiveWindow)); if ActiveWindow <> 0 then SetActiveWindow(ActiveWindow); end; end; function TCustomForm.GetRolesForControl(AControl: TControl ): TControlRolesForForm; begin Result:=[]; if DefaultControl=AControl then Include(Result,crffDefault); if CancelControl=AControl then Include(Result,crffCancel); end; procedure TCustomForm.RemoveAllHandlersOfObject(AnObject: TObject); var HandlerType: TFormHandlerType; begin inherited RemoveAllHandlersOfObject(AnObject); for HandlerType:=Low(TFormHandlerType) to High(TFormHandlerType) do FFormHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject); end; procedure TCustomForm.AddHandlerFirstShow(OnFirstShowHandler: TNotifyEvent; AsLast: Boolean); begin AddHandler(fhtFirstShow,TMethod(OnFirstShowHandler),AsLast); end; procedure TCustomForm.RemoveHandlerFirstShow(OnFirstShowHandler: TNotifyEvent); begin RemoveHandler(fhtFirstShow,TMethod(OnFirstShowHandler)); end; procedure TCustomForm.AddHandlerClose(OnCloseHandler: TCloseEvent; AsLast: Boolean); begin AddHandler(fhtClose,TMethod(OnCloseHandler),AsLast); end; procedure TCustomForm.RemoveHandlerClose(OnCloseHandler: TCloseEvent); begin RemoveHandler(fhtClose,TMethod(OnCloseHandler)); end; procedure TCustomForm.AddHandlerCreate(OnCreateHandler: TNotifyEvent; AsLast: Boolean); begin AddHandler(fhtCreate,TMethod(OnCreateHandler),AsLast); end; procedure TCustomForm.RemoveHandlerCreate(OnCreateHandler: TNotifyEvent); begin RemoveHandler(fhtCreate,TMethod(OnCreateHandler)); end; procedure TCustomForm.Dock(NewDockSite: TWinControl; ARect: TRect); begin inherited Dock(NewDockSite, ARect); end; //============================================================================== { TFormPropertyStorage } procedure TFormPropertyStorage.FormFirstShow(Sender: TObject); begin if Sender=nil then ; Restore; end; procedure TFormPropertyStorage.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin if Sender=nil then ; Save; end; constructor TFormPropertyStorage.Create(TheOwner: TComponent); begin inherited Create(TheOwner); if Owner is TCustomForm then begin TCustomForm(Owner).AddHandlerFirstShow(@FormFirstShow,true); TCustomForm(Owner).AddHandlerClose(@FormClose,true); end; end; destructor TFormPropertyStorage.Destroy; begin if Owner is TControl then TControl(Owner).RemoveAllHandlersOfObject(Self); inherited Destroy; end;