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

IDE: using DesignInfo for frames to store position, LCL: TFrame storing DesignLeft and DesignTop

Browse Source 
git-svn-id: trunk@15227 -
This commit is contained in:
mattias 2008-05-25 20:50:07 +00:00
parent 29eab2b98f
commit a75241f932
3 changed files with 71 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
designer/framedesigner.pas
View File

@ -60,8 +60,8 @@ end;
procedure TFrameDesignerForm.SetLookupRoot(const AValue: TComponent);
begin
if (AValue <> nil) and (AValue is TCustomFrame) then
TCustomFrame(AValue).Parent := Self;
if (AValue is TControl) then
TControl(AValue).Parent := Self;
inherited;
end;
@ -78,15 +78,22 @@ procedure TFrameDesignerForm.DoLoadBounds;
end;
var
CurFrame: TCustomFrame;
CurControl: TControl;
NewLeft: integer;
NewTop: integer;
begin
inherited;
if LookupRoot is TCustomFrame then
if LookupRoot is TControl then
begin
CurFrame := TCustomFrame(LookupRoot);
SetNewBounds(Left, Top, CurFrame.Width, CurFrame.Height);
end
CurControl := TControl(LookupRoot);
// restore designer position
NewLeft:=LongRec(LookupRoot.DesignInfo).Lo;
NewTop:=LongRec(LookupRoot.DesignInfo).Hi;
// resize designer form
SetNewBounds(NewLeft,NewTop,CurControl.Width,CurControl.Height);
DebugLn(['TFrameDesignerForm.DoLoadBounds ',NewLeft,',',NewTop]);
end
else
if LookupRoot <> nil then
DebugLn(['Unsupported component type in TFrameDesignerForm.DoLoadBounds: ', LookupRoot.ClassName])
@ -94,9 +101,14 @@ end;
procedure TFrameDesignerForm.DoSaveBounds;
begin
if LookupRoot is TCustomFrame then
TFrame(LookupRoot).SetBounds(0, 0, Width, Height)
else
if LookupRoot is TControl then begin
// store designer position
LongRec(LookupRoot.DesignInfo).Lo:=Left;
LongRec(LookupRoot.DesignInfo).Hi:=Top;
// always fill the whole designer form
TControl(LookupRoot).SetBounds(0, 0, Width, Height);
DebugLn(['TFrameDesignerForm.DoSaveBounds ',Left,',',Top,' ',LongRec(LookupRoot.DesignInfo).Lo,',',LongRec(LookupRoot.DesignInfo).hi]);
end else
if LookupRoot <> nil then
DebugLn(['Unsupported component type in TFrameDesignerForm.DoSaveBounds: ', LookupRoot.ClassName]);
inherited;
@ -106,8 +118,8 @@ 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);
if (LookupRoot is TControl) then
TControl(LookupRoot).SetBounds(0, 0, Width, Height);
end;
end.

6
lcl/forms.pp
View File

@ -247,15 +247,19 @@ type
private
procedure AddActionList(ActionList: TCustomActionList);
procedure RemoveActionList(ActionList: TCustomActionList);
procedure ReadDesignLeft(Reader: TReader);
procedure ReadDesignTop(Reader: TReader);
procedure WriteDesignLeft(Writer: TWriter);
procedure WriteDesignTop(Writer: TWriter);
protected
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetParent(AParent: TWinControl); override;
class function GetControlClassDefaultSize: TPoint; override;
procedure DefineProperties(Filer: TFiler); override;
public
constructor Create(AOwner: TComponent); override;
procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
end;
TCustomFrameClass = class of TCustomFrame;

53
lcl/include/customframe.inc
View File

@ -38,6 +38,34 @@ begin
ParentForm.FActionLists.Remove(ActionList);
end;
procedure TCustomFrame.ReadDesignLeft(Reader: TReader);
var
Temp: LongInt;
begin
Temp:=DesignInfo;
LongRec(Temp).Lo:=Reader.ReadInteger;
DesignInfo:=Temp;
end;
procedure TCustomFrame.ReadDesignTop(Reader: TReader);
var
Temp: LongInt;
begin
Temp:=DesignInfo;
LongRec(Temp).Hi:=Reader.ReadInteger;
DesignInfo:=Temp;
end;
procedure TCustomFrame.WriteDesignLeft(Writer: TWriter);
begin
Writer.WriteInteger(LongRec(DesignInfo).Lo);
end;
procedure TCustomFrame.WriteDesignTop(Writer: TWriter);
begin
Writer.WriteInteger(LongRec(DesignInfo).Hi);
end;
procedure TCustomFrame.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
I: Integer;
@ -100,6 +128,20 @@ begin
Result.Y:=240;
end;
procedure TCustomFrame.DefineProperties(Filer: TFiler);
Var
Ancestor: TComponent;
Temp: longint;
begin
Temp:=0;
Ancestor:=TComponent(Filer.Ancestor);
if Assigned(Ancestor) then Temp:=Ancestor.DesignInfo;
Filer.Defineproperty('DesignLeft',@ReadDesignLeft,@WriteDesignLeft,
(longrec(DesignInfo).Lo<>Longrec(Temp).Lo));
Filer.Defineproperty('DesignTop',@ReadDesignTop,@WriteDesignTop,
(longrec(DesignInfo).Hi<>Longrec(Temp).Hi));
end;
constructor TCustomFrame.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@ -114,17 +156,6 @@ begin
end;
end;
procedure TCustomFrame.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
begin
if csDesignInstance in ComponentState then
begin
// dont move frame in the designer
aLeft := 0;
aTop := 0;
end;
inherited SetBounds(aLeft, aTop, aWidth, aHeight);
end;
{ TFrame }
function TFrame.LCLVersionIsStored: boolean;