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

IDE, IDEIntf: fixed componentreeview dragover check

Browse Source 
git-svn-id: trunk@42713 -
This commit is contained in:
mattias 2013-09-10 09:30:35 +00:00
parent c50737c1d3
commit e140abe386
3 changed files with 38 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
components/ideintf/componenttreeview.pas
View File

@ -381,6 +381,7 @@ var
AcceptControl, AcceptContainer: Boolean; AcceptControl, AcceptContainer: Boolean;
InsertType: TTreeViewInsertMarkType; InsertType: TTreeViewInsertMarkType;
ParentNode: TTreeNode; ParentNode: TTreeNode;
aLookupRoot: TPersistent;
begin begin
//debugln('TComponentTreeView.DragOver START ',dbgs(Accept)); //debugln('TComponentTreeView.DragOver START ',dbgs(Accept));
@ -390,6 +391,11 @@ begin
GetComponentInsertMarkAt(X, Y, Node, InsertType); GetComponentInsertMarkAt(X, Y, Node, InsertType);
SetInsertMark(Node, InsertType); SetInsertMark(Node, InsertType);
if PropertyEditorHook<>nil then
aLookupRoot := PropertyEditorHook.LookupRoot
else
aLookupRoot := nil;
// check new parent // check new parent
ParentNode := Node; ParentNode := Node;
if InsertType in [tvimAsNextSibling, tvimAsPrevSibling] then if InsertType in [tvimAsNextSibling, tvimAsPrevSibling] then
@ -399,14 +405,9 @@ begin
AnObject := TObject(ParentNode.Data); AnObject := TObject(ParentNode.Data);
if (AnObject is TWinControl) then if (AnObject is TWinControl) then
begin begin
if (csAcceptsControls in AControl.ControlStyle) and if ControlAcceptsStreamableChildComponent(TWinControl(AControl),
// Because of TWriter, you can not put a control onto an csInline, csAncestor controls (e.g. on a frame or it child). TComponentClass(AnObject.ClassType),aLookupRoot)
([csInline, csAncestor] * AControl.ComponentState = []) and then begin
( // TReader/TWriter only supports this
(AControl.Owner = nil) or // root
(AControl.Owner.Owner = nil) // child of a root
) then
begin
AContainer := TPersistent(AnObject); AContainer := TPersistent(AnObject);
//DebugLn(['TComponentTreeView.DragOver AContainer=',DbgSName(AContainer)]); //DebugLn(['TComponentTreeView.DragOver AContainer=',DbgSName(AContainer)]);
AcceptContainer := True; AcceptContainer := True;

27
components/ideintf/propedits.pp
View File

@ -1563,6 +1563,8 @@ function ClassTypeInfo(Value: TClass): PTypeInfo;
function GetClassUnitName(Value: TClass): string; function GetClassUnitName(Value: TClass): string;
procedure CreateComponentEvent(AComponent: TComponent; const EventName: string); procedure CreateComponentEvent(AComponent: TComponent; const EventName: string);
function ClassNameToComponentName(const AClassName: string): string; function ClassNameToComponentName(const AClassName: string): string;
function ControlAcceptsStreamableChildComponent(aControl: TWinControl;
aComponentClass: TComponentClass; aLookupRoot: TPersistent): boolean;
procedure LazSetMethodProp(Instance : TObject;PropInfo : PPropInfo; Value : TMethod); procedure LazSetMethodProp(Instance : TObject;PropInfo : PPropInfo; Value : TMethod);
procedure WritePublishedProperties(Instance: TPersistent); procedure WritePublishedProperties(Instance: TPersistent);
@ -1679,7 +1681,8 @@ begin
end; end;
end; end;
Procedure LazSetMethodProp(Instance : TObject;PropInfo : PPropInfo; Value : TMethod); procedure LazSetMethodProp(Instance: TObject; PropInfo: PPropInfo;
Value: TMethod);
type type
PMethod = ^TMethod; PMethod = ^TMethod;
TSetMethodProcIndex=procedure(index:longint;p:TMethod) of object; TSetMethodProcIndex=procedure(index:longint;p:TMethod) of object;
@ -6371,7 +6374,27 @@ begin
System.Delete(Result,1,1); System.Delete(Result,1,1);
end; end;
Function ClassTypeInfo(Value: TClass): PTypeInfo; function ControlAcceptsStreamableChildComponent(aControl: TWinControl;
aComponentClass: TComponentClass; aLookupRoot: TPersistent): boolean;
begin
Result:=false;
if not (csAcceptsControls in aControl.ControlStyle) then exit;
// Because of TWriter, you can not put a control onto an
// csInline,csAncestor control (e.g. on a frame).
if ([csInline,csAncestor]*aControl.ComponentState<>[]) then exit;
if aComponentClass.InheritsFrom(TControl)
and not aControl.CheckChildClassAllowed(aComponentClass, False) then exit;
// TWriter only supports children of LookupRoot and LookupRoot.Components
if (aControl.Owner <> aLookupRoot) and (aControl <> aLookupRoot) then exit;
Result:=true;
end;
function ClassTypeInfo(Value: TClass): PTypeInfo;
begin begin
Result := PTypeInfo(Value.ClassInfo); Result := PTypeInfo(Value.ClassInfo);
end; end;

12
designer/designer.pp
View File

@ -1881,15 +1881,11 @@ var
else else
NewParentControl := WinControlAtPos(MouseUpPos.X, MouseUpPos.Y, true, true); NewParentControl := WinControlAtPos(MouseUpPos.X, MouseUpPos.Y, true, true);
while (NewParentControl <> nil) and while (NewParentControl <> nil)
((not (csAcceptsControls in NewParentControl.ControlStyle)) or and not ControlAcceptsStreamableChildComponent(NewParentControl,
(NewComponentClass.InheritsFrom(TControl) and not NewParentControl.CheckChildClassAllowed(NewComponentClass, False)) or NewComponentClass,FLookupRoot)
(csInline in NewParentControl.ComponentState) or // Because of TWriter, you can not put a control onto an csInline control (e.g. on a frame). do
((NewParentControl.Owner <> FLookupRoot) and
(NewParentControl <> FLookupRoot))) do
begin
NewParentControl := NewParentControl.Parent; NewParentControl := NewParentControl.Parent;
end;
NewParent := NewParentControl; NewParent := NewParentControl;
end; end;
if not Assigned(NewParent) then exit; if not Assigned(NewParent) then exit;