diff --git a/components/ideintf/componenttreeview.pas b/components/ideintf/componenttreeview.pas index 0a5bf8ebbd..2e867fcb87 100644 --- a/components/ideintf/componenttreeview.pas +++ b/components/ideintf/componenttreeview.pas @@ -35,6 +35,8 @@ uses type TCTVGetImageIndexEvent = procedure(APersistent: TPersistent; var AIndex: integer) of object; + TCTVParentAcceptsChildEvent = function(aParent, aChild, aLookupRoot: TPersistent): boolean of object; + TCTVSetParentEvent = procedure(aChild, aParent, aLookupRoot: TPersistent) of object; // First 4 are ways to change ZOrder, zoDelete deletes a component. TZOrderDelete = (zoToFront, zoToBack, zoForward, zoBackward, zoDelete); @@ -44,6 +46,8 @@ type TComponentTreeView = class(TCustomTreeView) private FComponentList: TBackupComponentList; + FOnParentAcceptsChild: TCTVParentAcceptsChildEvent; + FOnSetParent: TCTVSetParentEvent; FPropertyEditorHook: TPropertyEditorHook; // Map of Root component -> TAVLTree of collapsed components. FRoot2CollapasedMap: TPointerToPointerTree; @@ -104,6 +108,8 @@ type property OnModified: TNotifyEvent read FOnModified write FOnModified; property OnComponentGetImageIndex : TCTVGetImageIndexEvent read FOnComponentGetImageIndex write FOnComponentGetImageIndex; + property OnParentAcceptsChild: TCTVParentAcceptsChildEvent read FOnParentAcceptsChild write FOnParentAcceptsChild; + property OnSetParent: TCTVSetParentEvent read FOnSetParent write FOnSetParent; end; implementation @@ -360,7 +366,14 @@ var CompEditDsg: TComponentEditorDesigner; NewIndex, AIndex: Integer; ok: Boolean; + ParentObj: TObject; + aLookupRoot, aParent, aChild: TPersistent; begin + if PropertyEditorHook<>nil then + aLookupRoot := PropertyEditorHook.LookupRoot + else + aLookupRoot := nil; + GetComponentInsertMarkAt(X, Y, Node, InsertType); SetInsertMark(nil, tvimNone); if InsertType in [tvimAsNextSibling, tvimAsPrevSibling] then @@ -377,9 +390,11 @@ begin else CompEditDsg := nil; - if TObject(ParentNode.Data) is TWinControl then + ParentObj:=TObject(ParentNode.Data); + if ParentObj is TWinControl then begin - AContainer := TWinControl(ParentNode.Data); + // reparent lcl TControl(s) + AContainer := TWinControl(ParentObj); SelNode := GetFirstMultiSelected; while Assigned(SelNode) do begin @@ -410,6 +425,7 @@ begin else if TObject(Node.Data) is TCollectionItem then begin + // reorder collection item ACollection := TCollectionItem(Node.Data).Collection; ACollection.BeginUpdate; case InsertType of @@ -442,6 +458,19 @@ begin SelNode := SelNode.GetPrevMultiSelected; end; ACollection.EndUpdate; + end else if Assigned(OnSetParent) and (ParentObj is TPersistent) then begin + // default: reparent + aParent:=TPersistent(ParentObj); + SelNode := GetLastMultiSelected; + while Assigned(SelNode) do + begin + if (TObject(SelNode.Data) is TPersistent) then + begin + aChild:=TPersistent(TObject(SelNode.Data)); + OnSetParent(aChild,aParent,aLookupRoot); + end; + SelNode := SelNode.GetPrevMultiSelected; + end; end; BuildComponentNodes(True); end; @@ -454,16 +483,14 @@ var Node: TTreeNode; AnObject: TObject; AControl: TControl absolute AnObject; - AContainer: TPersistent; - AcceptControl, AcceptContainer: Boolean; + aLookupRoot, AContainer: TPersistent; InsertType: TTreeViewInsertMarkType; ParentNode: TTreeNode; - aLookupRoot: TPersistent; + UserAccept: Boolean; begin //debugln('TComponentTreeView.DragOver START ',dbgs(Accept)); - - AcceptContainer := False; - AcceptControl := True; + Accept:=false; + AContainer := nil; GetComponentInsertMarkAt(X, Y, Node, InsertType); SetInsertMark(Node, InsertType); @@ -480,53 +507,53 @@ begin if Assigned(ParentNode) and Assigned(ParentNode.Data) then begin AnObject := TObject(ParentNode.Data); - if (AnObject is TWinControl) then + if AnObject is TPersistent then begin - if ControlAcceptsStreamableChildComponent(TWinControl(AControl), - TComponentClass(AnObject.ClassType),aLookupRoot) - then begin - AContainer := TPersistent(AnObject); - //DebugLn(['TComponentTreeView.DragOver AContainer=',DbgSName(AContainer)]); - AcceptContainer := True; - end; - end - else - if (AnObject is TCollection) then - begin - // it is allowed to move container items inside the container - AContainer := TPersistent(AnObject); - AcceptContainer := True; + AContainer:=TPersistent(AnObject); end; end; - if AcceptContainer then + //debugln(['TComponentTreeView.DragOver AContainer=',DbgSName(AContainer)]); + if AContainer<>nil then begin Node := GetFirstMultiSelected; - while Assigned(Node) and AcceptControl do + while Assigned(Node) do begin AnObject := TObject(Node.Data); - // don't allow to move ancestor components - if (AnObject is TComponent) and - (csAncestor in TComponent(AnObject).ComponentState) then break; - if (AnObject is TControl) then + + if Assigned(OnParentAcceptsChild) and (AnObject is TPersistent) then begin - if AnObject = AContainer then break; - if not (AContainer is TWinControl) then break; - //DebugLn(['TComponentTreeView.DragOver AControl=',DbgSName(AControl),' Parent=',DbgSName(AControl.Parent),' OldAccepts=',csAcceptsControls in AControl.Parent.ControlStyle]); - // check if new parent allows this control class - if not TWinControl(AContainer).CheckChildClassAllowed(AnObject.ClassType, False) then + //debugln(['TComponentTreeView.DragOver Child=',DbgSName(AnObject),' AContainer=',DbgSName(AContainer)]); + if not OnParentAcceptsChild(AContainer,TPersistent(AnObject),aLookupRoot) then break; - // check if one of the parent of the container is the control itself - if AControl.IsParentOf(TWinControl(AContainer)) then break; - // do not move children of a restricted parent to another parent - // e.g. TPage of TPageControl - if (AControl.Parent <> nil) and (AControl.Parent <> AContainer) and - (not (csAcceptsControls in AControl.Parent.ControlStyle)) then - break; - end - else + end else begin + // default rules for components: + + // don't allow to move ancestor components + if (AnObject is TComponent) and + (csAncestor in TComponent(AnObject).ComponentState) then break; + + if (AnObject is TControl) then + begin + if AnObject = AContainer then break; + if not (AContainer is TWinControl) then break; + //DebugLn(['TComponentTreeView.DragOver AControl=',DbgSName(AControl),' Parent=',DbgSName(AControl.Parent),' OldAccepts=',csAcceptsControls in AControl.Parent.ControlStyle]); + // check if new parent allows this control class + if not TWinControl(AContainer).CheckChildClassAllowed(AnObject.ClassType, False) then + break; + // check if one of the parents of the container is the control itself + if AControl.IsParentOf(TWinControl(AContainer)) then break; + // do not move children of a restricted parent to another parent + // e.g. TPage of TPageControl + if (AControl.Parent <> nil) and (AControl.Parent <> AContainer) and + (not (csAcceptsControls in AControl.Parent.ControlStyle)) then + break; + end; + end; + if (AnObject is TCollectionItem) then begin + // allow to reorder collection items if AnObject = AContainer then break; if not (AContainer is TCollection) then break; @@ -535,15 +562,15 @@ begin end; Node := Node.GetNextMultiSelected; end; - AcceptControl := (Node = nil); + Accept := (Node = nil); end; - Accept := AcceptContainer and AcceptControl; //debugln('TComponentTreeView.DragOver A ',dbgs(Accept)); - inherited DragOver(Source, X, Y, State, Accept); + UserAccept:=Accept; + inherited DragOver(Source, X, Y, State, UserAccept); + if Assigned(OnDragOver) then + Accept:=UserAccept; //debugln('TComponentTreeView.DragOver B ',dbgs(Accept)); - - Accept := AcceptContainer and AcceptControl and ((OnDragOver=nil) or Accept); end; procedure TComponentTreeView.DragCanceled; diff --git a/components/ideintf/formeditingintf.pas b/components/ideintf/formeditingintf.pas index b94e6fda82..3767cf83d4 100644 --- a/components/ideintf/formeditingintf.pas +++ b/components/ideintf/formeditingintf.pas @@ -150,6 +150,8 @@ type class procedure InitFormInstance({%H-}aForm: TComponent); virtual; // called after NewInstance, before constructor class function GetDefaultSize: TPoint; virtual; public + procedure InitComponent(AComponent, NewParent: TComponent; NewBounds: TRect); virtual; + procedure ChangeParent(AComponent, NewParent: TComponent); virtual; procedure SetBounds(AComponent: TComponent; NewBounds: TRect); virtual; procedure GetBounds(AComponent: TComponent; out CurBounds: TRect); virtual; procedure SetFormBounds(RootComponent: TComponent; NewBounds, ClientRect: TRect); virtual; @@ -158,7 +160,8 @@ type out ScrollOffset: TPoint); virtual; function GetComponentOriginOnForm(AComponent: TComponent): TPoint; virtual; function ComponentIsIcon({%H-}AComponent: TComponent): boolean; virtual; - function ParentAcceptsChild({%H-}Parent: TComponent; {%H-}Child: TComponentClass): boolean; virtual; + function ParentAcceptsChild({%H-}Parent: TComponent; {%H-}ChildClass: TComponentClass): boolean; virtual; + function ParentAcceptsChildComponent({%H-}Parent, {%H-}Child: TComponent): boolean; virtual; function ComponentIsVisible({%H-}AComponent: TComponent): Boolean; virtual; function ComponentIsSelectable({%H-}AComponent: TComponent): Boolean; virtual; function ComponentAtPos(p: TPoint; MinClass: TComponentClass; @@ -167,7 +170,6 @@ type function UseRTTIForMethods({%H-}aComponent: TComponent): boolean; virtual; // false = use sources // events - procedure InitComponent(AComponent, NewParent: TComponent; NewBounds: TRect); virtual; procedure Paint; virtual; procedure KeyDown(Sender: TControl; var {%H-}Key: word; {%H-}Shift: TShiftState); virtual; procedure KeyUp(Sender: TControl; var {%H-}Key: word; {%H-}Shift: TShiftState); virtual; @@ -230,6 +232,8 @@ type procedure CreateChildComponentsFromStream(BinStream: TStream; ComponentClass: TComponentClass; Root: TComponent; ParentControl: TWinControl; NewComponents: TFPList); virtual; abstract; + function ParentAcceptsChild(Parent, Child, aLookupRoot: TComponent): boolean; virtual; abstract; + function ParentAcceptsChildClass(Parent: TComponent; ChildClass: TComponentClass; aLookupRoot: TComponent): boolean; virtual; abstract; // ancestors function GetAncestorLookupRoot(AComponent: TComponent): TComponent; virtual; abstract; @@ -692,9 +696,16 @@ begin end; function TDesignerMediator.ParentAcceptsChild(Parent: TComponent; - Child: TComponentClass): boolean; + ChildClass: TComponentClass): boolean; begin - Result:=false; + Result:=true; +end; + +function TDesignerMediator.ParentAcceptsChildComponent(Parent, Child: TComponent + ): boolean; +begin + if (Parent=nil) or (Child=nil) then exit(false); + Result:=ParentAcceptsChild(Parent,TComponentClass(Child.ClassType)); end; function TDesignerMediator.ComponentIsVisible(AComponent: TComponent): Boolean; @@ -786,6 +797,11 @@ begin TDesignerMediator(AComponent).SetParentComponent(NewParent); end; +procedure TDesignerMediator.ChangeParent(AComponent, NewParent: TComponent); +begin + TDesignerMediator(AComponent).SetParentComponent(NewParent); +end; + procedure TDesignerMediator.KeyDown(Sender: TControl; var Key: word; Shift: TShiftState); begin diff --git a/ide/customformeditor.pp b/ide/customformeditor.pp index f4927349d8..bfc86df119 100644 --- a/ide/customformeditor.pp +++ b/ide/customformeditor.pp @@ -81,6 +81,9 @@ type ): TAvlTreeNode; procedure FrameCompGetCreationClass(Sender: TObject; var NewComponentClass: TComponentClass); + function OnCompTree_ParentAcceptsChild(aParent, aChild, + aLookupRoot: TPersistent): boolean; + procedure OnCompTree_SetParent(aChild, aParent, aLookupRoot: TPersistent); procedure OnPasWriterFindAncestor(Writer: TCompWriterPas; aComponent: TComponent; const aName: string; var anAncestor, aRootAncestor: TComponent); @@ -231,6 +234,9 @@ type procedure CreateChildComponentsFromStream(BinStream: TStream; ComponentClass: TComponentClass; Root: TComponent; ParentControl: TWinControl; NewComponents: TFPList); override; + function ParentAcceptsChild(Parent, Child, aLookupRoot: TComponent): boolean; override; + function ParentAcceptsChildClass(Parent: TComponent; + ChildClass: TComponentClass; aLookupRoot: TComponent): boolean; override; function FixupReferences(AComponent: TComponent): TModalResult; procedure WriterFindAncestor({%H-}Writer: TWriter; Component: TComponent; const {%H-}Name: string; @@ -1293,18 +1299,21 @@ var var NewSize: TPoint; begin - if Mediator<>nil then exit; - MediatorClass:=GetDesignerMediatorClass(TComponentClass(NewComponent.ClassType)); - if MediatorClass<>nil then + if Mediator=nil then begin - Mediator:=MediatorClass.CreateMediator(nil,NewComponent); - if Mediator<>nil then + MediatorClass:=GetDesignerMediatorClass(TComponentClass(NewComponent.ClassType)); + if MediatorClass<>nil then begin - NewSize:=Mediator.GetDefaultSize; - NewWidth:=NewSize.X; - NewHeight:=NewSize.Y; + Mediator:=MediatorClass.CreateMediator(nil,NewComponent); + FreeMediator:=true; end; end; + if Mediator<>nil then + begin + NewSize:=Mediator.GetDefaultSize; + NewWidth:=NewSize.X; + NewHeight:=NewSize.Y; + end; end; procedure MediatorInitComponent; @@ -1634,6 +1643,81 @@ begin Root,BinStream,ComponentClass,ParentControl,NewComponents); end; +function TCustomFormEditor.ParentAcceptsChild(Parent, Child, + aLookupRoot: TComponent): boolean; +var + Mediator: TDesignerMediator; + AControl: TControl; + aComp: TComponent; +begin + Result:=false; + if (Parent=nil) or (Child=nil) or (aLookupRoot=nil) then + exit; + + // don't allow to move ancestor components + if csAncestor in Child.ComponentState then + exit; + + // check if one of the parents of the Parent is the Child itself + aComp:=Parent; + repeat + if aComp=Child then exit; + aComp:=aComp.GetParentComponent; + until aComp=nil; + + // check mediator + Mediator:=GetDesignerMediatorByComponent(aLookupRoot); + if Mediator<>nil then + begin + if not Mediator.ParentAcceptsChildComponent(Parent,Child) then + exit; + end; + + // check LCL rules + if Parent is TWinControl then + begin + if (not (csAcceptsControls in TWinControl(Parent).ControlStyle)) then + exit; + if not TWinControl(Parent).CheckChildClassAllowed(TComponentClass(Child.ClassType), False) then + exit; + end + else if Parent is TControl then begin + exit; + end; + + if Child is TControl then + begin + // do not move children of a restricted parent to another parent + // e.g. TPage of TPageControl + AControl:=TControl(Child); + if (AControl.Parent <> nil) and (AControl.Parent <> Parent) and + (not (csAcceptsControls in AControl.Parent.ControlStyle)) then + exit; + end; + Result:=true; +end; + +function TCustomFormEditor.ParentAcceptsChildClass(Parent: TComponent; + ChildClass: TComponentClass; aLookupRoot: TComponent): boolean; +var + Mediator: TDesignerMediator; +begin + Result:=false; + if (Parent=nil) or (ChildClass=nil) or (aLookupRoot=nil) then + exit; + Mediator:=GetDesignerMediatorByComponent(aLookupRoot); + if Mediator<>nil then + Result:=Mediator.ParentAcceptsChild(Parent,ChildClass) + else if Parent is TWinControl then + begin + if not TWinControl(Parent).CheckChildClassAllowed(ChildClass, False) then + exit; + end else if Parent is TControl then begin + exit; + end; + Result:=true; +end; + function TCustomFormEditor.FixupReferences(AComponent: TComponent): TModalResult; begin Result:=MainIDEInterface.DoFixupComponentReferences(AComponent,[]); @@ -2332,6 +2416,35 @@ begin OnSelectFrame(Sender,NewComponentClass); end; +function TCustomFormEditor.OnCompTree_ParentAcceptsChild(aParent, aChild, + aLookupRoot: TPersistent): boolean; +begin + Result:=(aParent is TComponent) + and (aChild is TComponent) + and (aLookupRoot is TComponent) + and ParentAcceptsChild(TComponent(aParent),TComponent(aChild),TComponent(aLookupRoot)); +end; + +procedure TCustomFormEditor.OnCompTree_SetParent(aChild, aParent, + aLookupRoot: TPersistent); +var + Mediator: TDesignerMediator; + ChildComp, OldParent: TComponent; +begin + if not (aChild is TComponent) then exit; + if not (aParent is TComponent) then exit; + if not (aLookupRoot is TComponent) then exit; + Mediator:=GetDesignerMediatorByComponent(TComponent(aLookupRoot)); + if Mediator<>nil then + begin + ChildComp:=TComponent(aChild); + OldParent:=ChildComp.GetParentComponent; + Mediator.ChangeParent(ChildComp,TComponent(aParent)); + if ChildComp.GetParentComponent<>OldParent then + OnObjectInspectorModified(Self); + end; +end; + procedure TCustomFormEditor.OnPasWriterFindAncestor(Writer: TCompWriterPas; aComponent: TComponent; const aName: string; var anAncestor, aRootAncestor: TComponent); @@ -2595,6 +2708,7 @@ begin if FObj_Inspector<>nil then begin FObj_Inspector.OnModified:=nil; FObj_inspector.OnNodeGetImageIndex:= nil; + FObj_inspector.ComponentTree.OnParentAcceptsChild:=nil; end; FObj_Inspector:=AnObjectInspector; @@ -2602,10 +2716,11 @@ begin if FObj_Inspector<>nil then begin FObj_Inspector.OnModified:=@OnObjectInspectorModified; FObj_inspector.OnNodeGetImageIndex:= @DoOnNodeGetImageIndex; + FObj_inspector.ComponentTree.OnParentAcceptsChild:=@OnCompTree_ParentAcceptsChild; + FObj_inspector.ComponentTree.OnSetParent:=@OnCompTree_SetParent; end; end; - procedure TCustomFormEditor.DoOnNodeGetImageIndex(APersistent: TPersistent; var AImageIndex: integer); var