paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 07:38:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl, win32: start implementation of TCustomForm.PopupMode, TCustomForm.PopupParent

Browse Source 
git-svn-id: trunk@23723 -
This commit is contained in:
paul 2010-02-17 06:04:19 +00:00
parent 825101fc3f
commit 1f6c52fe1a
4 changed files with 85 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
lcl/forms.pp
View File

@ -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.

40
lcl/include/customform.inc
View File

@ -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;

23
lcl/interfaces/win32/win32wsforms.pp
View File

@ -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

13
lcl/widgetset/wsforms.pp
View File

@ -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