From 101eedbc8f169768c12705d9ded26a5b34393e2e Mon Sep 17 00:00:00 2001 From: paul Date: Wed, 8 Apr 2009 06:27:26 +0000 Subject: [PATCH] lcl: add TCustomForm.DefaultMonitor and appropriate implementation, publish this property it in TForm git-svn-id: trunk@19278 - --- lcl/forms.pp | 61 ++++++++++++++++------------ lcl/include/customform.inc | 82 ++++++++++++++++++++++++++++++++------ 2 files changed, 105 insertions(+), 38 deletions(-) diff --git a/lcl/forms.pp b/lcl/forms.pp index 397c844a61..c7c50d738b 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -45,6 +45,11 @@ uses ; type + // forward class declarations + TIDesigner = class; + TMonitor = class; + TScrollingWinControl = class; + TProcedure = procedure; TProcedureOfObject = procedure of object; @@ -63,10 +68,6 @@ type TWindowState = (wsNormal, wsMinimized, wsMaximized); TCloseAction = (caNone, caHide, caFree, caMinimize); - TMonitor = class; - TScrollingWinControl = class; - - { Hint actions } TCustomHintAction = class(TCustomAction) @@ -330,31 +331,31 @@ type { TCustomForm } - TIDesigner = class; - - TBorderIcon = (biSystemMenu, biMinimize, biMaximize, biHelp); + TBorderIcon = ( // Form title bar items + biSystemMenu, // system menu + biMinimize, // minimize button + biMaximize, // maximize button + biHelp // help button + ); TBorderIcons = set of TBorderIcon; - TCloseEvent = procedure(Sender: TObject; var CloseAction: TCloseAction) of object; - TCloseQueryEvent = procedure(Sender : TObject; - var CanClose : boolean) of object; - THelpEvent = function(Command: Word; Data: Longint; - var CallHelp: Boolean): Boolean of object; - - TDropFilesEvent = procedure (Sender: TObject; const FileNames: Array of String) of object; - - TShortCutEvent = procedure (var Msg: TLMKey; var Handled: Boolean) of object; + TDefaultMonitor = ( // monitor to place form + dmDesktop, // use full desktop + dmPrimary, // use primary monitor + dmMainForm, // use monitor of main form + dmActiveForm // use monitor of active form + ); TFormStateType = ( - fsCreating, // initializing (form streaming) - fsVisible, // form should be shown - fsShowing, - fsModal, // form is modal - fsCreatedMDIChild, - fsBorderStyleChanged, - fsFormStyleChanged, - fsFirstShow, // form is shown for the first time - fsDisableAutoSize + fsCreating, // initializing (form streaming) + fsVisible, // form should be shown + fsShowing, // form handling WM_SHOWWINDOW message + fsModal, // form is modal + fsCreatedMDIChild, // todo: not mplemented + fsBorderStyleChanged,// border style is changed before window handle creation + fsFormStyleChanged, // form style is changed before window handle creation + fsFirstShow, // form is shown for the first time + fsDisableAutoSize // disable autosize ); TFormState = set of TFormStateType; @@ -369,7 +370,11 @@ type TShowInTaskbar = (stDefault, stAlways, stNever); - { TCustomForm } + TCloseEvent = procedure(Sender: TObject; var CloseAction: TCloseAction) of object; + TCloseQueryEvent = procedure(Sender : TObject; var CanClose : boolean) of object; + TDropFilesEvent = procedure (Sender: TObject; const FileNames: Array of String) of object; + THelpEvent = function(Command: Word; Data: Longint; var CallHelp: Boolean): Boolean of object; + TShortCutEvent = procedure (var Msg: TLMKey; var Handled: Boolean) of object; TCustomForm = class(TScrollingWinControl) private @@ -380,6 +385,7 @@ type FBorderIcons: TBorderIcons; FDefaultControl: TControl; FCancelControl: TControl; + FDefaultMonitor: TDefaultMonitor; FDesigner: TIDesigner; FFormState: TFormState; FFormStyle: TFormStyle; @@ -566,6 +572,8 @@ type property Caption stored IsForm; property Color default clBtnFace; property DefaultControl: TControl read FDefaultControl write SetDefaultControl; + property DefaultMonitor: TDefaultMonitor read FDefaultMonitor + write FDefaultMonitor default dmActiveForm; property Designer: TIDesigner read FDesigner write SetDesigner; property FormState: TFormState read FFormState; property FormStyle: TFormStyle read FFormStyle write SetFormStyle @@ -641,6 +649,7 @@ type property ClientWidth; property Color; property Constraints; + property DefaultMonitor; property DockSite; property DragKind; property DragMode; diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index a607593646..a704ce9390 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -1052,9 +1052,9 @@ end; procedure TCustomForm.SetAutoSize(Value: Boolean); begin - if Value=AutoSize then exit; - if Value=true then - Exclude(FFormState,fsDisableAutoSize); + if Value = AutoSize then Exit; + if Value then + Exclude(FFormState, fsDisableAutoSize); inherited SetAutoSize(Value); end; @@ -1490,6 +1490,7 @@ begin //DebugLn('[TCustomForm.CreateNew] Class=',Classname); BeginFormUpdate; FBorderIcons := [biSystemMenu, biMinimize, biMaximize]; + FDefaultMonitor := dmActiveForm; // set border style before handle is allocated if not (fsBorderStyleChanged in FFormState) then FFormBorderStyle:= bsSizeable; @@ -2022,6 +2023,59 @@ end; Here the initial form left and top are determined. ------------------------------------------------------------------------------} procedure TCustomForm.UpdateShowing; + + procedure MoveToDefaultMonitor(var X, Y: Integer); + var + Source, Target: TMonitor; + ABounds: TRect; + begin + // delphi compatibility: if no main form then DefaultMonitor has no effect + if Application.MainForm = nil then Exit; + Source := Screen.MonitorFromPoint(Point(X, Y)); + case DefaultMonitor of + dmDesktop: + Target := Source; // no need to move + dmPrimary: + Target := Screen.PrimaryMonitor; + dmMainForm: + Target := Application.MainForm.Monitor; + dmActiveForm: + if Screen.ActiveCustomForm <> nil then + Target := Screen.ActiveCustomForm.Monitor + else + Target := Source; + end; + if Source = Target then Exit; // no move + + if Position in [poMainFormCenter, poOwnerFormCenter] then + begin + ABounds := Target.BoundsRect; + // shift X and Y from Source to Target monitor + X := (X - Source.Left) + ABounds.Left; + Y := (Y - Source.Top) + ABounds.Top; + + // check that we are still in the desired monitor + with Target.BoundsRect do + begin + if X + Width > ABounds.Right then + X := ABounds.Right - Width; + if X < ABounds.Left then + X := ABounds.Left; + + if Y + Height > ABounds.Bottom then + Y := ABounds.Bottom - Height; + if Y < ABounds.Top then + Y := ABounds.Top; + end; + end + else + begin + ABounds := Target.BoundsRect; + X := (ABounds.Left + ABounds.Right - Width) div 2; + Y := (ABounds.Top + ABounds.Bottom - Height) div 2; + end; + end; + var X, Y : integer; begin @@ -2030,8 +2084,10 @@ begin DebugLn('[TCustomForm.UpdateShowing] A ',DbgSName(Self),' Pos=',DbgS(Left),',',DbgS(Top),' Visible=',DbgS(Visible)); {$ENDIF} { If the the form is about to show, calculate its metrics } - if Visible then begin - if Parent=nil then begin + if Visible then + begin + if Parent = nil then + begin // first make sure X and Y are assigned X := Left; Y := Top; @@ -2045,7 +2101,6 @@ begin end else begin case Position of - //TODO:poDefault, poDefaultPosOnly, poDefaultSizeOnly poDesktopCenter : begin X := (Screen.DesktopWidth - Width) div 2; @@ -2057,24 +2112,27 @@ begin Y := (Screen.Height - Height) div 2; end; poMainFormCenter : - if (Self <> Application.MainForm) then begin + if (Self <> Application.MainForm) then + begin X := ((Application.MainForm.Width - Width) div 2) + Application.MainForm.Left; Y := ((Application.MainForm.Height - Height) div 2) + Application.MainForm.Top; end; poOwnerFormCenter : - if (Owner is TCustomForm) then begin + if (Owner is TCustomForm) then + begin X := ((TCustomForm(Owner).Width - Width) div 2) + TCustomForm(Owner).Left; Y := ((TCustomForm(Owner).Height - Height) div 2) + TCustomForm(Owner).Top; end; end; end; - if X < 0 then X := 0; - if Y < 0 then Y := 0; + if (Position in [poScreenCenter, poMainFormCenter, poOwnerFormCenter]) then + MoveToDefaultMonitor(X, Y); SetBounds(X, Y, Width, Height); end; - if (fsFirstShow in FFormState) then begin - Exclude(FFormState,fsFirstShow); + if (fsFirstShow in FFormState) then + begin + Exclude(FFormState, fsFirstShow); DoFirstShow; end; end;