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

designer:

Browse Source 
- auto resize frame on designer form resize
- position frame designer at default position since frame TopLeft is always (0,0) in the designer

git-svn-id: trunk@15068 -
This commit is contained in:
paul 2008-05-07 07:18:29 +00:00
parent 322517d9e6
commit 90d87af7b6
1 changed files with 23 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
designer/framedesigner.pas
View File

@ -41,8 +41,10 @@ type
protected protected
procedure SetLookupRoot(const AValue: TComponent); override; procedure SetLookupRoot(const AValue: TComponent); override;
public public
constructor Create(AOwner: TComponent); override;
procedure DoLoadBounds; override; procedure DoLoadBounds; override;
procedure DoSaveBounds; override; procedure DoSaveBounds; override;
procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
end; end;
@ -50,6 +52,12 @@ implementation
{ TFrameDesignerForm } { TFrameDesignerForm }
constructor TFrameDesignerForm.Create(AOwner: TComponent);
begin
Position := poDefaultPosOnly; // let it be at default position since frame TopLeft is always (0,0)
inherited Create(AOwner);
end;
procedure TFrameDesignerForm.SetLookupRoot(const AValue: TComponent); procedure TFrameDesignerForm.SetLookupRoot(const AValue: TComponent);
begin begin
if (AValue <> nil) and (AValue is TCustomFrame) then if (AValue <> nil) and (AValue is TCustomFrame) then
@ -66,40 +74,41 @@ procedure TFrameDesignerForm.DoLoadBounds;
NewWidth := Max(20, Min(NewWidth, Screen.Width - 50)); NewWidth := Max(20, Min(NewWidth, Screen.Width - 50));
NewHeight := Max(20, Min(NewHeight, Screen.Height - 50)); NewHeight := Max(20, Min(NewHeight, Screen.Height - 50));
SetBounds(Left, Top, Max(20, NewWidth), Max(NewHeight, 20)); SetBounds(NewLeft, NewTop, Max(20, NewWidth), Max(NewHeight, 20));
end; end;
var var
CurFrame: TCustomFrame; CurFrame: TCustomFrame;
NewWidth: Integer;
NewHeight: Integer;
begin begin
inherited; inherited;
if LookupRoot is TCustomFrame then if LookupRoot is TCustomFrame then
begin begin
CurFrame := TCustomFrame(LookupRoot); CurFrame := TCustomFrame(LookupRoot);
NewWidth := CurFrame.Width; SetNewBounds(Left, Top, CurFrame.Width, CurFrame.Height);
NewHeight := CurFrame.Height;
SetNewBounds(Left, Top, NewWidth, NewHeight);
end end
else else
if LookupRoot <> nil then if LookupRoot <> nil then
begin DebugLn(['Unsupported component type in TFrameDesignerForm.DoLoadBounds: ', LookupRoot.ClassName])
// ?
end;
end; end;
procedure TFrameDesignerForm.DoSaveBounds; procedure TFrameDesignerForm.DoSaveBounds;
begin begin
if LookupRoot is TFrame then if LookupRoot is TCustomFrame then
TFrame(LookupRoot).SetBounds(0, 0, Width, Height) TFrame(LookupRoot).SetBounds(0, 0, Width, Height)
else else
if LookupRoot <> nil then if LookupRoot <> nil then
;//? DebugLn(['Unsupported component type in TFrameDesignerForm.DoSaveBounds: ', LookupRoot.ClassName]);
inherited; inherited;
end; end;
procedure TFrameDesignerForm.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
begin
// auto apply width and height
inherited SetBounds(aLeft, aTop, aWidth, aHeight);
if (LookupRoot <> nil) and (LookupRoot is TCustomFrame) then
TCustomFrame(LookupRoot).SetBounds(0, 0, Width, Height);
end;
end. end.