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

lcl: TCustomForm

Browse Source 
- add MakeFullyVisible, 
  - reimplement EnsureVisible
  - rearrange public methods

git-svn-id: trunk@19269 -
This commit is contained in:
paul 2009-04-07 08:47:24 +00:00
parent 511620d78d
commit 31974b5e84
2 changed files with 62 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
lcl/forms.pp
View File

@ -463,6 +463,7 @@ type
procedure ActiveChanged; dynamic;
procedure AdjustClientRect(var Rect: TRect); override;
procedure BeginFormUpdate;
function ColorIsStored: boolean; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure Deactivate; dynamic;
@ -508,43 +509,47 @@ type
public
constructor Create(AOwner: TComponent); override;
constructor CreateNew(AOwner: TComponent; Num : Integer{=0}); virtual;
procedure BeforeDestruction; override;
function BigIconHandle: HICON;
function SmallIconHandle: HICON;
procedure DestroyWnd; override;
destructor Destroy; override;
procedure BeforeDestruction; override;
class function GetControlClassDefaultSize: TPoint; override;
function BigIconHandle: HICON;
procedure Close;
function CloseQuery: boolean; virtual;
procedure Release;
procedure Hide;
procedure Show;
procedure ShowOnTop;
procedure EnsureVisible(AMoveToTop: boolean = true);
procedure DefocusControl(Control: TWinControl; Removing: Boolean);
procedure DestroyWnd; override;
procedure EnsureVisible(AMoveToTop: Boolean = True);
procedure FocusControl(WinControl: TWinControl);
function FormIsUpdating: boolean; override;
class function GetControlClassDefaultSize: TPoint; override;
function GetFormImage: TBitmap;
function GetRolesForControl(AControl: TControl): TControlRolesForForm;
procedure Hide;
procedure IntfDropFiles(const FileNames: array of String);
procedure IntfHelp(AComponent: TComponent);
function IsShortcut(var Message: TLMKey): boolean; virtual;
procedure MakeFullyVisible(AMonitor: TMonitor = nil);
function NeedParentForAutoSize: Boolean; override;
procedure Release;
procedure SetFocus; override;
function SetFocusedControl(Control: TWinControl): Boolean ; virtual;
procedure SetRestoredBounds(ALeft, ATop, AWidth, AHeight: integer);
procedure Show;
function ShowModal: Integer; virtual;
procedure ShowOnTop;
function SmallIconHandle: HICON;
function WantChildKey(Child : TControl;
var Message : TLMessage): Boolean; virtual;
procedure DefocusControl(Control: TWinControl; Removing: Boolean);
procedure SetFocus; override;
function SetFocusedControl(Control: TWinControl): Boolean ; Virtual;
procedure FocusControl(WinControl: TWinControl);
function ShowModal: Integer; virtual;
procedure SetRestoredBounds(ALeft, ATop, AWidth, AHeight: integer);
function GetRolesForControl(AControl: TControl): TControlRolesForForm;
procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
// handlers
procedure AddHandlerFirstShow(OnFirstShowHandler: TNotifyEvent;
AsLast: Boolean=true);
procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
procedure RemoveHandlerFirstShow(OnFirstShowHandler: TNotifyEvent);
procedure AddHandlerClose(OnCloseHandler: TCloseEvent; AsLast: Boolean=true);
procedure RemoveHandlerClose(OnCloseHandler: TCloseEvent);
procedure AddHandlerCreate(OnCreateHandler: TNotifyEvent; AsLast: Boolean=true);
procedure RemoveHandlerCreate(OnCreateHandler: TNotifyEvent);
function IsShortcut(var Message: TLMKey): boolean; virtual;
function ColorIsStored: boolean; override;
procedure IntfDropFiles(const FileNames: Array of String);
procedure IntfHelp(AComponent: TComponent);
function GetFormImage: TBitmap;
public
// drag and dock
procedure Dock(NewDockSite: TWinControl; ARect: TRect); override;

50
lcl/include/customform.inc
View File

@ -753,25 +753,13 @@ begin
end;
end;
procedure TCustomForm.EnsureVisible(AMoveToTop: boolean = true);
var
newLeft, newTop: integer;
procedure TCustomForm.EnsureVisible(AMoveToTop: Boolean = True);
begin
newLeft := Left;
newTop := Top;
if newLeft + (Width div 2) > Screen.Width then
newLeft := Screen.Width - Width;
if newLeft < 0 then
newLeft := 0;
if newTop + (Height div 2) + 24 > Screen.Height then
newTop := Screen.Height - Height - 24;
if newTop < 0 then
newTop := 0;
SetBounds(newLeft, newTop, Width, Height);
MakeFullyVisible;
if AMoveToTop then
ShowOnTop
else
Visible:=true;
Visible := True;
end;
{------------------------------------------------------------------------------
@ -1041,7 +1029,7 @@ end;
function TCustomForm.ColorIsStored: boolean;
begin
Result:=(Color <> clBtnFace);
Result := (Color <> clBtnFace);
end;
procedure TCustomForm.DoSendBoundsToInterface;
@ -1834,6 +1822,36 @@ begin
end;
end;
procedure TCustomForm.MakeFullyVisible(AMonitor: TMonitor);
var
newLeft, newTop: Integer;
ABounds: TRect;
Mon: TMonitor;
begin
newLeft := Left;
newTop := Top;
// reduce calls to GetMonitor
if AMonitor <> nil then
Mon := AMonitor
else
Mon := Monitor;
if Mon <> nil then
ABounds := Mon.BoundsRect
else
ABounds := Bounds(0, 0, Screen.Width, Screen.Height);
if newLeft + (Width div 2) > ABounds.Right then
newLeft := ABounds.Right - Width;
if newLeft < ABounds.Left then
newLeft := ABounds.Left;
if newTop + (Height div 2) + 24 > ABounds.Bottom then
newTop := ABounds.Bottom - Height - 24;
if newTop < ABounds.Top then
newTop := ABounds.Top;
SetBounds(newLeft, newTop, Width, Height);
end;
{------------------------------------------------------------------------------
Method: TCustomForm.IntfDropFiles
Params: FileNames - Dropped files