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