paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-25 13:30:28 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDEIntf: designer mediator: added ComponentIsIcon

Browse Source 
git-svn-id: trunk@21637 -
This commit is contained in:
mattias 2009-09-09 20:16:48 +00:00
parent 72c2e35d4a
commit 2d33a670e1
14 changed files with 542 additions and 253 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

172
designer/controlselection.pp
View File

@ -133,7 +133,6 @@ type
function GetLeft: integer;
procedure SetLeft(ALeft: integer);
function GetTop: integer;
procedure SetOwner(const AValue: TControlSelection);
procedure SetTop(ATop: integer);
function GetWidth: integer;
procedure SetUseCache(const AValue: boolean);
@ -145,9 +144,8 @@ type
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer);
procedure SetFormRelativeBounds(ALeft, ATop, AWidth, AHeight: integer);
procedure GetFormRelativeBounds(var ALeft, ATop, AWidth, AHeight: integer);
procedure GetFormRelativeBounds(var ALeft, ATop, AWidth, AHeight: integer;
StoreAsUsed: boolean);
StoreAsUsed: boolean = false);
procedure SetUsedBounds(ALeft, ATop, AWidth, AHeight: integer);
procedure SaveBounds;
procedure UpdateCache;
@ -157,7 +155,7 @@ type
procedure InvalidateNonVisualPersistent;
property Persistent: TPersistent read FPersistent;
property Owner: TControlSelection read FOwner write SetOwner;
property Owner: TControlSelection read FOwner;
property Left: integer read GetLeft write SetLeft;
property Top: integer read GetTop write SetTop;
property Width: integer read GetWidth write SetWidth;
@ -576,6 +574,8 @@ begin
FIsTControl:=FPersistent is TControl;
FIsTWinControl:=FPersistent is TWinControl;
FIsNonVisualComponent:=FIsTComponent and (not FIsTControl);
if (Owner.Mediator<>nil) and FIsTComponent then
FIsNonVisualComponent:=Owner.Mediator.ComponentIsIcon(TComponent(FPersistent));
if FIsTComponent then
FDesignerForm:=GetDesignerForm(TComponent(FPersistent));
FIsVisible:=FIsTComponent
@ -590,19 +590,24 @@ end;
procedure TSelectedControl.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
begin
if FIsTControl then begin
TControl(FPersistent).Invalidate;
TControl(FPersistent).SetBounds(ALeft, ATop, AWidth, AHeight);
FCachedLeft:=ALeft;
FCachedTop:=ATop;
FCachedWidth:=AWidth;
FCachedHeight:=AHeight;
end else if FIsTComponent then begin
end else if FIsNonVisualComponent then begin
if (Left<>ALeft) or (Top<>ATop) then begin
InvalidateNonVisualPersistent;
Left:=ALeft;
Top:=ATop;
InvalidateNonVisualPersistent;
end;
end else if (Owner.Mediator<>nil) and FIsTComponent then begin
FCachedLeft:=ALeft;
FCachedTop:=ATop;
FCachedWidth:=AWidth;
FCachedHeight:=AHeight;
Owner.Mediator.SetBounds(TComponent(FPersistent),Bounds(ALeft,ATop,AWidth,AHeight));
end;
end;
@ -612,23 +617,39 @@ var
ParentOffset: TPoint;
begin
if not FIsTComponent then exit;
ParentOffset:=
GetParentFormRelativeParentClientOrigin(TComponent(FPersistent));
SetBounds(ALeft-ParentOffset.X,ATop-ParentOffset.Y,AWidth,AHeight);
if Owner.Mediator<>nil then begin
ParentOffset:=Owner.Mediator.GetComponentOriginOnForm(TComponent(FPersistent));
Owner.Mediator.SetBounds(TComponent(FPersistent),
Bounds(ALeft-ParentOffset.X,ATop-ParentOffset.Y,AWidth,AHeight));
end else begin
ParentOffset:=GetParentFormRelativeParentClientOrigin(TComponent(FPersistent));
SetBounds(ALeft-ParentOffset.X,ATop-ParentOffset.Y,AWidth,AHeight);
end;
end;
procedure TSelectedControl.GetFormRelativeBounds(var ALeft, ATop, AWidth,
AHeight: integer);
AHeight: integer; StoreAsUsed: boolean);
var
ALeftTop: TPoint;
CurBounds: TRect;
begin
if FIsTComponent then
begin
ALeftTop := GetParentFormRelativeTopLeft(TComponent(FPersistent));
ALeft := ALeftTop.X;
ATop := ALeftTop.Y;
AWidth := GetComponentWidth(TComponent(FPersistent));
AHeight := GetComponentHeight(TComponent(FPersistent));
if Owner.Mediator<>nil then begin
ALeftTop:=Owner.Mediator.GetComponentOriginOnForm(TComponent(FPersistent));
Owner.Mediator.GetBounds(TComponent(FPersistent),CurBounds);
OffsetRect(CurBounds,ALeftTop.X,ALeftTop.Y);
ALeft:=CurBounds.Left;
ATop:=CurBounds.Top;
AWidth:=CurBounds.Right-CurBounds.Left;
AHeight:=CurBounds.Bottom-CurBounds.Top;
end else begin
ALeftTop := GetParentFormRelativeTopLeft(TComponent(FPersistent));
ALeft := ALeftTop.X;
ATop := ALeftTop.Y;
AWidth := GetComponentWidth(TComponent(FPersistent));
AHeight := GetComponentHeight(TComponent(FPersistent));
end;
end else
begin
ALeft := 0;
@ -636,12 +657,6 @@ begin
AWidth := 0;
AHeight := 0;
end;
end;
procedure TSelectedControl.GetFormRelativeBounds(var ALeft, ATop, AWidth,
AHeight: integer; StoreAsUsed: boolean);
begin
GetFormRelativeBounds(ALeft, ATop, AWidth, AHeight);
if StoreAsUsed then
SetUsedBounds(ALeft, ATop, AWidth, AHeight);
end;
@ -655,12 +670,22 @@ begin
end;
procedure TSelectedControl.SaveBounds;
var
r: TRect;
begin
if not FIsTComponent then exit;
GetComponentBounds(TComponent(FPersistent),
FOldLeft,FOldTop,FOldWidth,FOldHeight);
FOldFormRelativeLeftTop:=
if Owner.Mediator<>nil then begin
Owner.Mediator.GetBounds(TComponent(FPersistent),r);
FOldLeft:=r.Left;
FOldTop:=r.Top;
FOldWidth:=r.Right-r.Left;
FOldHeight:=r.Bottom-r.Top;
end else begin
GetComponentBounds(TComponent(FPersistent),
FOldLeft,FOldTop,FOldWidth,FOldHeight);
FOldFormRelativeLeftTop:=
GetParentFormRelativeTopLeft(TComponent(FPersistent));
end;
end;
procedure TSelectedControl.UpdateCache;
@ -717,67 +742,99 @@ begin
end;
function TSelectedControl.GetLeft: integer;
var
r: TRect;
begin
if FUseCache then
Result:=FCachedLeft
else if FIsTComponent then
Result:=GetComponentLeft(TComponent(FPersistent))
else
else if FIsTComponent then begin
if Owner.Mediator<>nil then begin
Owner.Mediator.GetBounds(TComponent(FPersistent),r);
Result:=r.Left;
end else begin
Result:=GetComponentLeft(TComponent(FPersistent))
end;
end else
Result:=0;
end;
procedure TSelectedControl.SetLeft(ALeft: Integer);
var
r: TRect;
begin
if FIsTControl then
TControl(FPersistent).Left := Aleft
else
if FIsTComponent then
begin
ALeft := Max(Low(SmallInt), Min(ALeft, High(SmallInt)));
TComponent(FPersistent).DesignInfo := DesignInfoFrom(ALeft, Top);
if Owner.Mediator<>nil then begin
Owner.Mediator.GetBounds(TComponent(FPersistent),r);
r.Left:=ALeft;
Owner.Mediator.SetBounds(TComponent(FPersistent),r)
end else begin
ALeft := Max(Low(SmallInt), Min(ALeft, High(SmallInt)));
TComponent(FPersistent).DesignInfo := LeftTopToDesignInfo(ALeft, Top);
end;
end;
FCachedLeft := ALeft;
end;
function TSelectedControl.GetTop: integer;
var
r: TRect;
begin
if FUseCache then
Result := FCachedTop
else
if FIsTComponent then
Result := GetComponentTop(TComponent(FPersistent))
else
if FIsTComponent then begin
if Owner.Mediator<>nil then begin
Owner.Mediator.GetBounds(TComponent(FPersistent),r);
Result:=r.Top;
end else begin
Result := GetComponentTop(TComponent(FPersistent));
end;
end else
Result := 0;
end;
procedure TSelectedControl.SetOwner(const AValue: TControlSelection);
begin
if FOwner=AValue then exit;
FOwner:=AValue;
end;
procedure TSelectedControl.SetTop(ATop: integer);
var
r: TRect;
begin
if FIsTControl then
TControl(FPersistent).Top := ATop
else
if FIsTComponent then
begin
ATop := Max(Low(SmallInt), Min(ATop, High(SmallInt)));
TComponent(FPersistent).DesignInfo := DesignInfoFrom(Left, ATop);
if Owner.Mediator<>nil then begin
Owner.Mediator.GetBounds(TComponent(FPersistent),r);
r.Top:=ATop;
Owner.Mediator.SetBounds(TComponent(FPersistent),r);
end else begin
ATop := Max(Low(SmallInt), Min(ATop, High(SmallInt)));
TComponent(FPersistent).DesignInfo := LeftTopToDesignInfo(Left, ATop);
end;
end;
FCachedTop := ATop;
end;
function TSelectedControl.GetWidth: integer;
var
r: TRect;
begin
if FUseCache then
Result := FCachedWidth
else
if FIsTComponent then
Result := GetComponentWidth(TComponent(FPersistent));
if FIsTComponent then begin
if Owner.Mediator<>nil then begin
Owner.Mediator.GetBounds(TComponent(FPersistent),r);
Result:=r.Right-r.Left;
end else begin
Result := GetComponentWidth(TComponent(FPersistent));
end;
end;
end;
procedure TSelectedControl.SetUseCache(const AValue: boolean);
@ -788,27 +845,48 @@ begin
end;
procedure TSelectedControl.SetWidth(AWidth: integer);
var
r: TRect;
begin
if FIsTControl then
TControl(FPersistent).Width:=AWidth;
TControl(FPersistent).Width:=AWidth
else if FIsTComponent and (Owner.Mediator<>nil) then begin
Owner.Mediator.GetBounds(TComponent(FPersistent),r);
r.Right:=r.Left+AWidth;
Owner.Mediator.SetBounds(TComponent(FPersistent),r);
end;
FCachedWidth:=AWidth;
end;
function TSelectedControl.GetHeight: integer;
var
r: TRect;
begin
if FUseCache then
Result := FCachedHeight
else
if FIsTComponent then
Result := GetComponentHeight(TComponent(FPersistent))
else
if FIsTComponent then begin
if Owner.Mediator<>nil then begin
Owner.Mediator.GetBounds(TComponent(FPersistent),r);
Result:=r.Bottom-r.Top;
end else begin
Result := GetComponentHeight(TComponent(FPersistent));
end;
end else
Result:=0;
end;
procedure TSelectedControl.SetHeight(AHeight: integer);
var
r: TRect;
begin
if FIsTControl then
TControl(FPersistent).Height:=AHeight;
TControl(FPersistent).Height:=AHeight
else if FIsTComponent and (Owner.Mediator<>nil) then begin
Owner.Mediator.GetBounds(TComponent(FPersistent),r);
r.Bottom:=r.Top+AHeight;
Owner.Mediator.SetBounds(TComponent(FPersistent),r);
end;
FCachedHeight:=AHeight;
end;

20
designer/designer.pp
View File

@ -279,6 +279,7 @@ type
procedure DrawDesignerItems(OnlyIfNeeded: boolean); override;
procedure CheckFormBounds;
procedure DoPaintDesignerItems;
function ComponentIsIcon(AComponent: TComponent): boolean;
public
property Flags: TDesignerFlags read FFlags;
property GridSizeX: integer read GetGridSizeX write SetGridSizeX;
@ -843,7 +844,7 @@ var
or (P.Y+NonVisualCompWidth>Form.ClientHeight) then
break;
until false;
AComponent.DesignInfo := DesignInfoFrom(
AComponent.DesignInfo := LeftTopToDesignInfo(
SmallInt(Max(0, Min(P.x, Form.ClientWidth - NonVisualCompWidth))),
SmallInt(Max(0, Min(P.y, Form.ClientHeight - NonVisualCompWidth))));
end;
@ -2534,7 +2535,7 @@ begin
for i := 0 to FLookupRoot.ComponentCount - 1 do
begin
AComponent := FLookupRoot.Components[i];
if ComponentIsNonVisual(AComponent) then
if ComponentIsIcon(AComponent) then
begin
Diff := aDDC.FormOrigin;
//DebugLn(['aDDC.FormOrigin - ', Diff.X, ' : ' ,Diff.Y]);
@ -2664,6 +2665,13 @@ begin
end;
end;
function TDesigner.ComponentIsIcon(AComponent: TComponent): boolean;
begin
Result:=DesignerProcs.ComponentIsNonVisual(AComponent);
if Result and (Mediator<>nil) then
Result:=Mediator.ComponentIsIcon(AComponent);
end;
function TDesigner.GetDesignedComponent(AComponent: TComponent): TComponent;
begin
Result:=AComponent;
@ -2715,8 +2723,7 @@ var i: integer;
begin
for i:=FLookupRoot.ComponentCount-1 downto 0 do begin
Result:=FLookupRoot.Components[i];
if (not (Result is TControl))
and (not ComponentIsInvisible(Result)) then begin
if ComponentIsIcon(Result) then begin
with Result do begin
LeftTop:=NonVisualComponentLeftTop(Result);
if (LeftTop.x<=x) and (LeftTop.y<=y)
@ -2732,7 +2739,7 @@ end;
procedure TDesigner.MoveNonVisualComponentIntoForm(AComponent: TComponent);
begin
with NonVisualComponentLeftTop(AComponent) do
AComponent.DesignInfo := DesignInfoFrom(x, y);
AComponent.DesignInfo := LeftTopToDesignInfo(x, y);
end;
procedure TDesigner.MoveNonVisualComponentsIntoForm;
@ -2742,8 +2749,7 @@ var
begin
for i:=0 to FLookupRoot.ComponentCount-1 do begin
AComponent:=FLookupRoot.Components[i];
if (not (AComponent is TControl))
and (not ComponentIsInvisible(AComponent)) then begin
if ComponentIsIcon(AComponent) then begin
MoveNonVisualComponentIntoForm(AComponent);
end;
end;

97
designer/designerprocs.pas
View File

@ -112,16 +112,6 @@ function GetComponentHeight(AComponent: TComponent): integer;
procedure InvalidateDesignerRect(aHandle: HWND; ARect: pRect);
function DesignInfoFrom(const ALeft, ATop: SmallInt): LongInt;
procedure DesignInfoTo(ADesignInfo: LongInt; out ALeft, ATop: SmallInt);
function LeftFromDesignInfo(ADesignInfo: LongInt): SmallInt;
function TopFromDesignInfo(ADesignInfo: LongInt): SmallInt;
procedure GetComponentLeftTopOrDesignInfo(AComponent: TComponent; out aLeft, aTop: integer); // get properties if exists, otherwise get DesignInfo
procedure SetComponentLeftTopOrDesignInfo(AComponent: TComponent; aLeft, aTop: integer); // set properties if exists, otherwise set DesignInfo
function TrySetOrdProp(Instance: TPersistent; const PropName: string;
Value: integer): boolean;
function TryGetOrdProp(Instance: TPersistent; const PropName: string;
out Value: integer): boolean;
implementation
@ -329,93 +319,6 @@ begin
end;
end;
function DesignInfoFrom(const ALeft, ATop: SmallInt): LongInt;
var
ResultRec: packed record
Left: SmallInt;
Top: SmallInt;
end absolute Result;
begin
ResultRec.Left := ALeft;
ResultRec.Top := ATop;
end;
procedure DesignInfoTo(ADesignInfo: LongInt; out ALeft, ATop: SmallInt);
var
DesignInfoRec: packed record
Left: SmallInt;
Top: SmallInt;
end absolute ADesignInfo;
begin
ALeft := DesignInfoRec.Left;
ATop := DesignInfoRec.Top;
end;
function LeftFromDesignInfo(ADesignInfo: LongInt): SmallInt;
var
DesignInfoRec: packed record
Left: SmallInt;
Top: SmallInt;
end absolute ADesignInfo;
begin
Result := DesignInfoRec.Left;
end;
function TopFromDesignInfo(ADesignInfo: LongInt): SmallInt;
var
DesignInfoRec: packed record
Left: SmallInt;
Top: SmallInt;
end absolute ADesignInfo;
begin
Result := DesignInfoRec.Top;
end;
procedure GetComponentLeftTopOrDesignInfo(AComponent: TComponent; out aLeft,
aTop: integer);
var
Info: LongInt;
begin
Info:=AComponent.DesignInfo;
if not TryGetOrdProp(AComponent,'Left',aLeft) then
aLeft:=LeftFromDesignInfo(Info);
if not TryGetOrdProp(AComponent,'Top',aTop) then
aTop:=TopFromDesignInfo(Info);
end;
procedure SetComponentLeftTopOrDesignInfo(AComponent: TComponent;
aLeft, aTop: integer);
var
HasLeft: Boolean;
HasTop: Boolean;
begin
HasLeft:=TrySetOrdProp(AComponent,'Left',aLeft);
HasTop:=TrySetOrdProp(AComponent,'Top',aTop);
if HasLeft and HasTop then exit;
AComponent.DesignInfo:=DesignInfoFrom(aLeft,aTop);
end;
function TrySetOrdProp(Instance: TPersistent; const PropName: string;
Value: integer): boolean;
var
PropInfo: PPropInfo;
begin
PropInfo:=GetPropInfo(Instance.ClassType,PropName);
if PropInfo=nil then exit(false);
SetOrdProp(Instance,PropInfo,Value);
Result:=true;
end;
function TryGetOrdProp(Instance: TPersistent; const PropName: string; out
Value: integer): boolean;
var
PropInfo: PPropInfo;
begin
PropInfo:=GetPropInfo(Instance.ClassType,PropName);
if PropInfo=nil then exit(false);
Value:=GetOrdProp(Instance,PropInfo);
Result:=true;
end;
{ TDesignerDeviceContext }

6
designer/framedesigner.pas
View File

@ -31,7 +31,7 @@ interface
uses
Classes, SysUtils, Math, LCLProc, Graphics, GraphType, Forms, Controls,
IDEProcs, DesignerProcs, CustomNonFormDesigner;
FormEditingIntf, IDEProcs, DesignerProcs, CustomNonFormDesigner;
type
@ -146,7 +146,7 @@ begin
begin
CurControl := TControl(LookupRoot);
// restore designer position
DesignInfoTo(LookupRoot.DesignInfo, NewLeft, NewTop);
DesignInfoToLeftTop(LookupRoot.DesignInfo, NewLeft, NewTop);
// resize designer form
SetNewBounds(NewLeft,NewTop,CurControl.Width,CurControl.Height);
//DebugLn(['TFrameDesignerForm.DoLoadBounds ',NewLeft,',',NewTop]);
@ -161,7 +161,7 @@ begin
if LookupRoot is TControl then
begin
// store designer position
LookupRoot.DesignInfo := DesignInfoFrom(Left, Top);
LookupRoot.DesignInfo := LeftTopToDesignInfo(Left, 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]);

23
designer/noncontroldesigner.pas
View File

@ -46,6 +46,7 @@ type
procedure SetMediator(const AValue: TDesignerMediator);
protected
procedure SetFrameWidth(const AValue: integer); virtual;
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -79,6 +80,14 @@ begin
Invalidate;
end;
procedure TNonControlDesignerForm.DoSetBounds(ALeft, ATop, AWidth,
AHeight: integer);
begin
inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
if Mediator<>nil then
Mediator.SetFormBounds(LookupRoot,BoundsRect,ClientRect);
end;
constructor TNonControlDesignerForm.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@ -113,7 +122,7 @@ begin
Pen.Color:=clBlack;
Frame3d(ARect, FrameWidth, bvLowered);
if Mediator<>nil then
Mediator.Paint(ClientRect);
Mediator.Paint;
end;
end;
@ -137,7 +146,7 @@ var
CurDataModule: TDataModule;
NewLeft, NewTop: integer;
NewWidth, NewHeight: Integer;
NewBounds: TRect;
NewBounds, NewClientRect: TRect;
begin
inherited DoLoadBounds;
@ -154,11 +163,17 @@ begin
if LookupRoot <> nil then
begin
if Mediator<>nil then begin
Mediator.GetBounds(LookupRoot,NewBounds);
Mediator.GetFormBounds(LookupRoot,NewBounds,NewClientRect);
NewLeft:=NewBounds.Left;
NewTop:=NewBounds.Top;
NewWidth:=NewBounds.Right-NewBounds.Left;
NewHeight:=NewBounds.Bottom-NewBounds.Top;
if (NewClientRect.Left<>NewClientRect.Right)
or (NewClientRect.Top<>NewClientRect.Bottom) then begin
// use the clientrect (the Width, Height depends on window theme)
NewWidth:=NewClientRect.Right-NewClientRect.Left+Width-ClientWidth;
NewHeight:=NewClientRect.Bottom-NewClientRect.Top+Height-ClientHeight;
end;
end else begin
GetComponentLeftTopOrDesignInfo(LookupRoot,NewLeft,NewTop);
NewWidth:=Width;
@ -179,7 +194,7 @@ begin
end else if LookupRoot<>nil then begin
//debugln(['TNonControlDesignerForm.DoSaveBounds ',dbgsName(LookupRoot),' ',dbgs(Left),',',dbgs(Top),' ',DbgSName(Mediator)]);
if Mediator<>nil then begin
Mediator.SetBounds(LookupRoot,BoundsRect);
Mediator.SetFormBounds(LookupRoot,BoundsRect,ClientRect);
end else begin
SetComponentLeftTopOrDesignInfo(LookupRoot,Left,Top);
end;

40
examples/designnonlcl/mywidgetdesigner.pas
View File

@ -52,7 +52,10 @@ type
class function FormClass: TComponentClass; override;
procedure GetBounds(AComponent: TComponent; out CurBounds: TRect); override;
procedure SetBounds(AComponent: TComponent; NewBounds: TRect); override;
procedure Paint(aRect: TRect); override;
procedure Paint; override;
function ComponentIsIcon(AComponent: TComponent): boolean; override;
function ParentAcceptsChild(Parent: TComponent;
Child: TComponentClass): boolean; override;
public
// needed by TMyWidget
constructor Create(AOwner: TComponent); override;
@ -68,6 +71,7 @@ implementation
procedure Register;
begin
FormEditingHook.RegisterDesignerMediator(TMyWidgetMediator);
RegisterComponents('MyWidgets',[TMyButton,TMyGroupBox]);
end;
{ TMyWidgetMediator }
@ -102,7 +106,8 @@ begin
if AComponent is TMyWidget then begin
w:=TMyWidget(AComponent);
CurBounds:=Bounds(w.Left,w.Top,w.Width,w.Height);
end;
end else
inherited GetBounds(AComponent,CurBounds);
end;
procedure TMyWidgetMediator.InvalidateRect(Sender: TObject; ARect: TRect;
@ -115,12 +120,14 @@ end;
procedure TMyWidgetMediator.SetBounds(AComponent: TComponent; NewBounds: TRect
);
begin
if AComponent is TMyWidget then
if AComponent is TMyWidget then begin
TMyWidget(AComponent).SetBounds(NewBounds.Left,NewBounds.Top,
NewBounds.Right-NewBounds.Left,NewBounds.Bottom-NewBounds.Top);
end else
inherited SetBounds(AComponent,NewBounds);
end;
procedure TMyWidgetMediator.Paint(aRect: TRect);
procedure TMyWidgetMediator.Paint;
procedure PaintWidget(AWidget: TMyWidget);
var
@ -139,10 +146,12 @@ procedure TMyWidgetMediator.Paint(aRect: TRect);
Pen.Color:=clRed;
Rectangle(0,0,AWidget.Width,AWidget.Height);
// inner frame
Pen.Color:=clMaroon;
Rectangle(AWidget.BorderLeft,AWidget.BorderTop,
AWidget.Width-AWidget.BorderRight,
AWidget.Height-AWidget.BorderBottom);
if AWidget.AcceptChildsAtDesignTime then begin
Pen.Color:=clMaroon;
Rectangle(AWidget.BorderLeft,AWidget.BorderTop,
AWidget.Width-AWidget.BorderRight,
AWidget.Height-AWidget.BorderBottom);
end;
// caption
TextOut(5,2,AWidget.Caption);
// childs
@ -170,9 +179,20 @@ procedure TMyWidgetMediator.Paint(aRect: TRect);
end;
begin
//debugln(['TMyWidgetMediator.Paint ',dbgs(aRect)]);
PaintWidget(MyForm);
inherited Paint(aRect);
inherited Paint;
end;
function TMyWidgetMediator.ComponentIsIcon(AComponent: TComponent): boolean;
begin
Result:=not (AComponent is TMyWidget);
end;
function TMyWidgetMediator.ParentAcceptsChild(Parent: TComponent;
Child: TComponentClass): boolean;
begin
Result:=(Parent is TMyWidget) and (Child.InheritsFrom(TMyWidget))
and (TMyWidget(Parent).AcceptChildsAtDesignTime);
end;
end.

51
examples/designnonlcl/mywidgetset.pas
View File

@ -51,6 +51,7 @@ type
TMyWidget = class(TComponent)
private
FAcceptChildsAtDesignTime: boolean;
FBorderBottom: integer;
FBorderLeft: integer;
FBorderRight: integer;
@ -77,6 +78,10 @@ type
procedure SetWidth(const AValue: integer);
protected
procedure InternalInvalidateRect(ARect: TRect; Erase: boolean); virtual;
procedure SetName(const NewName: TComponentName); override;
procedure SetParentComponent(Value: TComponent); override;
function HasParent: Boolean; override;
function GetParentComponent: TComponent; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -86,6 +91,7 @@ type
procedure SetBounds(NewLeft, NewTop, NewWidth, NewHeight: integer); virtual;
procedure InvalidateRect(ARect: TRect; Erase: boolean);
procedure Invalidate;
property AcceptChildsAtDesignTime: boolean read FAcceptChildsAtDesignTime;
published
property Left: integer read FLeft write SetLeft;
property Top: integer read FTop write SetTop;
@ -112,6 +118,20 @@ type
property Designer: IMyWidgetDesigner read FDesigner write FDesigner;
end;
{ TMyButton
A widget that does not allow childs at design time }
TMyButton = class(TMyWidget)
public
constructor Create(AOwner: TComponent); override;
end;
{ TMyGroupBox
A widget that does allow childs at design time }
TMyGroupBox = class(TMyWidget)
end;
implementation
{ TMyWidget }
@ -199,7 +219,29 @@ end;
procedure TMyWidget.InternalInvalidateRect(ARect: TRect; Erase: boolean);
begin
// see TMyForm
end;
procedure TMyWidget.SetName(const NewName: TComponentName);
begin
if Name=Caption then Caption:=NewName;
inherited SetName(NewName);
end;
procedure TMyWidget.SetParentComponent(Value: TComponent);
begin
if Value is TMyWidget then
Parent:=TMyWidget(Value);
end;
function TMyWidget.HasParent: Boolean;
begin
Result:=Parent<>nil;
end;
function TMyWidget.GetParentComponent: TComponent;
begin
Result:=Parent;
end;
constructor TMyWidget.Create(AOwner: TComponent);
@ -210,6 +252,7 @@ begin
FBorderRight:=5;
FBorderBottom:=5;
FBorderTop:=20;
FAcceptChildsAtDesignTime:=true;
end;
destructor TMyWidget.Destroy;
@ -269,5 +312,13 @@ begin
inherited Create(AOwner);
end;
{ TMyButton }
constructor TMyButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAcceptChildsAtDesignTime:=false;
end;
end.

1
examples/designnonlcl/project/NonLCL1.lpi
View File

@ -32,6 +32,7 @@
<Item1>
<PackageName Value="NotLCLDesigner"/>
<MinVersion Valid="True"/>
<DefaultFilename Value="../notlcldesigner.lpk"/>
</Item1>
</RequiredPackages>
<Units Count="2">

4
examples/designnonlcl/project/unit1.lfm
View File

@ -1,8 +1,8 @@
object MyForm1: TMyForm1
Left = 319
Top = 231
Width = 400
Height = 300
Width = 322
Height = 236
Visible = False
Caption = 'MyForm1'
end

6
examples/designnonlcl/project/unit1.lrs
View File

@ -1,4 +1,6 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TMyForm1','FORMDATA',[
'TPF0'#8'TMyForm1'#7'MyForm1'#4'Left'#3'?'#1#3'Top'#3#231#0#5'Width'#3#144#1#6
+'Height'#3','#1#7'Visible'#8#7'Caption'#6#7'MyForm1'#0#0
'TPF0'#8'TMyForm1'#7'MyForm1'#4'Left'#3'?'#1#3'Top'#3#231#0#5'Width'#3'B'#1#6
+'Height'#3#236#0#7'Visible'#8#7'Caption'#6#7'MyForm1'#0#0
]);

1
examples/designnonlcl/project/unit1.pas
View File

@ -9,6 +9,7 @@ uses
type
TMyForm1 = class(TMyForm)
MyButton1: TMyButton;
private
{ private declarations }
public

160
ide/customformeditor.pp
View File

@ -1727,7 +1727,7 @@ begin
end else begin
// no parent and not a form
AControl.SetBounds(0,0,CompWidth,CompHeight);
AControl.DesignInfo := DesignInfoFrom(CompLeft, CompTop);
AControl.DesignInfo := LeftTopToDesignInfo(CompLeft, CompTop);
//DebugLn(['TCustomFormEditor.CreateComponent ',dbgsName(AControl),' ',LongRec(AControl.DesignInfo).Lo,',',LongRec(AControl.DesignInfo).Hi]);
end;
end
@ -2581,6 +2581,7 @@ function TCustomFormEditor.GetDefaultComponentParent(TypeClass: TComponentClass
var
NewParent: TComponent;
Root: TPersistent;
Mediator: TDesignerMediator;
begin
Result:=nil;
// find selected component
@ -2603,8 +2604,19 @@ begin
// New TypeClass or selected component is not a TControl =>
// use Root component as parent
Root:=GetLookupRootForComponent(NewParent);
if Root is TComponent then
NewParent:=TComponent(Root);
if Root is TComponent then begin
Mediator:=GetDesignerMediatorByComponent(TComponent(Root));
if (Mediator<>nil) then begin
while (NewParent<>nil) do begin
if Mediator.ParentAcceptsChild(NewParent,TypeClass) then
break;
NewParent:=NewParent.GetParentComponent;
end;
if NewParent=nil then
NewParent:=TComponent(Root);
end else
NewParent:=TComponent(Root);
end;
end;
end;
if NewParent<>nil then
@ -2625,86 +2637,82 @@ var
MaxX: Integer;
MaxY: Integer;
begin
// TODO: Frames
Result:=true;
X:=10;
Y:=10;
if ParentCI=nil then
ParentCI:=GetDefaultComponentParent(TypeClass);
if (ParentCI=nil) or (ParentCI.Component=nil) then exit;
if TypeClass<>nil then begin
if not (TypeClass.InheritsFrom(TControl)) then begin
// a non visual component
// put it somewhere right or below the other non visual components
ParentComponent:=ParentCI.Component;
MinX:=-1;
MinY:=-1;
if (ParentComponent is TWinControl) then
begin
MaxX:=TWinControl(ParentComponent).ClientWidth-ComponentPaletteBtnWidth;
MaxY:=TWinControl(ParentComponent).ClientHeight-ComponentPaletteBtnHeight;
end else
begin
AForm:=FindNonFormForm(ParentComponent);
if AForm<>nil then begin
MaxX:=AForm.ClientWidth-ComponentPaletteBtnWidth;
MaxY:=AForm.ClientHeight-ComponentPaletteBtnHeight;
end else begin
MaxX:=300;
MaxY:=0;
end;
end;
// find top left most non visual component
for i:=0 to ParentComponent.ComponentCount-1 do begin
CurComponent:=ParentComponent.Components[i];
if ComponentIsNonVisual(CurComponent) then begin
P:=GetParentFormRelativeTopLeft(CurComponent);
if (P.X>=0) and (P.Y>=0) then begin
if (MinX<0) or (P.Y<MinY) or ((P.Y=MinY) and (P.X<MinX)) then begin
MinX:=P.X;
MinY:=P.Y;
end;
end;
end;
end;
if MinX<0 then begin
MinX:=10;
MinY:=10;
end;
// find a position without intersection
X:=MinX;
Y:=MinY;
//debugln('TCustomFormEditor.GetDefaultComponentPosition Min=',dbgs(MinX),',',dbgs(MinY));
i:=0;
while i<ParentComponent.ComponentCount do begin
CurComponent:=ParentComponent.Components[i];
inc(i);
if ComponentIsNonVisual(CurComponent) then begin
P:=GetParentFormRelativeTopLeft(CurComponent);
//debugln('TCustomFormEditor.GetDefaultComponentPosition ',dbgsName(CurComponent),' P=',dbgs(P));
if (P.X>=0) and (P.Y>=0) then begin
if (X+ComponentPaletteBtnWidth>=P.X)
and (X<=P.X+ComponentPaletteBtnWidth)
and (Y+ComponentPaletteBtnHeight>=P.Y)
and (Y<=P.Y+ComponentPaletteBtnHeight) then begin
// intersection found
// move position
inc(X,ComponentPaletteBtnWidth+2);
if X>MaxX then begin
inc(Y,ComponentPaletteBtnHeight+2);
X:=MinX;
end;
// restart intersection test
i:=0;
end;
end;
end;
end;
// keep it visible
if X>MaxX then X:=MaxX;
if Y>MaxY then Y:=MaxY;
if (ParentCI=nil) or (ParentCI.Component=nil) or (TypeClass=nil) then exit;
if (TypeClass.InheritsFrom(TControl)) then exit;
// a non visual component
// put it somewhere right or below the other non visual components
ParentComponent:=ParentCI.Component;
MinX:=-1;
MinY:=-1;
if (ParentComponent is TWinControl) then
begin
MaxX:=TWinControl(ParentComponent).ClientWidth-ComponentPaletteBtnWidth;
MaxY:=TWinControl(ParentComponent).ClientHeight-ComponentPaletteBtnHeight;
end else
begin
AForm:=FindNonFormForm(ParentComponent);
if AForm<>nil then begin
MaxX:=AForm.ClientWidth-ComponentPaletteBtnWidth;
MaxY:=AForm.ClientHeight-ComponentPaletteBtnHeight;
end else begin
MaxX:=300;
MaxY:=0;
end;
end;
// find top left most non visual component
for i:=0 to ParentComponent.ComponentCount-1 do begin
CurComponent:=ParentComponent.Components[i];
if ComponentIsNonVisual(CurComponent) then begin
P:=GetParentFormRelativeTopLeft(CurComponent);
if (P.X>=0) and (P.Y>=0) then begin
if (MinX<0) or (P.Y<MinY) or ((P.Y=MinY) and (P.X<MinX)) then begin
MinX:=P.X;
MinY:=P.Y;
end;
end;
end;
end;
if MinX<0 then begin
MinX:=10;
MinY:=10;
end;
// find a position without intersection
X:=MinX;
Y:=MinY;
//debugln('TCustomFormEditor.GetDefaultComponentPosition Min=',dbgs(MinX),',',dbgs(MinY));
i:=0;
while i<ParentComponent.ComponentCount do begin
CurComponent:=ParentComponent.Components[i];
inc(i);
if ComponentIsNonVisual(CurComponent) then begin
P:=GetParentFormRelativeTopLeft(CurComponent);
//debugln('TCustomFormEditor.GetDefaultComponentPosition ',dbgsName(CurComponent),' P=',dbgs(P));
if (P.X>=0) and (P.Y>=0) then begin
if (X+ComponentPaletteBtnWidth>=P.X)
and (X<=P.X+ComponentPaletteBtnWidth)
and (Y+ComponentPaletteBtnHeight>=P.Y)
and (Y<=P.Y+ComponentPaletteBtnHeight) then begin
// intersection found
// move position
inc(X,ComponentPaletteBtnWidth+2);
if X>MaxX then begin
inc(Y,ComponentPaletteBtnHeight+2);
X:=MinX;
end;
// restart intersection test
i:=0;
end;
end;
end;
end;
// keep it visible
if X>MaxX then X:=MaxX;
if Y>MaxY then Y:=MaxY;
end;
procedure TCustomFormEditor.OnObjectInspectorModified(Sender: TObject);

14
ide/formeditor.pp
View File

@ -44,6 +44,8 @@ type
public
procedure PaintAllDesignerItems;
procedure CheckDesignerPositions;
function GetDesignerMediatorByComponent(AComponent: TComponent
): TDesignerMediator; override;
end;
var
@ -116,4 +118,16 @@ begin
end;
end;
function TFormEditor.GetDesignerMediatorByComponent(AComponent: TComponent
): TDesignerMediator;
var
ADesigner: TIDesigner;
begin
ADesigner:=GetDesignerByComponent(AComponent);
if ADesigner is TDesigner then
Result:=TDesigner(ADesigner).Mediator
else
Result:=nil;
end;
end.

200
ideintf/formeditingintf.pas
View File

@ -22,7 +22,8 @@ unit FormEditingIntf;
interface
uses
Classes, SysUtils, TypInfo, Forms, Controls, ProjectIntf, ComponentEditors;
Math, Classes, SysUtils, LCLProc, TypInfo, types, Forms, Controls,
ProjectIntf, ComponentEditors;
const
ComponentPaletteImageWidth = 24;
@ -101,9 +102,16 @@ type
class function CreateMediator(TheOwner, aForm: TComponent): TDesignerMediator; virtual; abstract;
class procedure InitFormInstance(aForm: TComponent); virtual; // called after NewInstance, before constructor
public
procedure SetBounds(AComponent: TComponent; NewBounds: TRect); virtual; abstract;
procedure GetBounds(AComponent: TComponent; out CurBounds: TRect); virtual; abstract;
procedure Paint(aRect: TRect); virtual;
procedure SetBounds(AComponent: TComponent; NewBounds: TRect); virtual;
procedure GetBounds(AComponent: TComponent; out CurBounds: TRect); virtual;
procedure SetFormBounds(RootComponent: TComponent; NewBounds, ClientRect: TRect); virtual;
procedure GetFormBounds(RootComponent: TComponent; out CurBounds, CurClientRect: TRect); virtual;
procedure GetClientArea(AComponent: TComponent; out CurClientArea: TRect;
out ScrollOffset: TPoint); virtual;
function GetComponentOriginOnForm(AComponent: TComponent): TPoint; virtual;
procedure Paint; virtual;
function ComponentIsIcon(AComponent: TComponent): boolean; virtual;
function ParentAcceptsChild(Parent: TComponent; Child: TComponentClass): boolean; virtual;
property LCLForm: TForm read FLCLForm write SetLCLForm;
property Designer: TComponentEditorDesigner read FDesigner write SetDesigner;
end;
@ -168,6 +176,7 @@ type
procedure UnregisterDesignerMediator(MediatorClass: TDesignerMediatorClass); virtual; abstract; // auto calls UnregisterDesignerBaseClass
function DesignerMediatorCount: integer; virtual; abstract;
property DesignerMediators[Index: integer]: TDesignerMediatorClass read GetDesignerMediators;
function GetDesignerMediatorByComponent(AComponent: TComponent): TDesignerMediator; virtual; abstract;
// selection
function SaveSelectionToStream(s: TStream): Boolean; virtual; abstract;
@ -190,8 +199,111 @@ type
var
FormEditingHook: TAbstractFormEditor; // will be set by the IDE
procedure GetComponentLeftTopOrDesignInfo(AComponent: TComponent; out aLeft, aTop: integer); // get properties if exists, otherwise get DesignInfo
procedure SetComponentLeftTopOrDesignInfo(AComponent: TComponent; aLeft, aTop: integer); // set properties if exists, otherwise set DesignInfo
function TrySetOrdProp(Instance: TPersistent; const PropName: string;
Value: integer): boolean;
function TryGetOrdProp(Instance: TPersistent; const PropName: string;
out Value: integer): boolean;
function LeftFromDesignInfo(ADesignInfo: LongInt): SmallInt;
function TopFromDesignInfo(ADesignInfo: LongInt): SmallInt;
function LeftTopToDesignInfo(const ALeft, ATop: SmallInt): LongInt;
procedure DesignInfoToLeftTop(ADesignInfo: LongInt; out ALeft, ATop: SmallInt);
implementation
procedure GetComponentLeftTopOrDesignInfo(AComponent: TComponent; out aLeft,
aTop: integer);
var
Info: LongInt;
begin
Info:=AComponent.DesignInfo;
if not TryGetOrdProp(AComponent,'Left',aLeft) then
aLeft:=LeftFromDesignInfo(Info);
if not TryGetOrdProp(AComponent,'Top',aTop) then
aTop:=TopFromDesignInfo(Info);
end;
procedure SetComponentLeftTopOrDesignInfo(AComponent: TComponent;
aLeft, aTop: integer);
var
HasLeft: Boolean;
HasTop: Boolean;
begin
HasLeft:=TrySetOrdProp(AComponent,'Left',aLeft);
HasTop:=TrySetOrdProp(AComponent,'Top',aTop);
if HasLeft and HasTop then exit;
ALeft := Max(Low(SmallInt), Min(ALeft, High(SmallInt)));
ATop := Max(Low(SmallInt), Min(ATop, High(SmallInt)));
AComponent.DesignInfo:=LeftTopToDesignInfo(aLeft,aTop);
end;
function TrySetOrdProp(Instance: TPersistent; const PropName: string;
Value: integer): boolean;
var
PropInfo: PPropInfo;
begin
PropInfo:=GetPropInfo(Instance.ClassType,PropName);
if PropInfo=nil then exit(false);
SetOrdProp(Instance,PropInfo,Value);
Result:=true;
end;
function TryGetOrdProp(Instance: TPersistent; const PropName: string; out
Value: integer): boolean;
var
PropInfo: PPropInfo;
begin
PropInfo:=GetPropInfo(Instance.ClassType,PropName);
if PropInfo=nil then exit(false);
Value:=GetOrdProp(Instance,PropInfo);
Result:=true;
end;
function LeftFromDesignInfo(ADesignInfo: LongInt): SmallInt;
var
DesignInfoRec: packed record
Left: SmallInt;
Top: SmallInt;
end absolute ADesignInfo;
begin
Result := DesignInfoRec.Left;
end;
function TopFromDesignInfo(ADesignInfo: LongInt): SmallInt;
var
DesignInfoRec: packed record
Left: SmallInt;
Top: SmallInt;
end absolute ADesignInfo;
begin
Result := DesignInfoRec.Top;
end;
function LeftTopToDesignInfo(const ALeft, ATop: SmallInt): LongInt;
var
ResultRec: packed record
Left: SmallInt;
Top: SmallInt;
end absolute Result;
begin
ResultRec.Left := ALeft;
ResultRec.Top := ATop;
end;
procedure DesignInfoToLeftTop(ADesignInfo: LongInt; out ALeft, ATop: SmallInt);
var
DesignInfoRec: packed record
Left: SmallInt;
Top: SmallInt;
end absolute ADesignInfo;
begin
ALeft := DesignInfoRec.Left;
ATop := DesignInfoRec.Top;
end;
{ TDesignerMediator }
procedure TDesignerMediator.SetDesigner(const AValue: TComponentEditorDesigner
@ -212,10 +324,88 @@ begin
end;
procedure TDesignerMediator.Paint(aRect: TRect);
procedure TDesignerMediator.SetBounds(AComponent: TComponent; NewBounds: TRect
);
begin
SetComponentLeftTopOrDesignInfo(AComponent,NewBounds.Left,NewBounds.Top);
end;
procedure TDesignerMediator.GetBounds(AComponent: TComponent; out
CurBounds: TRect);
var
aLeft: integer;
aTop: integer;
begin
GetComponentLeftTopOrDesignInfo(AComponent,aLeft,aTop);
CurBounds:=Rect(aLeft,aTop,aLeft+ComponentPaletteBtnWidth,aTop+ComponentPaletteBtnHeight);
end;
procedure TDesignerMediator.SetFormBounds(RootComponent: TComponent; NewBounds,
ClientRect: TRect);
// default: use NewBounds as position and the ClientRect as size
var
r: TRect;
begin
r:=Bounds(NewBounds.Left,NewBounds.Top,
ClientRect.Right-ClientRect.Left,ClientRect.Bottom-ClientRect.Top);
//debugln(['TDesignerMediator.SetFormBounds NewBounds=',dbgs(NewBounds),' ClientRect=',dbgs(ClientRect),' r=',dbgs(r)]);
SetBounds(RootComponent,r);
end;
procedure TDesignerMediator.GetFormBounds(RootComponent: TComponent; out
CurBounds, CurClientRect: TRect);
// default: clientarea is whole bounds and CurBounds.Width/Height=0
// The IDE will use the clientarea to determine the size of the form
begin
GetBounds(RootComponent,CurBounds);
//debugln(['TDesignerMediator.GetFormBounds ',dbgs(CurBounds)]);
CurClientRect:=Rect(0,0,CurBounds.Right-CurBounds.Left,
CurBounds.Bottom-CurBounds.Top);
CurBounds.Right:=CurBounds.Left;
CurBounds.Bottom:=CurBounds.Top;
//debugln(['TDesignerMediator.GetFormBounds ',dbgs(CurBounds),' ',dbgs(CurClientRect)]);
end;
procedure TDesignerMediator.GetClientArea(AComponent: TComponent; out
CurClientArea: TRect; out ScrollOffset: TPoint);
// default: no ScrollOffset and client area is whole bounds
begin
GetBounds(AComponent,CurClientArea);
OffsetRect(CurClientArea,-CurClientArea.Left,-CurClientArea.Top);
ScrollOffset:=Point(0,0);
end;
function TDesignerMediator.GetComponentOriginOnForm(AComponent: TComponent): TPoint;
var
Parent: TComponent;
ClientArea: TRect;
ScrollOffset: TPoint;
begin
Result:=Point(0,0);
while AComponent<>nil do begin
Parent:=AComponent.GetParentComponent;
if Parent=nil then break;
GetClientArea(Parent,ClientArea,ScrollOffset);
inc(Result.X,ClientArea.Left+ScrollOffset.X);
inc(Result.Y,ClientArea.Top+ScrollOffset.Y);
end;
end;
procedure TDesignerMediator.Paint;
begin
end;
function TDesignerMediator.ComponentIsIcon(AComponent: TComponent): boolean;
begin
Result:=true;
end;
function TDesignerMediator.ParentAcceptsChild(Parent: TComponent;
Child: TComponentClass): boolean;
begin
Result:=false;
end;
end.