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