diff --git a/lcl/forms.pp b/lcl/forms.pp index 338b0626bf..19691298ef 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -379,7 +379,17 @@ type fhtCreate ); - TShowInTaskbar = (stDefault, stAlways, stNever); + TShowInTaskbar = ( + stDefault, // use default rules for showing taskbar item + stAlways, // always show taskbar item for the form + stNever // never show taskbar item for the form + ); + + TPopupMode = ( + pmNone, // default behavior - popup to mainform/taskbar window + pmAuto, // popup to active form and same as pmNone if no active form + pmExplicit // popup to PopupParent and same as pmNone if not exists + ); TCloseEvent = procedure(Sender: TObject; var CloseAction: TCloseAction) of object; TCloseQueryEvent = procedure(Sender : TObject; var CanClose : boolean) of object; @@ -405,6 +415,8 @@ type FFormHandlers: array[TFormHandlerType] of TMethodList; FHelpFile: string; FIcon: TIcon; + FPopupMode: TPopupMode; + FPopupParent: TCustomForm; FSmallIconHandle: HICON; FBigIconHandle: HICON; FKeyPreview: Boolean; @@ -455,7 +467,8 @@ type procedure SetFormStyle(Value : TFormStyle); procedure SetIcon(AValue: TIcon); procedure SetMenu(Value: TMainMenu); - procedure SetModalResult(const AValue: TModalResult); + procedure SetPopupMode(const AValue: TPopupMode); + procedure SetPopupParent(const AValue: TCustomForm); procedure SetPosition(Value : TPosition); procedure SetShowInTaskbar(Value: TShowInTaskbar); procedure SetWindowFocus; @@ -611,8 +624,11 @@ type property Icon: TIcon read FIcon write SetIcon stored IsIconStored; property KeyPreview: Boolean read FKeyPreview write FKeyPreview default False; property Menu : TMainMenu read FMenu write SetMenu; - property ModalResult : TModalResult read FModalResult write SetModalResult; + property ModalResult : TModalResult read FModalResult write FModalResult; property Monitor: TMonitor read GetMonitor; + property PopupMode: TPopupMode read FPopupMode write SetPopupMode default pmNone; + property PopupParent: TCustomForm read FPopupParent write SetPopupParent; + property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; property OnClose: TCloseEvent read FOnClose write FOnClose stored IsForm; property OnCloseQuery : TCloseQueryEvent @@ -731,6 +747,8 @@ type property ParentFont; property PixelsPerInch; property PopupMenu; + property PopupMode; + property PopupParent; property Position; property SessionProperties; property ShowHint; @@ -1891,6 +1909,3 @@ finalization FreeThenNil(Screen); end. - - - diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index b3bd13289c..63ac48acc9 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -153,7 +153,12 @@ begin if (FActionLists <> nil) and (AComponent is TCustomActionList) then DoRemoveActionList(TCustomActionList(AComponent)) else - if AComponent = Menu then Menu := nil; + if AComponent = Menu then + Menu := nil + else + if AComponent = PopupParent then + PopupParent := nil; + if FActiveControl=AComponent then begin {$IFDEF VerboseFocus} @@ -243,13 +248,33 @@ begin FIcon.Assign(AValue); end; -{------------------------------------------------------------------------------ - procedure TCustomForm.SetModalResult(const AValue: TModalResult); - ------------------------------------------------------------------------------} -procedure TCustomForm.SetModalResult(const AValue: TModalResult); +procedure TCustomForm.SetPopupMode(const AValue: TPopupMode); begin - if FModalResult=AValue then exit; - FModalResult:=AValue; + if FPopupMode <> AValue then + begin + FPopupMode := AValue; + if FPopupMode = pmAuto then + PopupParent := nil; + if not (csDesigning in ComponentState) and HandleAllocated then + TWSCustomFormClass(WidgetSetClass).SetPopupParent(Self, PopupMode, PopupParent); + end; +end; + +procedure TCustomForm.SetPopupParent(const AValue: TCustomForm); +begin + if FPopupParent <> AValue then + begin + if FPopupParent <> nil then + FPopupParent.RemoveFreeNotification(Self); + FPopupParent := AValue; + if FPopupParent <> nil then + begin + FPopupParent.FreeNotification(Self); + FPopupMode := pmExplicit; + end; + if not (csDesigning in ComponentState) and HandleAllocated then + TWSCustomFormClass(WidgetSetClass).SetPopupParent(Self, PopupMode, PopupParent); + end; end; {------------------------------------------------------------------------------ @@ -1630,6 +1655,7 @@ begin {$ENDIF} FBorderIcons := [biSystemMenu, biMinimize, biMaximize]; FDefaultMonitor := dmActiveForm; + FPopupMode := pmNone; FShowInTaskbar := stDefault; FAlphaBlend := False; FAlphaBlendValue := 255; diff --git a/lcl/interfaces/win32/win32wsforms.pp b/lcl/interfaces/win32/win32wsforms.pp index de5d6e1846..7525cc6f0a 100644 --- a/lcl/interfaces/win32/win32wsforms.pp +++ b/lcl/interfaces/win32/win32wsforms.pp @@ -83,6 +83,8 @@ type const AFormBorderStyle: TFormBorderStyle); override; class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle: TFormStyle); override; class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override; + class procedure SetPopupParent(const ACustomForm: TCustomForm; + const APopupMode: TPopupMode; const APopupParent: TCustomForm); override; class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override; class procedure ShowModal(const ACustomForm: TCustomForm); override; class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; @@ -292,7 +294,7 @@ class function TWin32WSCustomForm.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; var Params: TCreateWindowExParams; - lForm: TCustomForm; + lForm: TCustomForm absolute AWinControl; Bounds: TRect; begin // general initialization of Params @@ -300,7 +302,17 @@ begin // customization of Params with Params do begin - lForm := TCustomForm(AWinControl); + // define Parent according to PopupMode and PopupParent + if not (csDesigning in lForm.ComponentState) and (Application.MainForm <> lForm) then + case lForm.PopupMode of + pmNone:; + pmAuto: + if (Screen.ActiveForm <> nil) then + Parent := Screen.ActiveForm.Handle; + pmExplicit: + if (lForm.PopupParent <> nil) then + Parent := lForm.PopupParent.Handle; + end; CalcFormWindowFlags(lForm, Flags, FlagsEx); pClassName := @ClsName[0]; WindowTitle := StrCaption; @@ -447,6 +459,13 @@ begin RDW_INVALIDATE or RDW_FRAME or RDW_NOCHILDREN or RDW_ERASE); end; +class procedure TWin32WSCustomForm.SetPopupParent(const ACustomForm: TCustomForm; + const APopupMode: TPopupMode; const APopupParent: TCustomForm); +begin + // changing parent is not possible without handle recreation + RecreateWnd(ACustomForm); +end; + class procedure TWin32WSCustomForm.SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); var diff --git a/lcl/widgetset/wsforms.pp b/lcl/widgetset/wsforms.pp index 6fbc11909a..cd322ecc55 100644 --- a/lcl/widgetset/wsforms.pp +++ b/lcl/widgetset/wsforms.pp @@ -82,17 +82,19 @@ type published class procedure CloseModal(const ACustomForm: TCustomForm); virtual; class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); virtual; + class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; + const Alpha: Byte); virtual; class procedure SetBorderIcons(const AForm: TCustomForm; const ABorderIcons: TBorderIcons); virtual; class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); virtual; class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle: TFormStyle); virtual; class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); virtual; + class procedure ShowModal(const ACustomForm: TCustomForm); virtual; + class procedure SetPopupParent(const ACustomForm: TCustomForm; + const APopupMode: TPopupMode; const APopupParent: TCustomForm); virtual; class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); virtual; class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual; - class procedure ShowModal(const ACustomForm: TCustomForm); virtual; - class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; - const Alpha: Byte); virtual; end; TWSCustomFormClass = class of TWSCustomForm; @@ -181,6 +183,11 @@ class procedure TWSCustomForm.ShowModal(const ACustomForm: TCustomForm); begin end; +class procedure TWSCustomForm.SetPopupParent(const ACustomForm: TCustomForm; + const APopupMode: TPopupMode; const APopupParent: TCustomForm); +begin +end; + class procedure TWSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; const Alpha: Byte); begin