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