1{%MainUnit ../forms.pp} 2 3{****************************************************************************** 4 TCustomForm 5 ****************************************************************************** 6 7 ***************************************************************************** 8 This file is part of the Lazarus Component Library (LCL) 9 10 See the file COPYING.modifiedLGPL.txt, included in this distribution, 11 for details about the license. 12 ***************************************************************************** 13} 14 15{ $DEFINE CHECK_POSITION} 16 17const 18 BorderStylesAllowAutoScroll = [bsSizeable, bsSizeToolWin]; 19 ShowCommands: array[TWindowState] of Integer = 20 (SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED, SW_SHOWFULLSCREEN); 21 22{ TCustomForm } 23 24{------------------------------------------------------------------------------ 25 procedure TCustomForm.CloseModal; 26 ------------------------------------------------------------------------------} 27procedure TCustomForm.CloseModal; 28var 29 CloseAction: TCloseAction; 30begin 31 try 32 CloseAction := caNone; 33 if CloseQuery then 34 begin 35 CloseAction := caHide; 36 DoClose(CloseAction); 37 end; 38 case CloseAction of 39 caNone: ModalResult := 0; 40 caFree: Release; 41 end; 42 { do not call widgetset CloseModal here, but in ShowModal to 43 guarantee execution of it } 44 except 45 ModalResult := 0; 46 Application.HandleException(Self); 47 end; 48end; 49 50procedure TCustomForm.FreeIconHandles; 51begin 52 if FSmallIconHandle <> 0 then 53 begin 54 DestroyIcon(FSmallIconHandle); 55 FSmallIconHandle := 0; 56 end; 57 58 if FBigIconHandle <> 0 then 59 begin 60 DestroyIcon(FBigIconHandle); 61 FBigIconHandle := 0; 62 end; 63end; 64 65{------------------------------------------------------------------------------ 66 Method: TCustomForm.AfterConstruction 67 Params: None 68 Returns: Nothing 69 70 Gets called after the construction of the object 71 ------------------------------------------------------------------------------} 72procedure TCustomForm.AfterConstruction; 73var 74 MonPPI: Integer; 75begin 76 SetRestoredBounds(Left, Top, Width, Height, True); 77 DoCreate; 78 EndFormUpdate; // the BeginFormUpdate is in CreateNew 79 inherited AfterConstruction; 80 81 MonPPI := Monitor.PixelsPerInch; 82 if Application.Scaled and Scaled and (MonPPI > 0) and (MonPPI <> PixelsPerInch) 83 and not (csDesigning in ComponentState) then 84 AutoAdjustLayout(lapAutoAdjustForDPI, PixelsPerInch, MonPPI, 85 Width, MulDiv(Width, MonPPI, PixelsPerInch)); 86end; 87 88{------------------------------------------------------------------------------ 89 Method: TCustomForm.BeforeDestruction 90 Params: None 91 Returns: Nothing 92 93 Gets called before the destruction of the object 94 ------------------------------------------------------------------------------} 95procedure TCustomForm.BeforeDestruction; 96begin 97 // set csDestroying 98 inherited BeforeDestruction; 99 //debugln(['TCustomForm.BeforeDestruction ',DbgSName(Self),' ',csDestroying in ComponentState]); 100 // EndWrite will happen in the destructor 101 GlobalNameSpace.BeginWrite; 102 Screen.FSaveFocusedList.Remove(Self); 103 RemoveFixupReferences(Self, ''); 104 if (FormStyle <> fsMDIChild) or (csDesigning in ComponentState) then 105 Hide 106 else 107 if Assigned(Menu) and Assigned(Application.MainForm) and Assigned(Application.MainForm.Menu) then 108 Application.MainForm.Menu.Unmerge(Menu); 109 DoDestroy; 110 // don't call the inherited method because it calls Destroying which is already called 111end; 112 113{------------------------------------------------------------------------------ 114 Method: TCustomForm.Destroy 115 Params: None 116 Returns: Nothing 117 118 Destructor for the class. 119 ------------------------------------------------------------------------------} 120destructor TCustomForm.Destroy; 121var 122 HandlerType: TFormHandlerType; 123begin 124 //DebugLn('[TCustomForm.Destroy] A ',Name,':',ClassName); 125 if not (csDestroying in ComponentState) then 126 GlobalNameSpace.BeginWrite; 127 try 128 Application.RemoveAsyncCalls(Self); // because of Application.QueueAsyncCall(@Moved, 0); in WMMove 129 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomForm.Destroy'){$ENDIF}; 130 FreeThenNil(FIcon); 131 FreeIconHandles; 132 Screen.RemoveForm(Self); 133 FreeThenNil(FActionLists); 134 for HandlerType:=Low(FFormHandlers) to High(FFormHandlers) do 135 FreeThenNil(FFormHandlers[HandlerType]); 136 //DebugLn('[TCustomForm.Destroy] B ',Name,':',ClassName); 137 inherited Destroy; 138 //DebugLn('[TCustomForm.Destroy] END ',Name,':',ClassName); 139 finally 140 // BeginWrite has happen either in the BeforeDestrucion or here 141 GlobalNameSpace.EndWrite; 142 end; 143end; 144 145{------------------------------------------------------------------------------ 146 Method: TCustomForm.FocusControl 147 Params: None 148 Returns: Nothing 149 150 Focus the control. If needed, bring form to front and focus it. 151 If Form is not visible or disabled raise an exception. 152 ------------------------------------------------------------------------------} 153procedure TCustomForm.FocusControl(WinControl: TWinControl); 154var 155 WasActive: Boolean; 156begin 157 WasActive := FActive; 158 SetActiveControl(WinControl); 159 if (not WasActive) then 160 SetFocus; // if not CanFocus then this will raise an exception 161end; 162 163{------------------------------------------------------------------------------ 164 Method: TCustomForm.Notification 165 ------------------------------------------------------------------------------} 166procedure TCustomForm.Notification(AComponent: TComponent; 167 Operation: TOperation); 168begin 169 inherited Notification(AComponent,Operation); 170 171 case Operation of 172 opInsert: 173 begin 174 if AComponent is TCustomActionList then 175 begin 176 DoAddActionList(TCustomActionList(AComponent)); 177 end 178 else 179 if not (csLoading in ComponentState) and (Menu = nil) and 180 (AComponent.Owner=Self) and (AComponent is TMainMenu) then 181 Menu := TMainMenu(AComponent); 182 end; 183 opRemove: 184 begin 185 // first clean up references 186 if FActiveControl = AComponent then 187 begin 188 {$IFDEF VerboseFocus} 189 debugln('TCustomForm.Notification opRemove FActiveControl=',DbgSName(AComponent)); 190 {$ENDIF} 191 FActiveControl := nil; 192 end; 193 if AComponent = FActiveDefaultControl then 194 FActiveDefaultControl := nil; 195 if AComponent = FDefaultControl then 196 FDefaultControl := nil; 197 if AComponent = FCancelControl then 198 FCancelControl := nil; 199 if AComponent = FLastFocusedControl then 200 FLastFocusedControl := nil; 201 // then do stuff which can trigger things 202 if Assigned(FActionLists) and (AComponent is TCustomActionList) then 203 DoRemoveActionList(TCustomActionList(AComponent)) 204 else 205 if AComponent = Menu then 206 Menu := nil 207 else 208 if AComponent = PopupParent then 209 PopupParent := nil; 210 end; 211 end; 212 if FDesigner <> nil then 213 FDesigner.Notification(AComponent, Operation); 214end; 215 216{------------------------------------------------------------------------------ 217 Method: TCustomForm.IconChanged 218 ------------------------------------------------------------------------------} 219procedure TCustomForm.IconChanged(Sender: TObject); 220begin 221 if HandleAllocated then 222 begin 223 FreeIconHandles; 224 if BorderStyle <> bsDialog then 225 TWSCustomFormClass(WidgetSetClass).SetIcon(Self, SmallIconHandle, BigIconHandle) 226 else 227 TWSCustomFormClass(WidgetSetClass).SetIcon(Self, 0, 0); 228 end; 229end; 230 231procedure TCustomForm.SetCancelControl(NewControl: TControl); 232var 233 OldCancelControl: TControl; 234begin 235 if NewControl <> FCancelControl then 236 begin 237 OldCancelControl := FCancelControl; 238 FCancelControl := NewControl; 239 // notify old control 240 if Assigned(OldCancelControl) then 241 OldCancelControl.UpdateRolesForForm; 242 // notify new control 243 if Assigned(FCancelControl) then 244 begin 245 FreeNotification(FCancelControl); 246 FCancelControl.UpdateRolesForForm; 247 end; 248 end; 249end; 250 251procedure TCustomForm.SetDefaultControl(NewControl: TControl); 252var 253 OldDefaultControl: TControl; 254begin 255 if NewControl <> FDefaultControl then 256 begin 257 OldDefaultControl := FDefaultControl; 258 FDefaultControl := NewControl; 259 // notify old control 260 if Assigned(OldDefaultControl) then 261 OldDefaultControl.UpdateRolesForForm; 262 // notify new control 263 if Assigned(FDefaultControl) then 264 begin 265 FDefaultControl.FreeNotification(Self); 266 FDefaultControl.UpdateRolesForForm; 267 end; 268 // maybe active default control changed 269 if not Assigned(FActiveDefaultControl) then 270 begin 271 if Assigned(OldDefaultControl) then 272 OldDefaultControl.ActiveDefaultControlChanged(nil); 273 if Assigned(FDefaultControl) then 274 FDefaultControl.ActiveDefaultControlChanged(nil); 275 end; 276 end; 277end; 278 279{------------------------------------------------------------------------------ 280 Method: TCustomForm.SetIcon 281 Params: the new icon 282 ------------------------------------------------------------------------------} 283procedure TCustomForm.SetIcon(AValue: TIcon); 284begin 285 FIcon.Assign(AValue); 286end; 287 288procedure TCustomForm.SetPopupMode(const AValue: TPopupMode); 289begin 290 if FPopupMode <> AValue then 291 begin 292 FPopupMode := AValue; 293 if (FPopupMode in [pmAuto, pmNone]) and (PopupParent <> nil) then 294 PopupParent := nil 295 else 296 if not (csDesigning in ComponentState) and HandleAllocated then 297 TWSCustomFormClass(WidgetSetClass).SetRealPopupParent(Self, GetRealPopupParent); 298 end; 299end; 300 301procedure TCustomForm.SetPopupParent(const AValue: TCustomForm); 302begin 303 if FPopupParent <> AValue then 304 begin 305 if FPopupParent <> nil then 306 FPopupParent.RemoveFreeNotification(Self); 307 FPopupParent := AValue; 308 if FPopupParent <> nil then 309 begin 310 FPopupParent.FreeNotification(Self); 311 FPopupMode := pmExplicit; 312 end; 313 if not (csDesigning in ComponentState) and HandleAllocated then 314 TWSCustomFormClass(WidgetSetClass).SetRealPopupParent(Self, GetRealPopupParent); 315 end; 316end; 317 318{------------------------------------------------------------------------------ 319 Method: TCustomForm.BigIconHandle 320 Returns: HICON 321 ------------------------------------------------------------------------------} 322function TCustomForm.BigIconHandle: HICON; 323var 324 OldChange: TNotifyEvent; 325 OldCurrent: Integer; 326begin 327 if Assigned(FIcon) and not FIcon.Empty then 328 begin 329 if FBigIconHandle = 0 then 330 begin 331 OldChange := FIcon.OnChange; 332 OldCurrent := FIcon.Current; 333 FIcon.OnChange := nil; 334 FIcon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON))); 335 FBigIconHandle := FIcon.ReleaseHandle; 336 FIcon.Current := OldCurrent; 337 FIcon.OnChange := OldChange; 338 end; 339 Result := FBigIconHandle; 340 end 341 else 342 Result := Application.BigIconHandle; 343end; 344 345{------------------------------------------------------------------------------ 346 Method: TCustomForm.SmallIconHandle 347 Returns: HICON 348 ------------------------------------------------------------------------------} 349function TCustomForm.SmallIconHandle: HICON; 350var 351 OldChange: TNotifyEvent; 352 OldCurrent: Integer; 353begin 354 if Assigned(FIcon) and not FIcon.Empty then 355 begin 356 if FSmallIconHandle = 0 then 357 begin 358 OldChange := FIcon.OnChange; 359 OldCurrent := FIcon.Current; 360 FIcon.OnChange := nil; 361 FIcon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON))); 362 FSmallIconHandle := FIcon.ReleaseHandle; 363 FIcon.Current := OldCurrent; 364 FIcon.OnChange := OldChange; 365 end; 366 Result := FSmallIconHandle; 367 end 368 else 369 Result := Application.SmallIconHandle; 370end; 371 372{------------------------------------------------------------------------------ 373 Method: TCustomForm.SetFocus 374 ------------------------------------------------------------------------------} 375procedure TCustomForm.SetFocus; 376 377 procedure RaiseCannotFocus; 378 var 379 s: String; 380 begin 381 s:='[TCustomForm.SetFocus] '+Name+':'+ClassName+' '+rsCanNotFocus; 382 {$IFDEF VerboseFocus} 383 RaiseGDBException(s); 384 {$ELSE} 385 raise EInvalidOperation.Create(s); 386 {$ENDIF} 387 end; 388 389begin 390 {$IFDEF VerboseFocus} 391 DebugLn('TCustomForm.SetFocus ',Name,':',ClassName,' ActiveControl=',DbgSName(ActiveControl)); 392 {$ENDIF} 393 if not FActive then 394 begin 395 if not (IsControlVisible and Enabled) then 396 RaiseCannotFocus; 397 SetWindowFocus; 398 end; 399end; 400 401{------------------------------------------------------------------------------ 402 TCustomForm SetVisible 403------------------------------------------------------------------------------} 404procedure TCustomForm.SetVisible(Value : boolean); 405begin 406 if (Value=(fsVisible in FFormState)) and (Visible=Value) then exit; 407 //DebugLn(['[TCustomForm.SetVisible] START ',Name,':',ClassName,' Old=',Visible,' New=',Value,' ',(fsCreating in FFormState)]); 408 if Value then 409 Include(FFormState, fsVisible) 410 else 411 Exclude(FFormState, fsVisible); 412 //DebugLn(['TCustomForm.SetVisible ',Name,':',ClassName,' fsCreating=',fsCreating in FFormState]); 413 if (fsCreating in FFormState) {or FormUpdating} then 414 // will be done when finished loading 415 else 416 begin 417 inherited SetVisible(Value); 418 Application.UpdateVisible; 419 end; 420 //DebugLn(['[TCustomForm.SetVisible] END ',Name,':',ClassName,' ',Value,' ',(fsCreating in FFormState),' ',Visible]); 421end; 422 423procedure TCustomForm.AllAutoSized; 424begin 425 inherited AllAutoSized; 426 { If the the form is about to show, calculate its metrics } 427 if (not Showing) and Visible and ([csDestroying, csDesigning] * ComponentState = []) then 428 MoveToDefaultPosition; 429end; 430 431procedure TCustomForm.AutoScale; 432var 433 MonPPI: Integer; 434begin 435 if not Scaled then 436 begin 437 Scaled := True; // will execute AutoScale 438 Exit; 439 end; 440 MonPPI := Monitor.PixelsPerInch; 441 if Application.Scaled and (MonPPI > 0) and (MonPPI <> PixelsPerInch) then 442 AutoAdjustLayout(lapAutoAdjustForDPI, PixelsPerInch, MonPPI, 443 MulDiv(Width, MonPPI, PixelsPerInch), 444 MulDiv(Height, MonPPI, PixelsPerInch)); 445end; 446 447{------------------------------------------------------------------------------ 448 procedure TCustomForm.SetWindowFocus; 449 ------------------------------------------------------------------------------} 450procedure TCustomForm.SetWindowFocus; 451var 452 NewFocusControl: TWinControl; 453begin 454 if [csLoading,csDestroying]*ComponentState<>[] then exit; 455 if Assigned(FActiveControl) and not Assigned(FDesigner) then 456 NewFocusControl := ActiveControl 457 else 458 NewFocusControl := Self; 459 {$IFDEF VerboseFocus} 460 DebugLn('TCustomForm.SetWindowFocus ',Name,':',Classname , 461 ' NewFocusControl=',NewFocusControl.Name,':',NewFocusControl.ClassName, 462 ' HndAlloc=',dbgs(NewFocusControl.HandleAllocated)); 463 {$ENDIF} 464 if not NewFocusControl.HandleAllocated or 465 not NewFocusControl.CanFocus then 466 exit; 467 //DebugLn(['TCustomForm.SetWindowFocus ',DbgSName(Self),' NewFocusControl',DbgSName(NewFocusControl)]); 468 LCLIntf.SetFocus(NewFocusControl.Handle); 469 if GetFocus = NewFocusControl.Handle then 470 NewFocusControl.Perform(CM_UIACTIVATE, 0, 0); 471end; 472 473{------------------------------------------------------------------------------ 474 Method: TCustomForm.WMShowWindow 475 Params: Msg: The showwindow message 476 Returns: nothing 477 478 ShowWindow event handler. 479 ------------------------------------------------------------------------------} 480procedure TCustomForm.WMShowWindow(var message: TLMShowWindow); 481begin 482 {$IFDEF VerboseFocus} 483 Debugln(['TCustomForm.WMShowWindow A ',DbgSName(Self),' fsShowing=',fsShowing in FFormState,' Msg.Show=',Message.Show,' FActiveControl=',DbgSName(FActiveControl)]); 484 {$ENDIF} 485 if (fsShowing in FFormState) then exit; 486 Include(FFormState, fsShowing); 487 try 488 // only fire event if reason is not some other window hide/showing etc. 489 if Message.Status = 0 then 490 begin 491 if Message.Show then 492 DoShowWindow; 493 end; 494 finally 495 Exclude(FFormState, fsShowing); 496 end; 497end; 498 499{------------------------------------------------------------------------------ 500 Method: TCustomForm.WMActivate 501 Params: Msg: When the form is Activated 502 Returns: nothing 503 504 Activate event handler. 505 ------------------------------------------------------------------------------} 506procedure TCustomForm.WMActivate(var Message: TLMActivate); 507begin 508 {$IFDEF VerboseFocus} 509 DebugLn('TCustomForm.WMActivate A ',DbgSName(Self),' Msg.Active=',dbgs(Message.Active)); 510 {$ENDIF} 511 if (Parent = nil) and (ParentWindow = 0) and 512 (FormStyle <> fsMDIForm) or (csDesigning in ComponentState) then 513 SetActive(Message.Active <> WA_INACTIVE); 514 if Message.Active = WA_INACTIVE then 515 begin 516 if Assigned(Application) then 517 Application.Deactivate(0); 518 end 519 else 520 begin 521 if Assigned(Application) then 522 Application.Activate(0); 523 // The button reappears in some situations (e.g. when the window gets the 524 //"urgency" flag) so we hide it again here. 525 // This is the most important place to invoke UpdateShowInTaskBar, since 526 //invoking it anywhere else seeems basically useless/frequently reversed. 527 if (ShowInTaskBar = stNever) or 528 ( (ShowInTaskBar = stDefault) and 529 Assigned(Application) and (Application.TaskBarBehavior = tbSingleButton) 530 ) then 531 UpdateShowInTaskBar; 532 end; 533end; 534 535procedure TCustomForm.WMHelp(var Message: TLMHelp); 536var 537 Child: TWinControl; 538 Context: THelpContext; 539begin 540 if (csDesigning in ComponentState) or not Assigned(Message.HelpInfo) then 541 Exit; 542 543{ 544 WriteLn('context type = ', Message.HelpInfo^.iContextType); 545 WriteLn('control id = ', Message.HelpInfo^.iCtrlId); 546 WriteLn('item handle = ', Message.HelpInfo^.hItemHandle); 547 WriteLn('context id = ', Message.HelpInfo^.dwContextId); 548 WriteLn('MousePos = ', dbgs(Message.HelpInfo^.MousePos)); 549} 550 551 case Message.HelpInfo^.iContextType of 552 HELPINFO_WINDOW: 553 begin 554 Child := FindControl(Message.HelpInfo^.hItemHandle); 555 if Assigned(Child) then 556 Child.ShowHelp; 557 end; 558 HELPINFO_MENUITEM: 559 begin 560 if Assigned(Menu) then 561 begin 562 Context := Menu.GetHelpContext(Message.HelpInfo^.iCtrlId, True); 563 if Context = 0 then 564 Context := Menu.GetHelpContext(Message.HelpInfo^.hItemHandle, False); 565 if Context <> 0 then 566 Application.HelpContext(Context); 567 end; 568 end; 569 end; 570end; 571 572procedure TCustomForm.CMShowingChanged(var Message: TLMessage); 573begin 574 try 575 if Showing then 576 DoShow 577 else 578 DoHide; 579 except 580 if not HandleShowHideException then 581 raise; 582 end; 583 inherited CMShowingChanged(Message); 584end; 585 586procedure TCustomForm.DoShowWindow; 587begin 588 if (ActiveControl = nil) and (not (csDesigning in ComponentState)) and (Parent = nil) then 589 begin 590 // automatically choose a control to focus 591 {$IFDEF VerboseFocus} 592 DebugLn('TCustomForm.DoShowWindow ',DbgSName(Self),' Set ActiveControl := ',DbgSName(FindDefaultForActiveControl)); 593 {$ENDIF} 594 ActiveControl := FindDefaultForActiveControl; 595 end; 596end; 597 598{------------------------------------------------------------------------------ 599 Method: TCustomForm.Activate 600 Params: none 601 Returns: nothing 602 603 Activation form methode event handler. 604 ------------------------------------------------------------------------------} 605procedure TCustomForm.Activate; 606begin 607 if FIsFirstOnActivate and (WindowState in [wsMaximized, wsFullScreen]) then 608 Exit; 609 FIsFirstOnActivate := False; 610 if Assigned(FOnActivate) then FOnActivate(Self); 611end; 612 613{------------------------------------------------------------------------------ 614 procedure TCustomForm.ActiveChanged; 615 ------------------------------------------------------------------------------} 616procedure TCustomForm.ActiveChanged; 617begin 618 619end; 620 621procedure TCustomForm.AdjustClientRect(var Rect: TRect); 622begin 623 InflateRect(Rect, -BorderWidth, -BorderWidth); 624end; 625 626{------------------------------------------------------------------------------ 627 Method: TCustomForm.Deactivate 628 Params: none 629 Returns: nothing 630 631 Form deactivation (losing focus within application) event handler. 632 ------------------------------------------------------------------------------} 633procedure TCustomForm.Deactivate; 634begin 635 if Assigned(FOnDeactivate) then FOnDeactivate(Self); 636end; 637 638{------------------------------------------------------------------------------ 639 Method: TCustomForm.WMSize 640 Params: Msg: The Size message 641 Returns: nothing 642 643 Resize event handler. 644 ------------------------------------------------------------------------------} 645procedure TCustomForm.WMSize(var message: TLMSize); 646var 647 NewState: TWindowState; 648begin 649 {$IFDEF CHECK_POSITION} 650 DebugLn(['[TCustomForm.WMSize] ',DbgSName(Self),' Message.SizeType=',Message.SizeType,' Message.Width=',Message.Width,' Message.Height=',Message.Height,' AutoSizeDelayed=',AutoSizeDelayed]); 651 {$ENDIF} 652 653 if (Parent = nil) and ((Message.SizeType and SIZE_SourceIsInterface) > 0) then 654 begin 655 // this is a top level form (constraints depend on window manager) 656 // and the widgetset set a size 657 if (Message.Width <> Width) or (Message.Height <> Height) then 658 begin 659 // the window manager sets another size => disable autosize to prevent endless loop 660 Include(FFormState, fsDisableAutoSize); 661 end; 662 end; 663 664 inherited WMSize(Message); 665end; 666 667procedure TCustomForm.DoOnResize; 668begin 669 if not (csDestroying in ComponentState) then 670 begin 671 FDelayedOnResize := True; 672 Inc(FDelayedEventCtr); 673 Application.QueueAsyncCall(@DelayedEvent, 0); 674 end; 675end; 676 677procedure TCustomForm.DoOnChangeBounds; 678begin 679 if not (csDestroying in ComponentState) then 680 begin 681 FDelayedOnChangeBounds := True; 682 Inc(FDelayedEventCtr); 683 Application.QueueAsyncCall(@DelayedEvent, 0); 684 end; 685end; 686 687procedure TCustomForm.DelayedEvent(Data: PtrInt); 688begin 689 { discard duplicate calls, accept last call only } 690 Dec(FDelayedEventCtr); 691 if FDelayedEventCtr > 0 then 692 Exit; 693 { update restored bounds } 694 if WindowState = wsNormal then 695 begin 696 if FDelayedOnChangeBounds then 697 begin 698 FRestoredLeft := Left; 699 FRestoredTop := Top; 700 end; 701 if FDelayedOnResize then 702 begin 703 FRestoredWidth := Width; 704 FRestoredHeight := Height; 705 end; 706 end; 707 { call onShow() or onActivate() for the first time, 708 after first OnResize() and OnChangeBounds() } 709 if FDelayedOnResize and FDelayedOnChangeBounds then 710 begin 711 if FIsFirstOnShow then 712 begin 713 FIsFirstOnShow := False; 714 DoShow; 715 end; 716 if FIsFirstOnActivate then 717 begin 718 FIsFirstOnActivate := False; 719 if FActive then 720 Activate; 721 end; 722 end; 723 { delayed onResize() } 724 if FDelayedOnResize then 725 inherited DoOnResize; 726 { delayed onChangeBounds() } 727 if FDelayedOnResize or FDelayedOnChangeBounds then 728 inherited DoOnChangeBounds; 729 FDelayedOnChangeBounds := False; 730 FDelayedOnResize := False; 731end; 732 733procedure TCustomForm.WMWindowPosChanged(var Message: TLMWindowPosChanged); 734begin 735 if (Parent = nil) and Assigned(Message.WindowPos) and ((Message.WindowPos^.flags and SWP_SourceIsInterface)>0) then 736 begin 737 // this is a top level form (constraints depend on window manager) 738 // and the widgetset set a size 739 if (Message.WindowPos^.cx <> Width) or (Message.WindowPos^.cy <> Height) then 740 begin 741 // the window manager sets another size => disable autosize to prevent endless loop 742 Include(FFormState,fsDisableAutoSize); 743 end; 744 end; 745 746 inherited WMWindowPosChanged(Message); 747end; 748 749procedure TCustomForm.CMBiDiModeChanged(var Message: TLMessage); 750var 751 i: Integer; 752 lMessage: TLMessage; 753begin 754 inherited CMBiDiModeChanged(Message); 755 // send CM_PARENTBIDIMODECHANGED to all components owned by the form 756 // this is needed for menus 757 lMessage.msg := CM_PARENTBIDIMODECHANGED; 758 lMessage.wParam := 0; 759 lMessage.lParam := 0; 760 lMessage.Result := 0; 761 DisableAlign; 762 try 763 AdjustSize; 764 for i := 0 to ComponentCount - 1 do 765 begin 766 // all TControl descendants have this notification in TWinControl.CMBidiModeChanged 767 if Components[i] is TControl then 768 Continue; 769 Components[i].Dispatch(lMessage); 770 end; 771 finally 772 EnableAlign; 773 end; 774end; 775 776procedure TCustomForm.CMParentBiDiModeChanged(var Message: TLMessage); 777begin 778 if csLoading in ComponentState then 779 Exit; 780 781 if ParentBidiMode then 782 begin 783 if Parent <> nil then 784 BidiMode := Parent.BidiMode 785 else 786 BidiMode := Application.BidiMode; 787 ParentBidiMode := True; 788 end; 789end; 790 791procedure TCustomForm.CMAppShowBtnGlyphChanged(var Message: TLMessage); 792begin 793 NotifyControls(Message.msg); 794end; 795 796procedure TCustomForm.CMAppShowMenuGlyphChanged(var Message: TLMessage); 797var 798 i: integer; 799begin 800 for i := 0 to ComponentCount - 1 do 801 Components[i].Dispatch(Message); 802end; 803 804procedure TCustomForm.CMIconChanged(var Message: TLMessage); 805begin 806 IconChanged(Self); 807end; 808 809procedure TCustomForm.CMRelease(var Message: TLMessage); 810begin 811 Free; 812end; 813 814procedure TCustomForm.CMActivate(var Message: TLMessage); 815begin 816 if not(csDesigning in ComponentState) and (FormStyle=fsMDIChild) and Assigned(Menu) 817 and Assigned(Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) and Assigned(Application.MainForm.Menu) 818 then 819 Application.MainForm.Menu.Merge(Menu); 820 Activate; 821end; 822 823procedure TCustomForm.CMDeactivate(var Message: TLMessage); 824begin 825 Deactivate; 826 if not(csDesigning in ComponentState) and (FormStyle=fsMDIChild) and Assigned(Menu) 827 and Assigned(Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) and Assigned(Application.MainForm.Menu) 828 then 829 Application.MainForm.Menu.Unmerge(Menu); 830end; 831 832procedure TCustomForm.AddHandler(HandlerType: TFormHandlerType; 833 const Handler: TMethod; AsFirst: Boolean); 834begin 835 if Handler.Code=nil then RaiseGDBException('TCustomForm.AddHandler'); 836 if FFormHandlers[HandlerType]=nil then 837 FFormHandlers[HandlerType]:=TMethodList.Create; 838 FFormHandlers[HandlerType].Add(Handler,not AsFirst); 839end; 840 841procedure TCustomForm.RemoveHandler(HandlerType: TFormHandlerType; 842 const Handler: TMethod); 843begin 844 FFormHandlers[HandlerType].Remove(Handler); 845end; 846 847function TCustomForm.FindDefaultForActiveControl: TWinControl; 848begin 849 Result:=FindNextControl(nil, True, True, False) 850end; 851 852procedure TCustomForm.UpdateMenu; 853begin 854 if HandleAllocated and (FMenu <> nil) then 855 begin 856 // don't show a main menu for the dialog forms (delphi compatible) 857 if (BorderStyle <> bsDialog) or (csDesigning in ComponentState) then 858 FMenu.HandleNeeded 859 else 860 FMenu.DestroyHandle; 861 FMenu.WindowHandle := Handle; 862 end; 863end; 864 865function TCustomForm.GetEffectiveShowInTaskBar: TShowInTaskBar; 866begin 867 Result := ShowInTaskBar; 868 if (Result = stDefault) or (csDesigning in ComponentState) then 869 case Application.TaskBarBehavior of 870 tbSingleButton: Result := stNever; 871 tbMultiButton: Result := stAlways; 872 tbDefault: Result := stDefault; 873 end; 874end; 875 876procedure TCustomForm.UpdateShowInTaskBar; 877begin 878 if (Assigned(Application) and (Application.MainForm = Self)) or 879 (not HandleAllocated) or Assigned(Parent) or 880 (FormStyle = fsMDIChild) or not Showing then Exit; 881 TWSCustomFormClass(WidgetSetClass).SetShowInTaskbar(Self, GetEffectiveShowInTaskBar); 882end; 883 884class procedure TCustomForm.WSRegisterClass; 885begin 886 inherited WSRegisterClass; 887 RegisterCustomForm; 888end; 889 890{------------------------------------------------------------------------------ 891 Method: TCustomForm.DefocusControl 892 Params: Control: the control which is to be defocused 893 Removing: is it to be defocused because it is being removed 894 (destructed or changed parent). 895 Returns: nothing 896 897 Updates ActiveControl if it is to be defocused 898 ------------------------------------------------------------------------------} 899procedure TCustomForm.DefocusControl(Control: TWinControl; Removing: Boolean); 900begin 901 if Control.ContainsControl(ActiveControl) then 902 begin 903 {$IFDEF VerboseFocus} 904 debugln('TCustomForm.DefocusControl Control=',DbgSName(Control),' FActiveControl=',DbgSName(FActiveControl)); 905 {$ENDIF} 906 ActiveControl := nil; 907 end; 908end; 909 910{------------------------------------------------------------------------------ 911 Method: TCustomForm.DoCreate 912 Params: none 913 Returns: nothing 914 915 Calls user handler 916 ------------------------------------------------------------------------------} 917procedure TCustomForm.DoCreate; 918begin 919 try 920 LockRealizeBounds; 921 if Assigned(FOnCreate) then FOnCreate(Self); 922 FFormHandlers[fhtCreate].CallNotifyEvents(Self); 923 UnlockRealizeBounds; 924 except 925 if not HandleCreateException then 926 raise 927 end; 928end; 929 930{------------------------------------------------------------------------------ 931 Method: TCustomForm.DoClose 932 Params: none 933 Returns: nothing 934 935 Calls user handler 936 ------------------------------------------------------------------------------} 937procedure TCustomForm.DoClose(var CloseAction: TCloseAction); 938var 939 i: LongInt; 940begin 941 if Assigned(FOnClose) then FOnClose(Self, CloseAction); 942 i:=FFormHandlers[fhtClose].Count; 943 while FFormHandlers[fhtClose].NextDownIndex(i) do 944 TCloseEvent(FFormHandlers[fhtClose][i])(Self,CloseAction); 945 //DebugLn('TCustomForm.DoClose ',DbgSName(Self),' ',dbgs(ord(CloseAction))); 946end; 947 948{------------------------------------------------------------------------------ 949 Method: TCustomForm.DoDestroy 950 Params: none 951 Returns: nothing 952 953 Calls user handler 954 ------------------------------------------------------------------------------} 955procedure TCustomForm.DoDestroy; 956begin 957 try 958 if Assigned(FOnDestroy) then FOnDestroy(Self); 959 except 960 if not HandleDestroyException then 961 raise; 962 end; 963end; 964 965{------------------------------------------------------------------------------ 966 procedure TCustomForm.SetActive(AValue: Boolean); 967 ------------------------------------------------------------------------------} 968procedure TCustomForm.SetActive(AValue: Boolean); 969begin 970 FActive := AValue; 971 if FActive then 972 begin 973 if (ActiveControl = nil) and (not (csDesigning in ComponentState)) 974 and Application.MoveFormFocusToChildren then 975 ActiveControl := FindDefaultForActiveControl; 976 SetWindowFocus; 977 end; 978end; 979 980{------------------------------------------------------------------------------ 981 Method: TCustomForm.DoHide 982 Params: none 983 Returns: nothing 984 985 Calls user handler 986 ------------------------------------------------------------------------------} 987procedure TCustomForm.DoHide; 988begin 989 if Assigned(FOnHide) then FOnHide(Self); 990end; 991 992{------------------------------------------------------------------------------ 993 Method: TCustomForm.DoShow 994 Params: none 995 Returns: nothing 996 997 Calls user handler 998 ------------------------------------------------------------------------------} 999procedure TCustomForm.DoShow; 1000begin 1001 if FIsFirstOnShow and (WindowState in [wsMaximized, wsFullScreen]) then 1002 Exit; 1003 FIsFirstOnShow := False; 1004 if Assigned(FOnShow) then FOnShow(Self); 1005end; 1006 1007{------------------------------------------------------------------------------ 1008 procedure TCustomForm.EndFormUpdate; 1009 ------------------------------------------------------------------------------} 1010procedure TCustomForm.EndFormUpdate; 1011begin 1012 dec(FFormUpdateCount); 1013 if FFormUpdateCount = 0 then 1014 begin 1015 FormEndUpdated; 1016 Visible := (fsVisible in FFormState); 1017 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomForm.BeginFormUpdate'){$ENDIF}; 1018 end; 1019end; 1020 1021procedure TCustomForm.EnsureVisible(AMoveToTop: Boolean = True); 1022begin 1023 MakeFullyVisible(nil, True); 1024 if AMoveToTop then 1025 ShowOnTop 1026 else 1027 Visible := True; 1028end; 1029 1030{------------------------------------------------------------------------------ 1031 function TCustomForm.FormIsUpdating: boolean; 1032 ------------------------------------------------------------------------------} 1033function TCustomForm.FormIsUpdating: boolean; 1034begin 1035 Result:=FFormUpdateCount>0; 1036end; 1037 1038{------------------------------------------------------------------------------ 1039 Method: TCustomForm.GetChildren 1040 Params: Proc - see fcl/inc/writer.inc 1041 Root 1042 Returns: nothing 1043 1044 Adds component to children list which have no parent. 1045 (TWinControl only lists components with parents) 1046 ------------------------------------------------------------------------------} 1047procedure TCustomForm.GetChildren(Proc: TGetChildProc; Root: TComponent); 1048var 1049 I: Integer; 1050 OwnedComponent: TComponent; 1051begin 1052 inherited GetChildren(Proc, Root); 1053 if Root = Self then 1054 for I := 0 to ComponentCount - 1 do begin 1055 OwnedComponent := Components[I]; 1056 if OwnedComponent.HasParent = False 1057 then Proc(OwnedComponent); 1058 end; 1059end; 1060 1061function TCustomForm.HandleCreateException: Boolean; 1062begin 1063 Result := Application.CaptureExceptions; 1064 if Result then 1065 Application.HandleException(Self); 1066end; 1067 1068function TCustomForm.HandleDestroyException: Boolean; 1069begin 1070 Result := Application.CaptureExceptions; 1071 if Result then 1072 Application.HandleException(Self); 1073end; 1074 1075function TCustomForm.HandleShowHideException: Boolean; 1076begin 1077 Result := Application.CaptureExceptions; 1078 if Result then 1079 Application.HandleException(Self); 1080end; 1081 1082procedure TCustomForm.InitializeWnd; 1083begin 1084 if not (csDesigning in ComponentState) then 1085 begin 1086 // set alpha value 1087 TWSCustomFormClass(WidgetSetClass).SetAlphaBlend(Self, AlphaBlend, AlphaBlendValue); 1088 // set allow drop files 1089 TWSCustomFormClass(WidgetSetClass).SetAllowDropFiles(Self, FAllowDropFiles); 1090 end; 1091 inherited InitializeWnd; 1092end; 1093 1094{------------------------------------------------------------------------------ 1095 Method: TCustomForm.PaintWindow 1096 Params: none 1097 Returns: nothing 1098 1099 Calls user handler 1100 ------------------------------------------------------------------------------} 1101procedure TCustomForm.PaintWindow(dc: Hdc); 1102begin 1103 // Canvas.Lock; 1104 try 1105 Canvas.Handle := DC; 1106 //DebugLn('[TCustomForm.PaintWindow] ',ClassName,' DC=',DbgS(DC,8),' ',DbgS(FCanvas.Handle,8)); 1107 try 1108 Paint; 1109 if FDesigner <> nil then FDesigner.PaintGrid; 1110 finally 1111 Canvas.Handle := 0; 1112 end; 1113 finally 1114 // Canvas.Unlock; 1115 end; 1116end; 1117 1118 1119{------------------------------------------------------------------------------ 1120 Method: TCustomForm.RequestAlign 1121 Params: none 1122 Returns: nothing 1123 1124 Calls user handler 1125 ------------------------------------------------------------------------------} 1126procedure TCustomForm.RequestAlign; 1127Begin 1128 if Parent = nil then begin 1129 //Screen.AlignForm(Self); 1130 end 1131 else 1132 inherited RequestAlign; 1133end; 1134 1135procedure TCustomForm.Resizing(State: TWindowState); 1136var 1137 OldState: TWindowState; 1138begin 1139 if Showing and not (csDesigning in ComponentState) then 1140 begin 1141 OldState := FWindowState; 1142 FWindowState := State; 1143 if OldState <> State then 1144 begin 1145 if (State = wsMinimized) and (Application.MainForm = Self) and 1146 (WidgetSet.GetLCLCapability(lcNeedMininimizeAppWithMainForm) <> LCL_CAPABILITY_NO) then 1147 Application.Minimize; 1148 if (OldState = wsMinimized) and (Application.MainForm = Self) and 1149 (WidgetSet.GetLCLCapability(lcNeedMininimizeAppWithMainForm) <> LCL_CAPABILITY_NO) then 1150 Application.Restore; 1151 if Assigned(OnWindowStateChange) then 1152 OnWindowStateChange(Self); 1153 end; 1154 end; 1155end; 1156 1157procedure TCustomForm.CalculatePreferredSize(var PreferredWidth, 1158 PreferredHeight: integer; WithThemeSpace: Boolean); 1159var 1160 WorkArea: TRect; 1161begin 1162 inherited CalculatePreferredSize(PreferredWidth, PreferredHeight, 1163 WithThemeSpace); 1164 if (Parent = nil) and (Anchors * [akRight, akBottom] <> []) then 1165 begin 1166 // do size bigger than the monitor workarea 1167 WorkArea := Monitor.WorkareaRect; 1168 if akRight in Anchors then 1169 PreferredWidth := min(PreferredWidth, WorkArea.Right - WorkArea.Left); 1170 if akBottom in Anchors then 1171 PreferredHeight := min(PreferredHeight, WorkArea.Bottom - WorkArea.Top); 1172 end; 1173end; 1174 1175{------------------------------------------------------------------------------ 1176 procedure TCustomForm.SetZOrder(Topmost: Boolean); 1177------------------------------------------------------------------------------} 1178procedure TCustomForm.SetZOrder(Topmost: Boolean); 1179begin 1180 if Parent = nil then 1181 begin 1182 if TopMost and HandleAllocated then 1183 begin 1184 if (Screen.GetCurrentModalForm <> nil) and (Screen.GetCurrentModalForm <> Self) then 1185 Exit; 1186 //TODO: call TWSCustomFormClass(Widgetset).SetZORder. 1187 Screen.MoveFormToZFront(Self); 1188 SetForegroundWindow(Handle); 1189 end; 1190 end 1191 else 1192 inherited SetZOrder(Topmost); 1193end; 1194 1195procedure TCustomForm.SetParent(NewParent: TWinControl); 1196var 1197 ParentForm: TCustomForm; 1198begin 1199 if Parent = NewParent then exit; 1200 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomForm.SetParent'){$ENDIF}; 1201 try 1202 if HandleAllocated then DestroyHandle; 1203 inherited SetParent(NewParent); 1204 if (Parent = nil) and Visible then 1205 HandleNeeded; 1206 1207 if Parent <> nil then 1208 begin 1209 ParentForm := GetParentForm(Self); 1210 if Application.Scaled and (ParentForm<>nil) and ParentForm.Scaled 1211 and (ParentForm.PixelsPerInch<>PixelsPerInch) then 1212 AutoAdjustLayout(lapAutoAdjustForDPI, PixelsPerInch, ParentForm.PixelsPerInch, 0, 0); 1213 end; 1214 finally 1215 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomForm.SetParent'){$ENDIF}; 1216 end; 1217end; 1218 1219procedure TCustomForm.MoveToDefaultPosition; 1220var 1221 RealWidth, RealHeight: Integer; 1222 1223 procedure MoveToDefaultMonitor(var X, Y: Integer); 1224 var 1225 Source, Target: TMonitor; 1226 ABounds: TRect; 1227 begin 1228 // delphi compatibility: if no main form then DefaultMonitor has no effect 1229 if Application.MainForm = nil then Exit; 1230 // find the monitor of the center of the form (the boundaries might be on another monitor) 1231 Source := Screen.MonitorFromRect(Rect(X,Y,X+RealWidth,Y+RealHeight)); 1232 case DefaultMonitor of 1233 dmDesktop: 1234 Target := Source; // no need to move 1235 dmPrimary: 1236 Target := Screen.PrimaryMonitor; 1237 dmMainForm: 1238 Target := Application.MainForm.Monitor; 1239 dmActiveForm: 1240 if Screen.ActiveCustomForm <> nil then 1241 Target := Screen.ActiveCustomForm.Monitor 1242 else 1243 Target := Source; 1244 end; 1245 if Source = Target then Exit; // no move 1246 if Position in [poMainFormCenter, poOwnerFormCenter] then 1247 begin 1248 ABounds := Target.BoundsRect; 1249 // shift X and Y from Source to Target monitor 1250 X := (X - Source.Left) + ABounds.Left; 1251 Y := (Y - Source.Top) + ABounds.Top; 1252 // check that we are still in the desired monitor 1253 X:= Max(ABounds.Left, Min(ABounds.Right-RealWidth, X)); 1254 Y:= Max(ABounds.Top, Min(ABounds.Bottom-RealHeight, Y)); 1255 end 1256 else // poWorkAreaCenter, poScreenCenter 1257 begin 1258 if Position = poWorkAreaCenter then 1259 ABounds := Target.WorkareaRect 1260 else 1261 ABounds := Target.BoundsRect; 1262 X := (ABounds.Left + ABounds.Right - RealWidth) div 2; 1263 Y := (ABounds.Top + ABounds.Bottom - RealHeight) div 2; 1264 end; 1265 end; 1266 1267var 1268 X, Y: integer; 1269 p: TPosition; 1270 AForm: TCustomForm; 1271 RealRect, AFormRealRect: TRect; 1272 AFormRealWidth, AFormRealHeight: Integer; 1273begin 1274 if (Parent <> nil) or (ParentWindow <> 0) then exit; 1275 1276 if not (WindowState in [wsNormal,wsMinimized]) then exit; 1277 1278 // first make sure X and Y are assigned 1279 X := Left; 1280 Y := Top; 1281 if HandleAllocated and (GetWindowRect(Handle, RealRect) <> 0) then 1282 begin // success 1283 RealWidth := RealRect.Right-RealRect.Left; 1284 RealHeight := RealRect.Bottom-RealRect.Top; 1285 end else 1286 begin // error 1287 RealWidth := Width; 1288 RealHeight := Height; 1289 end; 1290 1291 p := Position; 1292 if (Position = poMainFormCenter) and (Application.Mainform=nil) then 1293 p := poScreenCenter; 1294 case P of 1295 poDesktopCenter: 1296 begin 1297 X := Screen.DesktopLeft + (Screen.DesktopWidth - RealWidth) div 2; 1298 Y := Screen.DesktopTop +(Screen.DesktopHeight - RealHeight) div 2; 1299 end; 1300 poScreenCenter: 1301 begin 1302 X := (Screen.Width - RealWidth) div 2; 1303 Y := (Screen.Height - RealHeight) div 2; 1304 end; 1305 poWorkAreaCenter: 1306 begin 1307 X := Screen.WorkAreaLeft + (Screen.WorkAreaWidth - RealWidth) div 2; 1308 Y := Screen.WorkAreaTop + (Screen.WorkAreaHeight - RealHeight) div 2; 1309 end; 1310 poMainFormCenter, 1311 poOwnerFormCenter: 1312 begin 1313 if (P = poOwnerFormCenter) and (Owner is TCustomForm) then 1314 AForm := TCustomForm(Owner) 1315 else 1316 AForm := Application.MainForm; 1317 if (Self <> AForm) and Assigned(AForm) then 1318 begin 1319 if FormStyle = fsMDIChild then 1320 begin 1321 X := (AForm.ClientWidth - RealWidth) div 2; 1322 Y := (AForm.ClientHeight - RealHeight) div 2; 1323 end else 1324 begin 1325 if AForm.HandleAllocated and (GetWindowRect(AForm.Handle, AFormRealRect) <> 0) then 1326 begin // success 1327 AFormRealWidth := AFormRealRect.Right-AFormRealRect.Left; 1328 AFormRealHeight := AFormRealRect.Bottom-AFormRealRect.Top; 1329 end else 1330 begin // error 1331 AFormRealWidth := AForm.Width; 1332 AFormRealHeight := AForm.Height; 1333 end; 1334 X := ((AFormRealWidth - RealWidth) div 2) + AForm.Left; 1335 Y := ((AFormRealHeight - RealHeight) div 2) + AForm.Top; 1336 end; 1337 end; 1338 // check that we are still in the viewarea 1339 X:= Max(Screen.WorkAreaLeft, Min((Screen.WorkAreaLeft+Screen.WorkAreaWidth)-RealWidth, X)); 1340 Y:= Max(Screen.WorkAreaTop, Min((Screen.WorkAreaTop+Screen.WorkAreaHeight)-RealHeight, Y)); 1341 end; 1342 end; 1343 // get current widgetset position 1344 if (p in [poDefault, poDefaultPosOnly]) and HandleAllocated then 1345 GetWindowRelativePosition(Handle,X,Y); 1346 if (Position in [poScreenCenter, poMainFormCenter, poOwnerFormCenter, poWorkAreaCenter]) then 1347 MoveToDefaultMonitor(X, Y); 1348 SetBounds(X, Y, Width, Height); 1349end; 1350 1351{------------------------------------------------------------------------------ 1352 procedure TCustomForm.VisibleChanging; 1353------------------------------------------------------------------------------} 1354procedure TCustomForm.VisibleChanging; 1355begin 1356 //if (FormStyle = fsMDIChild) and Visible then 1357 // raise EInvalidOperation.Create(SMDIChildNotVisible); 1358 inherited VisibleChanging; 1359end; 1360 1361procedure TCustomForm.VisibleChanged; 1362begin 1363 inherited VisibleChanged; 1364 if (Screen<>nil) then 1365 Screen.NotifyScreenFormHandler(snFormVisibleChanged,Self); 1366end; 1367 1368{------------------------------------------------------------------------------ 1369 TCustomForm WndProc 1370------------------------------------------------------------------------------} 1371procedure TCustomForm.WndProc(var TheMessage : TLMessage); 1372var 1373 NewActiveControl: TWinControl; 1374 NewFocus: HWND; 1375 MenuItem: TMenuItem; 1376begin 1377 //debugln(['TCustomForm.WndProc ',dbgsname(Self)]); 1378 with TheMessage do 1379 case Msg of 1380 LM_SETFOCUS: 1381 if not (csDesigning in ComponentState) then 1382 begin 1383 //DebugLn(['TCustomForm.WndProc ',DbgSName(Self),'Msg = LM_SETFOCUS FActiveControl=',DbgSName(FActiveControl)]); 1384 NewActiveControl := nil; 1385 NewFocus := 0; 1386 1387 if (ActiveControl = nil) and not (csDesigning in ComponentState) then 1388 begin 1389 // automatically choose a control to focus 1390 {$IFDEF VerboseFocus} 1391 DebugLn('TCustomForm.WndProc ',DbgSName(Self),' Set ActiveControl := ',DbgSName(FindDefaultForActiveControl)); 1392 {$ENDIF} 1393 NewActiveControl := FindDefaultForActiveControl; 1394 end 1395 else 1396 NewActiveControl := ActiveControl; 1397 1398 if FormStyle = fsMDIFORM then 1399 begin 1400 Exit; 1401 end 1402 else 1403 begin 1404 if (NewActiveControl <> nil) and (NewActiveControl <> Self) and 1405 NewActiveControl.IsVisible and NewActiveControl.Enabled and 1406 ([csLoading,csDestroying]*NewActiveControl.ComponentState=[]) and 1407 not NewActiveControl.ParentDestroyingHandle then 1408 begin 1409 // get or create handle of FActiveControl 1410 NewFocus := NewActiveControl.Handle; 1411 //debugln('TCustomForm.WndProc A ',DbgSName(Self),' FActiveControl=',DbgSName(FActiveControl),' FocusHandle=',dbgs(FocusHandle)); 1412 end; 1413 end; 1414 1415 TheMessage.Result := 0; 1416 if NewFocus <> 0 then 1417 begin 1418 // redirect focus to child 1419 {$IFDEF VerboseFocus} 1420 DebugLn('[TCustomForm.WndProc] ',Name,':',ClassName,' FActiveControl=',DbgSName(FActiveControl)); 1421 {$ENDIF} 1422 LCLIntf.SetFocus(NewFocus); 1423 Exit; 1424 end; 1425 end; 1426 CM_EXIT: 1427 begin 1428 if HostDockSite <> nil then DeActivate; 1429 end; 1430 CM_ENTER: 1431 begin 1432 if HostDockSite <> nil then Activate; 1433 end; 1434 LM_WINDOWPOSCHANGING: 1435 if (not (csDesigning in ComponentState)) and (fsFirstShow in FFormState) then 1436 begin 1437 if (Position in [poDefault, poDefaultPosOnly]) and (WindowState <> wsMaximized) then 1438 with PWindowPos(TheMessage.lParam)^ do 1439 flags := flags or SWP_NOMOVE; 1440 1441 if (Position in [poDefault, poDefaultSizeOnly]) and (BorderStyle in [bsSizeable, bsSizeToolWin]) then 1442 with PWindowPos(TheMessage.lParam)^ do 1443 flags := flags or SWP_NOSIZE; 1444 end; 1445 LM_DRAWITEM: 1446 with PDrawItemStruct(TheMessage.LParam)^ do 1447 begin 1448 if (CtlType = ODT_MENU) and Assigned(Menu) then 1449 begin 1450 MenuItem := Menu.FindItem(itemID, fkCommand); 1451 if Assigned(MenuItem) then 1452 Exit; 1453 end; 1454 end; 1455 end; 1456 inherited WndProc(TheMessage); 1457end; 1458 1459function TCustomForm.VisibleIsStored: boolean; 1460begin 1461 Result := Visible; 1462end; 1463 1464function TCustomForm.ColorIsStored: boolean; 1465begin 1466 Result := (Color <> {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif}); 1467end; 1468 1469procedure TCustomForm.GetPreferredSize(var PreferredWidth, 1470 PreferredHeight: integer; Raw: boolean; WithThemeSpace: boolean); 1471begin 1472 if (fsDisableAutoSize in FFormState) and not Raw then begin 1473 PreferredWidth:=Width; 1474 PreferredHeight:=Height; 1475 end else begin 1476 inherited GetPreferredSize(PreferredWidth, PreferredHeight, Raw, 1477 WithThemeSpace); 1478 end; 1479end; 1480 1481function TCustomForm.GetRealPopupParent: TCustomForm; 1482begin 1483 Result := nil; 1484 if (fsModal in FormState) or // always set WndParent of modal windows 1485 (PopupMode in [pmAuto, pmExplicit]) // set WndParent of non-modal windows only for pmAuto, pmExplicit 1486 then 1487 begin 1488 if (PopupMode = pmAuto) 1489 or ((PopupMode = pmNone) and (fsModal in FormState)) then 1490 begin 1491 Result := Screen.ActiveForm; 1492 if (Result<>nil) and (Result.FormStyle = fsSplash) then // ignore fsSplash 1493 Result := nil; 1494 end else 1495 if (PopupMode = pmExplicit) then 1496 Result := PopupParent; 1497 1498 if (Result = nil) or not Result.HandleAllocated then 1499 Result := Application.MainForm; 1500 end; 1501 if (Result <> nil) and not Result.HandleAllocated then 1502 Result := nil; 1503 if (Result = Self) then 1504 Result := nil; 1505end; 1506 1507procedure TCustomForm.DoAutoSize; 1508begin 1509 //DebugLn(['TCustomForm.DoAutoSize ',DbgSName(Self),' ',WindowState=wsNormal,' ',fsDisableAutoSize in FFormState,' ',dbgs(BoundsRect),' ',dbgs(ClientRect)]); 1510 inherited DoAutoSize; 1511end; 1512 1513procedure TCustomForm.SetAutoSize(Value: Boolean); 1514begin 1515 if Value = AutoSize then Exit; 1516 if Value then 1517 begin 1518 Exclude(FFormState, fsDisableAutoSize); 1519 if Position=poDefaultPosOnly then 1520 FPosition:=poDefault; 1521 end; 1522 inherited SetAutoSize(Value); 1523end; 1524 1525procedure TCustomForm.SetAutoScroll(Value: Boolean); 1526begin 1527 inherited SetAutoScroll(Value and (BorderStyle in BorderStylesAllowAutoScroll)); 1528end; 1529 1530procedure TCustomForm.DoAddActionList(List: TCustomActionList); 1531begin 1532 if FActionLists=nil then 1533 FActionLists:=TList.Create; 1534 if FActionLists.IndexOf(List)<0 then begin 1535 FActionLists.Add(List); 1536 List.FreeNotification(Self); 1537 end; 1538end; 1539 1540procedure TCustomForm.DoRemoveActionList(List: TCustomActionList); 1541begin 1542 if FActionLists<>nil then 1543 FActionLists.Remove(List); 1544end; 1545 1546procedure TCustomForm.BeginAutoDrag; 1547begin 1548 // allow form dragging only if it is docked into a site without DockManager 1549 if (HostDockSite <> nil) and not HostDockSite.UseDockManager then 1550 BeginDrag(False); 1551end; 1552 1553class function TCustomForm.GetControlClassDefaultSize: TSize; 1554begin 1555 Result.CX := 320; 1556 Result.CY := 240; 1557end; 1558 1559procedure TCustomForm.DoDock(NewDockSite: TWinControl; var ARect: TRect); 1560//Save or restore the borderstyle 1561begin 1562 if (NewDockSite <> HostDockSite) and ((NewDockSite = nil) or (HostDockSite=nil)) then 1563 begin 1564 if NewDockSite = nil then begin 1565 //Restore the form borderstyle 1566 BorderStyle := FOldBorderStyle; 1567 // Note: changing the Align property must be done by the dock manager, not by default 1568 end else begin 1569 //Save the borderstyle & set new bordertype 1570 FOldBorderStyle := BorderStyle; 1571 BorderStyle := bsNone; 1572 // Note: changing the Align property must be done by the dock manager, not by default 1573 end; 1574 end; 1575 inherited DoDock(NewDockSite, ARect); 1576end; 1577 1578function TCustomForm.GetFloating: Boolean; 1579begin 1580 Result := ((HostDockSite = nil) and (Parent=nil) 1581 and (FloatingDockSiteClass = ClassType)) 1582 or (inherited GetFloating); 1583end; 1584 1585function TCustomForm.GetDefaultDockCaption: String; 1586begin 1587 Result := Caption; 1588end; 1589 1590procedure TCustomForm.CMActionExecute(var Message: TLMessage); 1591begin 1592 if DoExecuteAction(TBasicAction(Message.LParam)) then 1593 Message.Result := 1; 1594end; 1595 1596procedure TCustomForm.CMActionUpdate(var Message: TLMessage); 1597begin 1598 if DoUpdateAction(TBasicAction(Message.LParam)) then 1599 Message.Result := 1; 1600end; 1601 1602function TCustomForm.DoExecuteAction(ExeAction: TBasicAction): boolean; 1603 function DoExecuteActionInChildControls(ParentControl: TWinControl; 1604 AnAction: TBasicAction) : boolean; 1605 var 1606 i: integer; 1607 ChildComponent: TComponent; 1608 begin 1609 Result := True; 1610 for i := 0 to ParentControl.ComponentCount - 1 do 1611 begin 1612 ChildComponent := ParentControl.Components[i]; 1613 if not (ChildComponent is TControl) or TControl(ChildComponent).Visible then 1614 begin 1615 if ChildComponent.ExecuteAction(AnAction) then Exit; 1616 if (ChildComponent is TWinControl) and 1617 DoExecuteActionInChildControls(TWinControl(ChildComponent), AnAction) then Exit; 1618 end; 1619 end; 1620 Result := False; 1621 end; 1622 1623begin 1624 // don't execute action while designing or when form is not visible 1625 if (csDesigning in ComponentState) or not Visible then 1626 Exit(False); 1627 1628 // assume it gets handled somewhere 1629 Result := True; 1630 if Assigned(ActiveControl) and ActiveControl.ExecuteAction(ExeAction) then Exit; 1631 1632 if ExecuteAction(ExeAction) then Exit; 1633 1634 if DoExecuteActionInChildControls(Self, ExeAction) then Exit; 1635 1636 // not handled anywhere, return false 1637 Result := False; 1638end; 1639 1640function TCustomForm.DoUpdateAction(TheAction: TBasicAction): boolean; 1641 1642 function ProcessUpdate(Component: TComponent): Boolean; 1643 begin 1644 Result := (Component <> nil) and 1645 Component.UpdateAction(TheAction); 1646 end; 1647 1648 function ComponentAllowed(Component: TComponent): Boolean; 1649 begin 1650 result := not (Component is TControl) or TControl(Component).Visible; 1651 end; 1652 1653 function TraverseClients(Container: TWinControl): Boolean; 1654 var 1655 I: Integer; 1656 Component: TComponent; 1657 begin 1658 if Container.Showing then 1659 for I := 0 to Container.ComponentCount - 1 do 1660 begin 1661 Component := Container.Components[I]; 1662 if ComponentAllowed(Component) and ProcessUpdate(Component) 1663 or (Component is TWinControl) and TraverseClients(TWinControl(Component)) 1664 then begin 1665 Result := True; 1666 exit; 1667 end; 1668 end; 1669 Result := False; 1670 end; 1671 1672begin 1673 Result := False; 1674 if (csDesigning in ComponentState) or not Showing then Exit; 1675 // Find a target for given Command (Message.LParam). 1676 if ProcessUpdate(ActiveControl) or 1677 ProcessUpdate(Self) or 1678 TraverseClients(Self) then 1679 Result := True; 1680end; 1681 1682procedure TCustomForm.UpdateActions; 1683 1684 procedure RecursiveInitiate(Container: TWinControl); 1685 var 1686 i: Integer; 1687 CurControl: TControl; 1688 begin 1689 if not Container.Showing or (csDesigning in Container.ComponentState) then exit; 1690 //DebugLn(['RecursiveInitiate ',DbgSName(Container)]); 1691 for i := 0 to Container.ControlCount - 1 do begin 1692 CurControl := Container.Controls[i]; 1693 if (csActionClient in CurControl.ControlStyle) 1694 and CurControl.Visible then 1695 CurControl.InitiateAction; 1696 if CurControl is TWinControl then 1697 RecursiveInitiate(TWinControl(CurControl)); 1698 end; 1699 end; 1700 1701var 1702 I: Integer; 1703begin 1704 if (csDesigning in ComponentState) or (not Showing) then exit; 1705 {$IFDEF DebugDisableAutoSizing}WriteAutoSizeReasons(true);{$ENDIF} 1706 // update this form 1707 InitiateAction; 1708 // update main menu's top-most items 1709 if Menu <> nil then 1710 for I := 0 to Menu.Items.Count - 1 do 1711 with Menu.Items[I] do begin 1712 //DebugLn(['TCustomForm.UpdateActions ',Name,' Visible=',Visible]); 1713 if Visible then InitiateAction; 1714 end; 1715 // update all controls 1716 RecursiveInitiate(Self); 1717end; 1718 1719{------------------------------------------------------------------------------ 1720 TCustomForm SetMenu 1721------------------------------------------------------------------------------} 1722procedure TCustomForm.SetMenu(Value: TMainMenu); 1723var 1724 I: Integer; 1725begin 1726 if FMenu = Value then Exit; 1727 1728 // check duplicate menus 1729 if Value <> nil then 1730 for I := 0 to Screen.FormCount - 1 do 1731 if (Screen.Forms[I].Menu = Value) and (Screen.Forms[I] <> Self) then 1732 raise EInvalidOperation.CreateFmt(sDuplicateMenus, [Value.Name]); 1733 1734 if (FMenu <> nil) and not (csDestroying in FMenu.ComponentState) then 1735 begin 1736 FMenu.DestroyHandle; 1737 FMenu.Parent := nil; 1738 end; 1739 1740 if (csDestroying in ComponentState) or 1741 ((Value <> nil) and (csDestroying in Value.ComponentState)) then 1742 Value := nil; 1743 1744 FMenu := Value; 1745 if FMenu <> nil then 1746 begin 1747 FMenu.FreeNotification(Self); 1748 FMenu.Parent := Self; 1749 UpdateMenu; 1750 end; 1751end; 1752 1753procedure TCustomForm.SetModalResult(Value: TModalResult); 1754begin 1755 if HandleAllocated and (Value <> FModalResult) then 1756 TWSCustomFormClass(WidgetSetClass).SetModalResult(Self, Value); 1757 FModalResult := Value; 1758end; 1759 1760{------------------------------------------------------------------------------ 1761 TCustomForm SetBorderIcons 1762------------------------------------------------------------------------------} 1763procedure TCustomForm.SetBorderIcons(NewIcons: TBorderIcons); 1764begin 1765 if FBorderIcons = NewIcons then exit; 1766 FBorderIcons := NewIcons; 1767 if HandleAllocated then 1768 TWSCustomFormClass(WidgetSetClass).SetBorderIcons(Self, NewIcons); 1769end; 1770 1771{------------------------------------------------------------------------------ 1772 TCustomForm SetFormBorderStyle 1773------------------------------------------------------------------------------} 1774procedure TCustomForm.SetFormBorderStyle(NewStyle: TFormBorderStyle); 1775var 1776 AdaptBorderIcons: boolean; 1777begin 1778 if FFormBorderStyle = NewStyle then exit; 1779 1780 // AutoScroll is only available for bsSizeable, bsSizeToolWin windows 1781 if not (NewStyle in BorderStylesAllowAutoScroll) then 1782 AutoScroll := False; 1783 1784 AdaptBorderIcons := not (csLoading in ComponentState) and 1785 (BorderIcons = DefaultBorderIcons[FFormBorderStyle]); 1786 FFormBorderStyle := NewStyle; 1787 1788 if not (csDesigning in ComponentState) then 1789 begin 1790 // if Form had default border icons before change, it should keep the default 1791 if AdaptBorderIcons then 1792 BorderIcons := DefaultBorderIcons[FFormBorderStyle]; 1793 1794 Include(FFormState, fsBorderStyleChanged); 1795 // ToDo: implement it. 1796 // We can not use inherited SetBorderStyle(NewStyle), 1797 // because TBorderStyle <> TFormBorderStyle; 1798 if HandleAllocated then 1799 begin 1800 TWSCustomFormClass(WidgetSetClass).SetFormBorderStyle(Self, NewStyle); 1801 Perform(CM_ICONCHANGED, 0, 0); 1802 UpdateMenu; 1803 end; 1804 end; 1805end; 1806 1807{------------------------------------------------------------------------------ 1808 TCustomForm UpdateWindowState 1809------------------------------------------------------------------------------} 1810procedure TCustomForm.UpdateWindowState; 1811Begin 1812 1813 //TODO: Finish UpdateWindowState 1814 //DebugLn('Trace:TODO: [TCustomForm.UpdateWindowState]'); 1815end; 1816 1817{------------------------------------------------------------------------------ 1818 TCustomForm SetWindowState 1819------------------------------------------------------------------------------} 1820procedure TCustomForm.SetWindowState(Value : TWindowState); 1821begin 1822 if FWindowState <> Value then 1823 begin 1824 FWindowState := Value; 1825 //DebugLn(['TCustomForm.SetWindowState ',DbgSName(Self),' ',ord(FWindowState),' csDesigning=',csDesigning in ComponentState,' Showing=',Showing]); 1826 if (not (csDesigning in ComponentState)) and Showing then 1827 ShowWindow(Handle, ShowCommands[Value]); 1828 end; 1829end; 1830 1831procedure TCustomForm.SetRestoredBounds(ALeft, ATop, AWidth, AHeight: integer; 1832 const ADefaultPosition: Boolean); 1833var 1834 prevWindowState: TWindowState; 1835begin 1836 // temporarily go to normal window state to store restored bounds 1837 if (FRestoredLeft=ALeft) and (FRestoredTop=ATop) 1838 and (FRestoredWidth=AWidth) and (FRestoredHeight=AHeight) then exit; 1839 prevWindowState := WindowState; 1840 WindowState := wsNormal; 1841 SetBounds(ALeft, ATop, AWidth, AHeight); 1842 // override 1843 if ADefaultPosition then 1844 MoveToDefaultPosition; 1845 WindowState := prevWindowState; 1846 FRestoredLeft := Left; 1847 FRestoredTop := Top; 1848 FRestoredWidth := Width; 1849 FRestoredHeight := Height; 1850end; 1851 1852procedure TCustomForm.SetScaled(const AScaled: Boolean); 1853var 1854 OldScaled: Boolean; 1855begin 1856 if Scaled=AScaled then 1857 Exit; 1858 1859 OldScaled := Scaled; 1860 inherited SetScaled(AScaled); 1861 if not OldScaled and Scaled 1862 and (ComponentState * [csDesigning, csLoading] = []) then // not in designtime and not when loading 1863 AutoScale; 1864end; 1865 1866{------------------------------------------------------------------------------ 1867 TCustomForm SetActiveControl 1868------------------------------------------------------------------------------} 1869procedure TCustomForm.SetActiveControl(AWinControl: TWinControl); 1870begin 1871 if FActiveControl = AWinControl then exit; 1872 if Assigned(AWinControl) and IsVisible then 1873 begin 1874 // this form can focus => do some sanity checks and raise an exception to 1875 // to help programmers to understand why a control is not focused 1876 if (AWinControl = Self) or 1877 (GetParentForm(AWinControl) <> Self) or 1878 not ((csLoading in ComponentState) or AWinControl.CanFocus) then 1879 begin 1880 DebugLn(['TCustomForm.SetActiveControl ',DbgSName(Self),' AWinControl=',DbgSName(AWinControl),' GetParentForm(AWinControl)=', 1881 DbgSName(GetParentForm(AWinControl)),'=Self=',GetParentForm(AWinControl) = Self, 1882 ' csLoading=',csLoading in ComponentState, 1883 ' AWinControl.CanFocus=',AWinControl.CanFocus, 1884 ' IsControlVisible=',AWinControl.IsControlVisible, 1885 ' Enabled=',AWinControl.Enabled]); 1886 while AWinControl<>nil do begin 1887 debugln([' ',DbgSName(AWinControl),' IsControlVisible=',AWinControl.IsControlVisible,' Enabled=',AWinControl.Enabled,' CanFocus=',AWinControl.CanFocus]); 1888 AWinControl:=AWinControl.Parent; 1889 end; 1890 {$IFDEF VerboseFocus} 1891 RaiseGDBException(SCannotFocus); 1892 {$ELSE} 1893 raise EInvalidOperation.Create(SCannotFocus); 1894 {$ENDIF} 1895 end; 1896 end; 1897 1898 {$IFDEF VerboseFocus} 1899 Debugln(['TCustomForm.SetActiveControl ',DbgSName(Self),' FActive=',DbgS(FActive),' OldActiveControl=',DbgSName(FActiveControl),' NewActiveControl=',DbgSName(AWinControl)]); 1900 {$ENDIF} 1901 FActiveControl := AWinControl; 1902 if (FActiveControl<>nil) and not (FActiveControl is TCustomForm) then 1903 FLastActiveControl := FActiveControl; 1904 if Assigned(FActiveControl) then FreeNotification(FActiveControl); 1905 if ([csLoading, csDestroying] * ComponentState = []) then 1906 begin 1907 if FActive then 1908 SetWindowFocus; 1909 ActiveChanged; 1910 end; 1911end; 1912 1913procedure TCustomForm.SetActiveDefaultControl(AControl: TControl); 1914var 1915 lPrevControl: TControl; 1916begin 1917 if AControl = FActiveDefaultControl then exit; 1918 lPrevControl := FActiveDefaultControl; 1919 FActiveDefaultControl := AControl; 1920 1921 if Assigned(FActiveDefaultControl) then 1922 FActiveDefaultControl.FreeNotification(Self); 1923 1924 // notify previous active default control that he has lost "default-ness" 1925 if Assigned(lPrevControl) then 1926 lPrevControl.ActiveDefaultControlChanged(AControl); 1927 // notify default control that it may become/lost active default again 1928 if Assigned(FDefaultControl) and (FDefaultControl <> lPrevControl) then 1929 FDefaultControl.ActiveDefaultControlChanged(AControl); 1930end; 1931 1932procedure TCustomForm.SetAllowDropFiles(const AValue: Boolean); 1933begin 1934 if AValue = FAllowDropFiles then Exit; 1935 FAllowDropFiles := AValue; 1936 1937 if HandleAllocated and not (csDesigning in ComponentState) then 1938 TWSCustomFormClass(WidgetSetClass).SetAllowDropFiles(Self, AValue); 1939end; 1940 1941procedure TCustomForm.SetAlphaBlend(const AValue: Boolean); 1942begin 1943 if FAlphaBlend = AValue then 1944 Exit; 1945 FAlphaBlend := AValue; 1946 if not (csDesigning in ComponentState) and HandleAllocated then 1947 TWSCustomFormClass(WidgetSetClass).SetAlphaBlend(Self, AlphaBlend, AlphaBlendValue); 1948end; 1949 1950procedure TCustomForm.SetAlphaBlendValue(const AValue: Byte); 1951begin 1952 if FAlphaBlendValue = AValue then 1953 Exit; 1954 FAlphaBlendValue := AValue; 1955 if not (csDesigning in ComponentState) and HandleAllocated then 1956 TWSCustomFormClass(WidgetSetClass).SetAlphaBlend(Self, AlphaBlend, AlphaBlendValue); 1957end; 1958 1959{------------------------------------------------------------------------------ 1960 TCustomForm SetFormStyle 1961------------------------------------------------------------------------------} 1962procedure TCustomForm.SetFormStyle(Value : TFormStyle); 1963var 1964 OldFormStyle: TFormStyle; 1965Begin 1966 if FFormStyle = Value then 1967 exit; 1968 OldFormStyle := FFormStyle; 1969 FFormStyle := Value; 1970 Include(FFormState, fsFormStyleChanged); 1971 1972 if FFormStyle = fsSplash then 1973 BorderStyle := bsNone 1974 else 1975 if OldFormStyle = fsSplash then 1976 BorderStyle := bsSizeable; 1977 if HandleAllocated then 1978 TWSCustomFormClass(WidgetSetClass).SetFormStyle(Self, Value, OldFormStyle); 1979end; 1980 1981{------------------------------------------------------------------------------ 1982 TCustomForm SetPosition 1983------------------------------------------------------------------------------} 1984procedure TCustomForm.SetPosition(Value: TPosition); 1985begin 1986 if Value <> FPosition then 1987 begin 1988 FPosition := Value; 1989 if Value = poDefaultPosOnly then AutoSize := False; 1990 UpdateControlState; 1991 1992 // we must update form TPosition if it's changed during runtime. 1993 if [csLoading, csDestroying, csDesigning] * ComponentState <> [] then Exit; 1994 1995 if HandleAllocated and Showing and 1996 not (fsShowing in FFormState) and 1997 not (fsFirstShow in FFormState) then 1998 MoveToDefaultPosition; 1999 end; 2000end; 2001 2002procedure TCustomForm.SetShowInTaskbar(Value: TShowInTaskbar); 2003begin 2004 if Value = FShowInTaskbar then exit; 2005 FShowInTaskbar := Value; 2006 UpdateShowInTaskBar; 2007end; 2008 2009procedure TCustomForm.SetLastFocusedControl(AControl: TWinControl); 2010begin 2011 if FLastFocusedControl = AControl then exit; 2012 FLastFocusedControl := AControl; 2013 if Assigned(FLastFocusedControl) then 2014 FLastFocusedControl.FreeNotification(Self); 2015end; 2016 2017{------------------------------------------------------------------------------ 2018 TCustomForm Constructor 2019------------------------------------------------------------------------------} 2020constructor TCustomForm.Create(AOwner: TComponent); 2021begin 2022 FDelayedEventCtr := 0; 2023 FDelayedOnChangeBounds := False; 2024 FDelayedOnResize := False; 2025 FIsFirstOnShow := True; 2026 FIsFirstOnActivate := True; 2027 GlobalNameSpace.BeginWrite; 2028 try 2029 CreateNew(AOwner, 1); // this calls BeginFormUpdate, which is ended in AfterConstruction 2030 if (ClassType <> TForm) and not (csDesigning in ComponentState) then 2031 begin 2032 Include(FFormState, fsCreating); 2033 try 2034 ProcessResource; 2035 finally 2036 Exclude(FFormState, fsCreating); 2037 end; 2038 end; 2039 finally 2040 GlobalNameSpace.EndWrite; 2041 end; 2042end; 2043 2044procedure TCustomForm.ProcessResource; 2045begin 2046 if not InitResourceComponent(Self, TForm) then 2047 if RequireDerivedFormResource then 2048 raise EResNotFound.CreateFmt( 2049 rsFormResourceSNotFoundForResourcelessFormsCreateNew, [ClassName]) 2050 else 2051 DebugLn(Format(rsFormResourceSNotFoundForResourcelessFormsCreateNew, [ClassName])); 2052end; 2053 2054{------------------------------------------------------------------------------ 2055 constructor TCustomForm.CreateNew(AOwner: TComponent; Num : Integer); 2056------------------------------------------------------------------------------} 2057constructor TCustomForm.CreateNew(AOwner: TComponent; Num: Integer = 0); 2058begin 2059 Include(FFormState,fsFirstShow); 2060 //DebugLn('[TCustomForm.CreateNew] Class=',Classname); 2061 BeginFormUpdate; 2062 FLastFocusedControl := Self; 2063 FBorderIcons := [biSystemMenu, biMinimize, biMaximize]; 2064 FDefaultMonitor := dmActiveForm; 2065 FPopupMode := pmNone; 2066 FShowInTaskbar := stDefault; 2067 FAlphaBlend := False; 2068 FAlphaBlendValue := 255; 2069 case Application.DoubleBuffered of 2070 adbDefault: FDoubleBuffered := TWSCustomFormClass(WidgetSetClass).GetDefaultDoubleBuffered; 2071 adbTrue: FDoubleBuffered := True; 2072 adbFalse: FDoubleBuffered := False; 2073 end; 2074 // set border style before handle is allocated 2075 if not (fsBorderStyleChanged in FFormState) then 2076 FFormBorderStyle:= bsSizeable; 2077 // set form style before handle is allocated 2078 if not (fsFormStyleChanged in FFormState) then 2079 FFormStyle:= fsNormal; 2080 2081 inherited Create(AOwner); 2082 Visible := False; 2083 fCompStyle:= csForm; 2084 2085 FMenu := nil; 2086 2087 ControlStyle := ControlStyle + [csAcceptsControls, csCaptureMouse, 2088 csClickEvents, csSetCaption, csDoubleClicks]; 2089 with GetControlClassDefaultSize do 2090 SetInitialBounds(0, 0, CX, CY); 2091 ParentColor := False; 2092 ParentFont := False; 2093 FWindowState := wsNormal; 2094 FIcon := TIcon.Create; 2095 FIcon.OnChange := @IconChanged; 2096 FKeyPreview := False; 2097 Color := {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif}; 2098 FloatingDockSiteClass := TWinControlClass(ClassType); 2099 Screen.AddForm(Self); 2100 FAllowDropFiles := False; 2101 2102 if ParentBiDiMode then 2103 BiDiMode := Application.BidiMode; 2104 2105 // Accessibility 2106 AccessibleDescription := 'A window'; 2107 AccessibleRole := larWindow; 2108 2109 // the EndFormUpdate is done in AfterConstruction 2110end; 2111 2112{------------------------------------------------------------------------------ 2113 TCustomForm CreateParams 2114------------------------------------------------------------------------------} 2115procedure TCustomForm.CreateParams(var Params : TCreateParams); 2116var 2117 APopupParent: TCustomForm; 2118begin 2119 inherited CreateParams(Params); 2120 with Params do 2121 begin 2122 if (Parent = nil) and (ParentWindow = 0) then 2123 begin 2124 // define Parent according to PopupMode and PopupParent 2125 if not (csDesigning in ComponentState) then 2126 begin 2127 if (Application.MainForm <> Self) then 2128 begin 2129 APopupParent := GetRealPopupParent; 2130 if APopupParent <> nil then 2131 WndParent := APopupParent.Handle; 2132 end; 2133 if (WndParent = 0) and 2134 (((Self = Application.MainForm) and Application.MainFormOnTaskBar) or (GetEffectiveShowInTaskBar = stAlways)) then 2135 ExStyle := ExStyle or WS_EX_APPWINDOW; 2136 end; 2137 Style := Style and not Cardinal(WS_GROUP or WS_TABSTOP or WS_CHILD); 2138 end; 2139 end; 2140end; 2141 2142 2143{------------------------------------------------------------------------------ 2144 TCustomForm Method Close 2145------------------------------------------------------------------------------} 2146procedure TCustomForm.Close; 2147var 2148 CloseAction: TCloseAction; 2149 IsMainForm: Boolean; 2150begin 2151 if fsModal in FFormState then 2152 ModalResult := mrCancel 2153 else 2154 begin 2155 if CloseQuery then 2156 begin 2157 // IsMainForm flag set if we are closing MainForm or its parent 2158 IsMainForm := (Application.MainForm = Self) or (Self.IsParentOf(Application.MainForm)); 2159 // Prepare default close action 2160 if FormStyle = fsMDIChild then 2161 begin 2162 CloseAction := caNone; 2163 // TODO: mdi logic 2164 end 2165 else 2166 begin 2167 if IsMainForm then 2168 CloseAction := caFree 2169 else 2170 CloseAction := caHide; 2171 end; 2172 // call event handler and let user modify CloseAction 2173 DoClose(CloseAction); 2174 // execute action according to close action 2175 case CloseAction of 2176 caHide: Hide; 2177 caMinimize: WindowState := wsMinimized; 2178 caFree: 2179 begin 2180 // if form is MainForm, then terminate the application 2181 // the owner of the MainForm is the application, 2182 // so the Application will take care of free-ing the form 2183 // and Release is not necessary 2184 if IsMainForm then 2185 Application.Terminate 2186 else 2187 Release; 2188 end; 2189 end; 2190 end; 2191 end; 2192end; 2193 2194{------------------------------------------------------------------------------ 2195 procedure TCustomForm.Release; 2196------------------------------------------------------------------------------} 2197procedure TCustomForm.Release; 2198begin 2199 if Application <> nil then 2200 Application.ReleaseComponent(Self) 2201 else 2202 Free; 2203end; 2204 2205function TCustomForm.CanFocus: Boolean; 2206begin 2207 if Parent = nil then 2208 Result := IsControlVisible and Enabled 2209 else 2210 Result := inherited CanFocus; 2211end; 2212 2213{------------------------------------------------------------------------------ 2214 TCustomForm Method CloseQuery 2215------------------------------------------------------------------------------} 2216function TCustomForm.CloseQuery: boolean; 2217 2218 function Check(AControl: TWinControl): boolean; 2219 var 2220 i: Integer; 2221 Child: TControl; 2222 begin 2223 for i:=0 to AControl.ControlCount-1 do begin 2224 Child:=AControl.Controls[i]; 2225 if Child is TWinControl then begin 2226 if Child is TCustomForm then begin 2227 if not TCustomForm(Child).CloseQuery then exit(false); 2228 end else begin 2229 if not Check(TWinControl(Child)) then exit(false); 2230 end; 2231 end; 2232 end; 2233 Result:=true; 2234 end; 2235 2236var 2237 I: Integer; 2238begin 2239 if FormStyle = fsMDIForm then 2240 begin 2241 // Query children forms whether we can close 2242 if not Check(Self) then exit(False); 2243 for I := 0 to MDIChildCount - 1 do 2244 if not MDIChildren[I].CloseQuery then Exit(False); 2245 end; 2246 Result := True; 2247 if Assigned(FOnCloseQuery) then 2248 FOnCloseQuery(Self, Result); 2249end; 2250 2251{------------------------------------------------------------------------------ 2252 TCustomForm Method WMCloseQuery 2253------------------------------------------------------------------------------} 2254procedure TCustomForm.WMCloseQuery(var message: TLMessage); 2255begin 2256 Close; 2257 // Always return 0, because we destroy the window ourselves 2258 Message.Result:= 0; 2259end; 2260 2261procedure TCustomForm.WMDPIChanged(var Msg: TLMessage); 2262var 2263 NewDpi, I, L: integer; 2264begin 2265 if Parent=nil then 2266 begin 2267 NewDpi := hi(Cardinal(Msg.wParam)); 2268 if Application.Scaled and Scaled and (NewDpi<>PixelsPerInch) then 2269 begin 2270 { Problem (Windows): if the form is shown the first time on a secondary monitor 2271 with a different DPI settings, the WM_DPICHANGED message is sent within 2272 UpdateBounds when BoundsLockCount>0 which means the bounds are not scaled. 2273 We force to update the bounds. See issue 32162. 2274 (A better solution is welcome.) 2275 } 2276 I := -1; 2277 while BoundsLockCount>0 do 2278 begin 2279 EndUpdateBounds; 2280 Inc(I); 2281 end; 2282 try 2283 AutoAdjustLayout(lapAutoAdjustForDPI, PixelsPerInch, NewDpi, 2284 Width, MulDiv(Width, NewDpi, PixelsPerInch)); 2285 finally 2286 for L := 0 to I do 2287 BeginUpdateBounds; 2288 end; 2289 end; 2290 end; 2291end; 2292 2293{------------------------------------------------------------------------------ 2294 TCustomForm Method Hide 2295------------------------------------------------------------------------------} 2296procedure TCustomForm.Hide; 2297begin 2298 Visible := False; 2299end; 2300 2301{------------------------------------------------------------------------------ 2302 procedure TCustomForm.Show; 2303------------------------------------------------------------------------------} 2304procedure TCustomForm.Show; 2305var 2306 MonPPI: Integer; 2307begin 2308 MonPPI := Monitor.PixelsPerInch; 2309 if Application.Scaled and Scaled and (MonPPI > 0) and (MonPPI <> PixelsPerInch) then 2310 AutoAdjustLayout(lapAutoAdjustForDPI, PixelsPerInch, MonPPI, 2311 Width, MulDiv(Width, MonPPI, PixelsPerInch)); 2312 2313 Visible := True; 2314 { wxMaximized secondary forms are not being shown maximized } 2315 if (not (csDesigning in ComponentState)) and Showing then 2316 ShowWindow(Handle, ShowCommands[WindowState]); 2317 BringToFront; 2318end; 2319 2320{------------------------------------------------------------------------------ 2321 procedure TCustomForm.ShowOnTop; 2322------------------------------------------------------------------------------} 2323procedure TCustomForm.ShowOnTop; 2324begin 2325 if WindowState = wsMinimized then 2326 WindowState := wsNormal; 2327 Visible := True; 2328 BringToFront; 2329 //DebugLn(['TCustomForm.ShowOnTop ',Name,':',ClassName,' ',Visible,' ',HandleAllocated,' ',csDesigning in ComponentState]); 2330end; 2331 2332{------------------------------------------------------------------------------ 2333 TCustomForm AutoSizeDelayedHandle 2334 2335 Returns true if AutoSize should be skipped / delayed because of its handle. 2336------------------------------------------------------------------------------} 2337function TCustomForm.AutoSizeDelayedHandle: Boolean; 2338begin 2339 if (Parent<>nil) or (ParentWindow<>0) then 2340 // this form is inlined / embedded it works like a normal TWinControl 2341 Result:=inherited AutoSizeDelayedHandle 2342 else 2343 // this form is on a screen => no delay 2344 Result:=false; 2345end; 2346 2347{------------------------------------------------------------------------------} 2348{ Method: TCustomForm.IsAutoScrollStored } 2349{ Returns: if form AutoScroll should be stored in the stream } 2350{------------------------------------------------------------------------------} 2351function TCustomForm.IsAutoScrollStored: Boolean; 2352begin 2353 // store autoscroll only if BorderStyle allows this 2354 Result := IsForm and (BorderStyle in BorderStylesAllowAutoScroll); 2355end; 2356 2357{------------------------------------------------------------------------------} 2358{ Method: TCustomForm.IsForm } 2359{ Returns: if form properties should be stored in the stream } 2360{------------------------------------------------------------------------------} 2361function TCustomForm.IsForm: Boolean; 2362begin 2363 Result := True; 2364end; 2365 2366{------------------------------------------------------------------------------} 2367{ Method: TCustomForm.IsIconStored } 2368{ Returns: if form icon should be stored in the stream } 2369{------------------------------------------------------------------------------} 2370function TCustomForm.IsIconStored: Boolean; 2371begin 2372 Result := IsForm and (Icon <> nil); 2373end; 2374 2375function TCustomForm.GetMonitor: TMonitor; 2376var 2377 ParentForm: TCustomForm; 2378begin 2379 if Assigned(Parent) then 2380 begin 2381 ParentForm := GetParentForm(Self); 2382 if Assigned(ParentForm) then 2383 Result := ParentForm.Monitor 2384 else 2385 Result := nil; 2386 end else 2387 begin 2388 if HandleAllocated then begin 2389 // ensure widgetset has latest coordinates // invisible forms are not updated by DoSendBoundsToInterface 2390 if (not HandleObjectShouldBeVisible) then 2391 TWSWinControlClass(WidgetSetClass).SetBounds(Self, Left, Top, Width, Height); 2392 Result := Screen.MonitorFromWindow(Handle, mdNearest); 2393 end 2394 else 2395 Result := Screen.MonitorFromPoint(point(Left,Top)); 2396 end; 2397end; 2398 2399{------------------------------------------------------------------------------ 2400 TCustomForm Method SetFocusedControl 2401 2402 Switch focus. 2403------------------------------------------------------------------------------} 2404function TCustomForm.SetFocusedControl(Control: TWinControl): Boolean; 2405 2406 function SendEnterExitLoop: Boolean; 2407 2408 function NextChildControl(CurParent, Target: TWinControl): TWinControl; inline; 2409 begin 2410 while (Target <> nil) and (Target.Parent <> CurParent) do 2411 Target := Target.Parent; 2412 Result := Target; 2413 end; 2414 2415 var 2416 LastState: TFocusState; 2417 Tmp: TWinControl; 2418 begin 2419 // send cm_exit, cm_enter messages 2420 // cm_exit must be sent to all controls from lastfocusedcontrol to the first parent which contains control 2421 // cm_enter must be sent from the control we stoped up to control 2422 // if during this loop something happens with focus (another control or form has aquired it) we need to stop it 2423 2424 if (FLastFocusedControl<>nil) and (not ContainsControl(FLastFocusedControl)) then 2425 FLastFocusedControl:=nil; // e.g. FLastFocusedControl was removed from this form 2426 if FLastFocusedControl=nil then 2427 FLastFocusedControl:=Self; 2428 2429 {$IFDEF VerboseFocus} 2430 debugln(['Sending CM_EXIT,CM_ENTER Form=',Self,' from FLastFocusedControl=',FLastFocusedControl,' to ',Control,' ...']); 2431 {$ENDIF} 2432 while not FLastFocusedControl.ContainsControl(Control) do 2433 begin 2434 LastState := SaveFocusState; 2435 if FLastFocusedControl = nil then Exit(False); 2436 // calling of CM_EXIT can cause other focus changes - so FLastFocusedControl can change after the call 2437 // therefore we need to change it before the call 2438 Tmp := FLastFocusedControl; 2439 if Assigned(Tmp.Parent) and 2440 ((csDestroying in Tmp.Parent.ComponentState) or 2441 (csDestroyingHandle in Tmp.Parent.ControlState)) then 2442 Exit(False); 2443 SetLastFocusedControl(Tmp.Parent); 2444 Tmp.Perform(CM_EXIT, 0, 0); 2445 if SaveFocusState <> LastState then 2446 begin 2447 {$IFDEF VerboseFocus} 2448 debugln(['SendEnterExitLoop Form=',Self,' Control=',Control,' sending CM_EXIT to ',Tmp,' changed focus => FAILED']); 2449 {$ENDIF} 2450 Exit(False); 2451 end; 2452 if FLastFocusedControl=nil then begin 2453 {$IFDEF VerboseFocus} 2454 debugln(['SendEnterExitLoop Form=',Self,' Control=',Control,' sending CM_EXIT to ',Tmp,' FAILED because path missing from last to control']); 2455 {$ENDIF} 2456 exit(false); 2457 end; 2458 end; 2459 2460 while FLastFocusedControl <> Control do 2461 begin 2462 SetLastFocusedControl(NextChildControl(FLastFocusedControl, Control)); 2463 if FLastFocusedControl = nil then Exit(False); 2464 LastState := SaveFocusState; 2465 FLastFocusedControl.Perform(CM_ENTER, 0, 0); 2466 if SaveFocusState <> LastState then 2467 begin 2468 {$IFDEF VerboseFocus} 2469 debugln(['SendEnterExitLoop Form=',Self,' Control=',Control,' sending CM_ENTER to ',Tmp,' changed focus => FAILED']); 2470 {$ENDIF} 2471 Exit(False); 2472 end; 2473 end; 2474 Result := True; 2475 end; 2476 2477var 2478 ParentForm: TCustomForm; 2479begin 2480 LastFocusedControl := Control; 2481 Result := False; 2482 if (Control <> nil) and (csDestroying in Control.ComponentState) then Exit; 2483 if (csDestroying in ComponentState) or (csDestroyingHandle in ControlState) then 2484 exit; 2485 2486 if (Parent <> nil) then 2487 begin 2488 // delegate to topmost form 2489 ParentForm := GetParentForm(Self); 2490 if ParentForm <> nil then 2491 Result := ParentForm.SetFocusedControl(Control); 2492 Exit; 2493 end; 2494 2495 // update FActiveControl 2496 if ([csLoading, csDesigning] * ComponentState = []) then 2497 begin 2498 if Control <> Self then 2499 begin 2500 if FActiveControl<>Control then 2501 begin 2502 {$IFDEF VerboseFocus} 2503 debugln(['TCustomForm.SetFocusedControl ',DbgSName(Self),' OldActiveControl=',DbgSName(FActiveControl),' New=',DbgSName(Control)]); 2504 {$ENDIF} 2505 FActiveControl := Control; 2506 if (FActiveControl<>nil) and not (FActiveControl is TCustomForm) then 2507 FLastActiveControl := FActiveControl; 2508 if Assigned(FActiveControl) then 2509 FreeNotification(FActiveControl); 2510 end; 2511 end 2512 else 2513 begin 2514 {$IFDEF VerboseFocus} 2515 if Assigned(FActiveControl) then 2516 debugln(['TCustomForm.SetFocusedControl ',DbgSName(Self),' OldActiveControl=',DbgSName(FActiveControl),' New=',DbgSName(Control)]); 2517 {$ENDIF} 2518 FActiveControl := nil; 2519 end; 2520 end; 2521 2522 // update Screen object 2523 Screen.FActiveControl := Control; 2524 if Control <> nil then 2525 begin 2526 Screen.FActiveCustomForm := Self; 2527 Screen.MoveFormToFocusFront(Self); 2528 if Self is TForm then 2529 Screen.FActiveForm := TForm(Self) 2530 else 2531 Screen.FActiveForm := nil; 2532 end; 2533 Screen.UpdateLastActive; 2534 2535 {$IFDEF VerboseFocus} 2536 DbgOut('TCustomForm.SetFocusedControl Self=',DbgSName(Self)); 2537 if Control<>nil then 2538 DbgOut([' Control=',Control,' Control.HandleAllocated=',Control.HandleAllocated,' csFocusing=',(csFocusing in Control.ControlState)]); 2539 DebugLn(); 2540 {$ENDIF} 2541 2542 if (Control <> nil) and (not (csFocusing in Control.ControlState)) then 2543 begin 2544 Control.ControlState := Control.ControlState + [csFocusing]; 2545 try 2546 if not Screen.SetFocusedForm(Self) then 2547 begin 2548 {$IFDEF VerboseFocus} 2549 debugln(['TCustomForm.SetFocusedControl Form=',DbgSName(Self),' Control=',DbgSName(Control),' Screen.SetFocusedForm FAILED']); 2550 {$ENDIF} 2551 Exit; 2552 end; 2553 Result := SendEnterExitLoop; 2554 finally 2555 Control.ControlState := Control.ControlState - [csFocusing]; 2556 end; 2557 end; 2558end; 2559 2560{------------------------------------------------------------------------------ 2561 TCustomForm Method WantChildKey 2562------------------------------------------------------------------------------} 2563function TCustomForm.WantChildKey(Child : TControl; var Message : TLMessage):Boolean; 2564begin 2565 Result := False; 2566end; 2567 2568function TCustomForm.IsShortcut(var Message: TLMKey): boolean; 2569var 2570 I: integer; 2571begin 2572 Result := false; 2573 if Assigned(FOnShortcut) then 2574 begin 2575 FOnShortcut(Message, Result); 2576 if Result then exit; 2577 end; 2578 if Assigned(FMenu) then 2579 begin 2580 Result := FMenu.IsShortCut(Message); 2581 if Result then exit; 2582 end; 2583 if Assigned(FActionLists) then 2584 begin 2585 for I := 0 to FActionLists.Count - 1 do 2586 begin 2587 Result := TCustomActionList(FActionLists.Items[I]).IsShortCut(Message); 2588 if Result then exit; 2589 end; 2590 end; 2591end; 2592 2593procedure TCustomForm.MakeFullyVisible(AMonitor: TMonitor; UseWorkarea: Boolean = False); 2594var 2595 newLeft, newTop, WindowWidth, WindowHeight: Integer; 2596 ABounds: TRect; 2597 Mon: TMonitor; 2598begin 2599 newLeft := Left; 2600 newTop := Top; 2601 2602 // window rect is not the same as bounds rect. window rect contains titlebar 2603 if GetWindowRect(Handle, ABounds) = 0 then 2604 ABounds := BoundsRect; 2605 with ABounds do 2606 begin 2607 WindowWidth := Right - Left; 2608 WindowHeight := Bottom - Top; 2609 end; 2610 2611 // reduce calls to GetMonitor 2612 if AMonitor <> nil then 2613 Mon := AMonitor 2614 else 2615 Mon := Monitor; 2616 2617 if Mon <> nil then 2618 if UseWorkArea then 2619 ABounds := Mon.WorkareaRect 2620 else 2621 ABounds := Mon.BoundsRect 2622 else 2623 ABounds := Bounds(0, 0, Screen.Width, Screen.Height); 2624 2625 if newLeft + WindowWidth > ABounds.Right then 2626 newLeft := ABounds.Right - WindowWidth; 2627 if newLeft < ABounds.Left then 2628 newLeft := ABounds.Left; 2629 if newTop + WindowHeight > ABounds.Bottom then 2630 newTop := ABounds.Bottom - WindowHeight; 2631 if newTop < ABounds.Top then 2632 newTop := ABounds.Top; 2633 SetBounds(newLeft, newTop, Width, Height); 2634end; 2635 2636{------------------------------------------------------------------------------ 2637 Method: TCustomForm.IntfDropFiles 2638 Params: FileNames - Dropped files 2639 2640 Invokes OnDropFilesEvent of the form. 2641 This function is called by the interface. 2642 ------------------------------------------------------------------------------} 2643procedure TCustomForm.IntfDropFiles(const FileNames: array of String); 2644begin 2645 //debugln(['TCustomForm.IntfDropFiles ',DbgSName(Self)]); 2646 if Assigned(FOnDropFiles) then FOnDropFiles(Self, FileNames); 2647end; 2648 2649{------------------------------------------------------------------------------ 2650 procedure TCustomForm.IntfHelp(AComponent: TComponent); 2651 2652 Show help for control or menu item. 2653 This function is called by the interface. 2654------------------------------------------------------------------------------} 2655procedure TCustomForm.IntfHelp(AComponent: TComponent); 2656begin 2657 if csDesigning in ComponentState then exit; 2658 2659 if AComponent is TControl then begin 2660 TControl(AComponent).ShowHelp; 2661 end else begin 2662 DebugLn('TCustomForm.IntfHelp TODO help for ',DbgSName(AComponent)); 2663 end; 2664end; 2665 2666function TCustomForm.GetFormImage: TBitmap; 2667var 2668 ARect: TRect; 2669begin 2670 Result := TBitmap.Create; 2671 try 2672 Result.SetSize(ClientWidth, ClientHeight); 2673 LCLIntf.GetWindowRect(Handle, ARect); 2674 with GetClientOrigin do 2675 PaintTo(Result.Canvas, ARect.Left - X, ARect.Top - Y); 2676 except 2677 Result.Free; 2678 raise; 2679 end; 2680end; 2681 2682procedure TCustomForm.CreateWnd; 2683// Creates the interface object. 2684begin 2685 //DebugLn('TCustomForm.CreateWnd START ',ClassName); 2686 FFormState := FFormState - [fsBorderStyleChanged, fsFormStyleChanged]; 2687 inherited CreateWnd; 2688 2689 //DebugLn('Trace:[TCustomForm.CreateWnd] FMenu.HandleNeeded'); 2690 UpdateMenu; 2691 2692 // update icon 2693 Perform(CM_ICONCHANGED, 0, 0); 2694 //DebugLn('TCustomForm.CreateWnd END ',ClassName); 2695end; 2696 2697procedure TCustomForm.DestroyWnd; 2698begin 2699 if Assigned(FMenu) then 2700 FMenu.DestroyHandle; 2701 inherited DestroyWnd; 2702end; 2703 2704procedure TCustomForm.Loaded; 2705var 2706 Control: TWinControl; 2707begin 2708 {$IF defined(CHECK_POSITION) or defined(VerboseFormUpdateShowing) or defined(VerboseShowing)} 2709 debugln(['[TCustomForm.Loaded] START ',DbgSName(Self),' Pos=',Left,',',Top,' Visible=',Visible,' Showing=',Showing]); 2710 {$ENDIF} 2711 DisableAlign; 2712 try 2713 if Application.Scaled and Scaled then 2714 FixDesignFontsPPIWithChildren(FDesignTimePPI); 2715 inherited Loaded; 2716 finally 2717 EnableAlign; 2718 end; 2719 if (ActiveControl <> nil) and (Parent = nil) then 2720 begin 2721 // check if loaded ActiveControl can be focused 2722 // and if yes, call SetActiveControl to invoke handlers 2723 Control := ActiveControl; 2724 {$IFDEF VerboseFocus} 2725 if FActiveControl<>nil then 2726 Debugln('TCustomForm.Loaded Self=',DbgSName(Self),' FActiveControl=',DbgSName(FActiveControl)); 2727 {$ENDIF} 2728 FActiveControl := nil; 2729 if Control.CanFocus then SetActiveControl(Control); 2730 end; 2731 //DebugLn('TCustomForm.Loaded ',Name,':',ClassName,' ',FormUpdating,' ',fsCreating in FFormState,' ',Visible,' ',fsVisible in FormState); 2732 if fsVisible in FormState then 2733 Visible := True; 2734end; 2735 2736procedure TCustomForm.ChildHandlesCreated; 2737// Called after all children handles are created. 2738begin 2739 inherited ChildHandlesCreated; 2740 if Parent=nil then 2741 ParentFormHandleInitialized; 2742end; 2743 2744procedure TCustomForm.BeginFormUpdate; 2745begin 2746 inc(FFormUpdateCount); 2747 if FFormUpdateCount=1 then 2748 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomForm.BeginFormUpdate'){$ENDIF}; 2749end; 2750 2751procedure TCustomForm.UpdateShowing; 2752// Here the initial form left and top are determined. 2753begin 2754 if csLoading in ComponentState then exit; 2755 {$IF defined(CHECK_POSITION) or defined(VerboseFormUpdateShowing) or defined(VerboseShowing)} 2756 DebugLn(['[TCustomForm.UpdateShowing] START ',DbgSName(Self),' Pos=',Left,',',Top,' Visible=',Visible,' Showing=',Showing]); 2757 {$ENDIF} 2758 // If the form is about to show, calculate its metrics 2759 if Visible and (not (csDestroying in ComponentState)) then 2760 begin 2761 if not (csDesigning in ComponentState) then 2762 MoveToDefaultPosition; 2763 if (fsFirstShow in FFormState) then 2764 begin 2765 Exclude(FFormState, fsFirstShow); 2766 DoFirstShow; 2767 end; 2768 end; 2769 {$IF defined(CHECK_POSITION) or defined(VerboseFormUpdateShowing) or defined(VerboseShowing)} 2770 DebugLn(['[TCustomForm.UpdateShowing] calling inherited ',dbgsname(Self),' Pos=',Left,',',Top]); 2771 {$ENDIF} 2772 inherited UpdateShowing; 2773 {$IF defined(CHECK_POSITION) or defined(VerboseFormUpdateShowing) or defined(VerboseShowing)} 2774 DebugLn(['[TCustomForm.UpdateShowing] activating ',dbgsname(Self),' Pos=',Left,',',Top]); 2775 {$ENDIF} 2776 // activate focus if visible 2777 if Showing and (not (csDestroying in ComponentState)) then 2778 begin 2779 if (not Assigned(ActiveControl)) and (not (csDesigning in ComponentState)) and (Parent=nil) then 2780 begin 2781 // automatically choose a control to focus 2782 {$IFDEF VerboseFocus} 2783 DebugLn('TCustomForm.CreateWnd ',DbgSName(Self),' Set ActiveControl := ',DbgSName(FindDefaultForActiveControl)); 2784 {$ENDIF} 2785 ActiveControl := FindDefaultForActiveControl; 2786 end; 2787 if (Parent=nil) and Assigned(ActiveControl) and 2788 ActiveControl.HandleAllocated and ActiveControl.CanFocus and 2789 ([csLoading, csDestroying, csDesigning] * ComponentState = []) then 2790 begin 2791 {$IFDEF VerboseFocus} 2792 DebugLn('TCustomForm.CreateWnd A ',DbgSName(Self),' FActiveControl=',DbgSName(FActiveControl)); 2793 {$ENDIF} 2794 LCLIntf.SetFocus(ActiveControl.Handle); 2795 end; 2796 UpdateShowInTaskBar; 2797 end; 2798end; 2799 2800procedure TCustomForm.DoFirstShow; 2801begin 2802 FFormHandlers[fhtFirstShow].CallNotifyEvents(Self); 2803end; 2804 2805{------------------------------------------------------------------------------ 2806 Method: TCustomForm.GetClientHandle 2807 Params: None 2808 Returns: Nothing 2809 2810 Returns handle of fsMdiForm container for mdi children. 2811 This is not same as Handle of form. 2812 Result is valid only if form FormStyle = fsMDIForm or FormStyle = fsMDIChild. 2813 In case when FormStyle = fsMDIChild it'll return handle of it's container 2814 (fsMDIForm). 2815 ------------------------------------------------------------------------------} 2816function TCustomForm.GetClientHandle: HWND; 2817begin 2818 Result := 0; 2819 if not (FormStyle in [fsMDIForm, fsMDIChild]) then 2820 exit; 2821 if HandleAllocated and not (csDesigning in ComponentState) then 2822 Result := TWSCustomFormClass(WidgetSetClass).GetClientHandle(Self); 2823end; 2824 2825{------------------------------------------------------------------------------ 2826 Method: TCustomForm.ActiveMDIChild 2827 Params: None 2828 Returns: Nothing 2829 2830 Returns currently active MDI child form of self. 2831 Valid result is returned only when Self FormStyle = fsMDIForm or fsMDIChild, 2832 otherwise Result is nil. 2833 ------------------------------------------------------------------------------} 2834function TCustomForm.ActiveMDIChild: TCustomForm; 2835begin 2836 Result := nil; 2837 if not (FormStyle in [fsMDIForm, fsMDIChild]) then 2838 exit; 2839 if HandleAllocated and not (csDesigning in ComponentState) then 2840 Result := TWSCustomFormClass(WidgetSetClass).ActiveMDIChild(Self); 2841end; 2842 2843{------------------------------------------------------------------------------ 2844 Method: TCustomForm.MDIChildCount 2845 Params: None 2846 Returns: Nothing 2847 2848 Returns count of MDIChild forms. 2849 Result is returned only when Self FormStyle = fsMDIForm or fsMDIChild (can 2850 be 0 ... number of mdichild forms). 2851 If Result is -1 then caller isn't mdi or handle is not allocated. 2852 ------------------------------------------------------------------------------} 2853function TCustomForm.MDIChildCount: Integer; 2854begin 2855 Result := -1; 2856 if not (FormStyle in [fsMDIForm, fsMDIChild]) then 2857 exit; 2858 if HandleAllocated and not (csDesigning in ComponentState) then 2859 Result := TWSCustomFormClass(WidgetSetClass).MDIChildCount(Self); 2860end; 2861 2862{------------------------------------------------------------------------------ 2863 Method: TCustomForm.MDIChildCount 2864 Params: AIndex: Integer; 2865 Returns: TCustomForm with FormStyle = fsMDIChild 2866 2867 Returns MDI child (fsMDIChild) of parent mdi form (fsMDIForm) at index 2868 AIndex in list of mdi children. 2869 Result can be nil if caller isn't an mdi type or handle isn't allocated. 2870 ------------------------------------------------------------------------------} 2871function TCustomForm.GetMDIChildren(AIndex: Integer): TCustomForm; 2872begin 2873 Result := nil; 2874 if not (FormStyle in [fsMDIForm, fsMDIChild]) then 2875 exit; 2876 if HandleAllocated and not (csDesigning in ComponentState) then 2877 Result := TWSCustomFormClass(WidgetSetClass).GetMDIChildren(Self, AIndex); 2878end; 2879 2880 2881{------------------------------------------------------------------------------ 2882 TCustomForm ShowModal 2883------------------------------------------------------------------------------} 2884function TCustomForm.ShowModal: Integer; 2885 2886 function HasVisibleForms: Boolean; 2887 var 2888 i: integer; 2889 AForm: TCustomForm; 2890 begin 2891 Result := False; 2892 for i := 0 to Screen.CustomFormZOrderCount - 1 do 2893 begin 2894 AForm := Screen.CustomFormsZOrdered[i]; 2895 if (AForm <> Self) and not (AForm.FormStyle = fsMDIChild) and 2896 (AForm.Parent = nil) and AForm.Visible and AForm.HandleAllocated then 2897 begin 2898 Result := True; 2899 break; 2900 end; 2901 end; 2902 end; 2903 2904 procedure RaiseShowModalImpossible; 2905 var 2906 s: String; 2907 begin 2908 DebugLn('TCustomForm.ShowModal Visible=',dbgs(Visible),' Enabled=',dbgs(Enabled), 2909 ' fsModal=',dbgs(fsModal in FFormState),' MDIChild=',dbgs(FormStyle = fsMDIChild)); 2910 s:='TCustomForm.ShowModal for '+DbgSName(Self)+' impossible, because'; 2911 if Visible then 2912 s:=s+' already visible (hint for designer forms: set Visible property to false)'; 2913 if not Enabled then 2914 s:=s+' not enabled'; 2915 if fsModal in FFormState then 2916 s:=s+' already modal'; 2917 if FormStyle = fsMDIChild then 2918 s:=s+' FormStyle=fsMDIChild'; 2919 raise EInvalidOperation.Create(s); 2920 end; 2921 2922 procedure RestoreFocusedForm; 2923 begin 2924 // needs to be called only in ShowModal 2925 Perform(CM_DEACTIVATE, 0, 0); 2926 if Screen.FSaveFocusedList.Count > 0 then 2927 begin 2928 Screen.FFocusedForm := TCustomForm(Screen.FSaveFocusedList.First); 2929 Screen.FSaveFocusedList.Remove(Screen.FFocusedForm); 2930 end 2931 else 2932 Screen.FFocusedForm := nil; 2933 end; 2934 2935var 2936 DisabledList: TList; 2937 SavedFocusState: TFocusState; 2938 ActiveWindow: HWnd; 2939begin 2940 if Self = nil then 2941 raise EInvalidOperation.Create('TCustomForm.ShowModal Self = nil'); 2942 if Application.Terminated then 2943 ModalResult := 0; 2944 // cancel drags 2945 DragManager.DragStop(false); 2946 // close popupmenus 2947 if ActivePopupMenu <> nil then 2948 ActivePopupMenu.Close; 2949 if Visible or (not Enabled) or (fsModal in FFormState) or (FormStyle = fsMDIChild) then 2950 RaiseShowModalImpossible; 2951 // Kill capture when opening another dialog 2952 if GetCapture <> 0 then 2953 SendMessage(GetCapture, LM_CANCELMODE, 0, 0); 2954 ReleaseCapture; 2955 2956 Application.ModalStarted; 2957 try 2958 Include(FFormState, fsModal); 2959 if (PopupMode = pmNone) and HandleAllocated then 2960 RecreateWnd(Self); // need to refresh handle for pmNone because ParentWindow changes if (fsModal in FFormState) - see GetRealPopupParent 2961 ActiveWindow := GetActiveWindow; 2962 SavedFocusState := SaveFocusState; 2963 Screen.FSaveFocusedList.Insert(0, Screen.FFocusedForm); 2964 Screen.FFocusedForm := Self; 2965 Screen.MoveFormToFocusFront(Self); 2966 Screen.BeginTempCursor(crDefault); 2967 ModalResult := 0; 2968 2969 try 2970 if WidgetSet.GetLCLCapability(lcModalWindow) = LCL_CAPABILITY_NO then 2971 DisabledList := Screen.DisableForms(Self) 2972 else 2973 DisabledList := nil; 2974 Show; 2975 try 2976 // activate must happen after show 2977 Perform(CM_ACTIVATE, 0, 0); 2978 TWSCustomFormClass(WidgetSetClass).ShowModal(Self); 2979 repeat 2980 { Delphi calls Application.HandleMessage 2981 But HandleMessage processes all pending events and then calls idle, 2982 which will wait for new messages. Under Win32 there is always a next 2983 message, so it works there. The LCL is OS independent, and so it uses 2984 a better way: } 2985 try 2986 WidgetSet.AppProcessMessages; // process all events 2987 except 2988 if Application.CaptureExceptions then 2989 Application.HandleException(Self) 2990 else 2991 raise; 2992 end; 2993 if Application.Terminated then 2994 ModalResult := mrCancel; 2995 if ModalResult <> 0 then 2996 begin 2997 CloseModal; 2998 if ModalResult<>0 then break; 2999 end; 3000 3001 Application.Idle(true); 3002 until False; 3003 3004 Result := ModalResult; 3005 if HandleAllocated and (GetActiveWindow <> Handle) then 3006 ActiveWindow := 0; 3007 finally 3008 { guarantee execution of widgetset CloseModal } 3009 TWSCustomFormClass(WidgetSetClass).CloseModal(Self); 3010 // set our modalresult to mrCancel before hiding. 3011 if ModalResult = 0 then 3012 ModalResult := mrCancel; 3013 // We should always re-enabled the forms before issuing Hide() 3014 // Because otherwise we will for a short amount of time have 3015 // all forms disabled, and some systems, like WinCE, will interprete this 3016 // as a problem in the application and hide it. 3017 // See bug 22718 3018 Screen.EnableForms(DisabledList); 3019 Hide; 3020 RestoreFocusedForm; 3021 end; 3022 finally 3023 RestoreFocusState(SavedFocusState); 3024 Screen.EndTempCursor(crDefault); 3025 if LCLIntf.IsWindow(ActiveWindow) then 3026 SetActiveWindow(ActiveWindow); 3027 Exclude(FFormState, fsModal); 3028 if ((PopupMode = pmNone) and HandleAllocated) and not (csDestroying in ComponentState) then 3029 RecreateWnd(Self); // need to refresh handle for pmNone because ParentWindow changes if (fsModal in FFormState) - see GetRealPopupParent 3030 end; 3031 finally 3032 Application.ModalFinished; 3033 end; 3034end; 3035 3036function TCustomForm.GetRolesForControl(AControl: TControl 3037 ): TControlRolesForForm; 3038begin 3039 Result:=[]; 3040 if DefaultControl=AControl then Include(Result,crffDefault); 3041 if CancelControl=AControl then Include(Result,crffCancel); 3042end; 3043 3044procedure TCustomForm.RemoveAllHandlersOfObject(AnObject: TObject); 3045var 3046 HandlerType: TFormHandlerType; 3047begin 3048 inherited RemoveAllHandlersOfObject(AnObject); 3049 for HandlerType:=Low(TFormHandlerType) to High(TFormHandlerType) do 3050 FFormHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject); 3051end; 3052 3053procedure TCustomForm.AddHandlerFirstShow(OnFirstShowHandler: TNotifyEvent; 3054 AsFirst: Boolean); 3055begin 3056 AddHandler(fhtFirstShow,TMethod(OnFirstShowHandler),AsFirst); 3057end; 3058 3059procedure TCustomForm.RemoveHandlerFirstShow(OnFirstShowHandler: TNotifyEvent); 3060begin 3061 RemoveHandler(fhtFirstShow,TMethod(OnFirstShowHandler)); 3062end; 3063 3064procedure TCustomForm.AddHandlerClose(OnCloseHandler: TCloseEvent; 3065 AsFirst: Boolean); 3066begin 3067 AddHandler(fhtClose,TMethod(OnCloseHandler),AsFirst); 3068end; 3069 3070procedure TCustomForm.RemoveHandlerClose(OnCloseHandler: TCloseEvent); 3071begin 3072 RemoveHandler(fhtClose,TMethod(OnCloseHandler)); 3073end; 3074 3075procedure TCustomForm.AddHandlerCreate(OnCreateHandler: TNotifyEvent; 3076 AsFirst: Boolean); 3077begin 3078 AddHandler(fhtCreate,TMethod(OnCreateHandler),AsFirst); 3079end; 3080 3081procedure TCustomForm.RemoveHandlerCreate(OnCreateHandler: TNotifyEvent); 3082begin 3083 RemoveHandler(fhtCreate,TMethod(OnCreateHandler)); 3084end; 3085 3086procedure TCustomForm.Dock(NewDockSite: TWinControl; ARect: TRect); 3087begin 3088 inherited Dock(NewDockSite, ARect); 3089end; 3090 3091procedure TCustomForm.UpdateDockCaption(Exclude: TControl); 3092const 3093 MaxCaption = 20; 3094var 3095 NewCaption: String; 3096 i: Integer; 3097 AControl: TControl; 3098 CtrlCaption: String; 3099begin 3100 { Show the combined captions of all clients. 3101 Exclude client to be undocked. 3102 Don't change the Caption to an empty string. } 3103 NewCaption := ''; 3104 for i := 0 to DockClientCount - 1 do 3105 begin 3106 AControl := DockClients[i]; 3107 // check if control is shown 3108 if (AControl = Exclude) or (not AControl.IsControlVisible) then 3109 continue; 3110 // get caption 3111 CtrlCaption:=GetDockCaption(AControl); 3112 if CtrlCaption='' then continue; 3113 // do not put garbage in the title 3114 UTF8FixBroken(CtrlCaption); 3115 if not (AControl is TCustomForm) then 3116 begin 3117 // non controls like tmemo can have very long captions => cut them 3118 if UTF8Length(CtrlCaption)>MaxCaption then 3119 CtrlCaption:=UTF8Copy(CtrlCaption,1,MaxCaption)+'...'; 3120 end; 3121 if NewCaption<>'' then NewCaption := NewCaption+', '; 3122 NewCaption:=NewCaption+CtrlCaption; 3123 end; 3124 // don't change the Caption to an empty string 3125 if NewCaption <> '' then 3126 Caption := NewCaption; 3127end; 3128 3129//============================================================================== 3130 3131{ TForm } 3132 3133function TForm.LCLVersionIsStored: boolean; 3134begin 3135 Result:=Parent=nil; 3136end; 3137 3138class procedure TForm.WSRegisterClass; 3139begin 3140 inherited WSRegisterClass; 3141 RegisterPropertyToSkip(TForm, 'OldCreateOrder', 'VCL compatibility property', ''); 3142 RegisterPropertyToSkip(TForm, 'TextHeight', 'VCL compatibility property', ''); 3143 RegisterPropertyToSkip(TForm, 'Scaled', 'VCL compatibility property', ''); 3144 RegisterPropertyToSkip(TForm, 'TransparentColorValue', 'VCL compatibility property', ''); 3145end; 3146 3147procedure TForm.CreateWnd; 3148begin 3149 if (Application<>nil) then 3150 Application.UpdateMainForm(TForm(Self)); 3151 inherited CreateWnd; 3152end; 3153 3154procedure TForm.Loaded; 3155begin 3156 inherited Loaded; 3157 FLCLVersion:=lcl_version; 3158end; 3159 3160constructor TForm.Create(TheOwner: TComponent); 3161begin 3162 FLCLVersion:=lcl_version; 3163 inherited Create(TheOwner); 3164end; 3165 3166{------------------------------------------------------------------------------ 3167 Method: TForm.Cascade 3168 Params: None 3169 Returns: Nothing 3170 3171 Arranges MDI child forms so they overlap. 3172 Use Cascade to arrange MDI child forms so they overlap. 3173 Cascade works only if the form is an MDI parent form (FormStyle=fsMDIForm). 3174 ------------------------------------------------------------------------------} 3175procedure TForm.Cascade; 3176begin 3177 if (FormStyle <> fsMDIForm) then 3178 exit; 3179 if HandleAllocated and not (csDesigning in ComponentState) then 3180 TWSCustomFormClass(WidgetSetClass).Cascade(Self); 3181end; 3182 3183{------------------------------------------------------------------------------ 3184 Method: TForm.Next 3185 Params: None 3186 Returns: Nothing 3187 3188 Activates the next child MDI form (fsMDIChild) in the form sequence. 3189 Use Next to change the active child form of an MDI parent. 3190 If calling of Next comes to the end of count it restarts and activates 3191 first dsMDIChild in sequence. 3192 The Next method applies only to forms with FormStyle = fsMDIForm. 3193 ------------------------------------------------------------------------------} 3194procedure TForm.Next; 3195begin 3196 if (FormStyle <> fsMDIForm) then 3197 exit; 3198 if HandleAllocated and not (csDesigning in ComponentState) then 3199 TWSCustomFormClass(WidgetSetClass).Next(Self); 3200end; 3201 3202{------------------------------------------------------------------------------ 3203 Method: TForm.Previous 3204 Params: None 3205 Returns: Nothing 3206 Activates the previous MDI child form in the form sequence. 3207 Behaviour is vice-versa of TForm.Next. 3208 The Previous method can be called only for forms with FormStyle = fsMDIForm 3209 ------------------------------------------------------------------------------} 3210procedure TForm.Previous; 3211begin 3212 if (FormStyle <> fsMDIForm) then 3213 exit; 3214 if HandleAllocated and not (csDesigning in ComponentState) then 3215 TWSCustomFormClass(WidgetSetClass).Previous(Self); 3216end; 3217 3218{------------------------------------------------------------------------------ 3219 Method: TForm.Tile 3220 Params: None 3221 Returns: Nothing 3222 3223 Arranges MDI child forms so that they are all the same size. 3224 Use Tile to arrange MDI child forms so that they are all the same size. 3225 Tiled forms completely fill up the client area of the parent form. 3226 How the forms arrange themselves depends upon the values of 3227 their TileMode properties, and it depends on widgetset. 3228 Tile works only if the form FormStyle = fsMDIForm. 3229 ------------------------------------------------------------------------------} 3230procedure TForm.Tile; 3231begin 3232 if (FormStyle <> fsMDIForm) then 3233 exit; 3234 if HandleAllocated and not (csDesigning in ComponentState) then 3235 TWSCustomFormClass(WidgetSetClass).Tile(Self); 3236end; 3237 3238{------------------------------------------------------------------------------ 3239 Method: TForm.ArrangeIcons 3240 Params: None 3241 Returns: Nothing 3242 3243 Arranges the minimized MDI icons in an MDI form. 3244 ArrangeIcons works only if the form FormStyle = fsMDIForm. 3245 ------------------------------------------------------------------------------} 3246procedure TForm.ArrangeIcons; 3247begin 3248 if (FormStyle <> fsMDIForm) then 3249 Exit; 3250 if HandleAllocated and not (csDesigning in ComponentState) then 3251 TWSCustomFormClass(WidgetSetClass).ArrangeIcons(Self); 3252end; 3253 3254//============================================================================== 3255 3256{ TFormPropertyStorage } 3257 3258procedure TFormPropertyStorage.FormCreate(Sender: TObject); 3259begin 3260 Restore; 3261end; 3262 3263procedure TFormPropertyStorage.FormClose(Sender: TObject; var CloseAction: TCloseAction); 3264begin 3265 If CloseAction = caFree Then Begin 3266 Save; 3267 TCustomForm(Owner).RemoveHandlerOnBeforeDestruction(@FormDestroy); 3268 end; 3269end; 3270 3271procedure TFormPropertyStorage.FormDestroy(Sender: TObject); 3272begin 3273 Save; 3274end; 3275 3276constructor TFormPropertyStorage.Create(TheOwner: TComponent); 3277begin 3278 inherited Create(TheOwner); 3279 if Owner is TCustomForm then 3280 begin 3281 TCustomForm(Owner).AddHandlerCreate(@FormCreate, True); 3282 TCustomForm(Owner).AddHandlerClose(@FormClose, True); 3283 TCustomForm(Owner).AddHandlerOnBeforeDestruction(@FormDestroy, True); 3284 end; 3285end; 3286 3287destructor TFormPropertyStorage.Destroy; 3288begin 3289 if Owner is TControl then 3290 TControl(Owner).RemoveAllHandlersOfObject(Self); 3291 inherited Destroy; 3292end; 3293