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

IDE: implemented experimental TPersistentPropertyEditor.SetValue for multi forms

Browse Source 
git-svn-id: trunk@14752 -
This commit is contained in:
mattias 2008-04-04 17:02:49 +00:00
parent 3d48fcca42
commit 03a7cd8f82
4 changed files with 119 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
ide/main.pp
View File

@ -421,6 +421,7 @@ type
const AnUnitName: shortstring);
procedure OnPropHookGetComponentNames(TypeData: PTypeData;
Proc: TGetStringProc);
function OnPropHookGetComponent(const ComponentPath: String): TComponent;
// designer events
procedure OnDesignerGetSelectedComponentClass(Sender: TObject;
@ -1645,6 +1646,7 @@ begin
GlobalDesignHook.AddHandlerPersistentDeleting(@OnPropHookPersistentDeleting);
GlobalDesignHook.AddHandlerDeletePersistent(@OnPropHookDeletePersistent);
GlobalDesignHook.AddHandlerGetComponentNames(@OnPropHookGetComponentNames);
GlobalDesignHook.AddHandlerGetComponent(@OnPropHookGetComponent);
ObjectInspector1.PropertyEditorHook:=GlobalDesignHook;
EnvironmentOptions.IDEWindowLayoutList.Apply(ObjectInspector1,
@ -13529,6 +13531,12 @@ begin
PkgBoss.IterateComponentNames(GlobalDesignHook.LookupRoot,TypeData,Proc);
end;
function TMainIDE.OnPropHookGetComponent(const ComponentPath: String
): TComponent;
begin
Result:=PkgBoss.FindUsableComponent(GlobalDesignHook.LookupRoot,ComponentPath);
end;
procedure TMainIDE.mnuEditCopyClicked(Sender: TObject);
begin
DoSourceEditorCommand(ecCopy);

13
ideintf/propedits.pp
View File

@ -1117,7 +1117,7 @@ type
TPropHookChainCall = procedure(const AMethodName, InstanceName,
InstanceMethod:ShortString; TypeData:PTypeData) of object;
// components
TPropHookGetComponent = function(const Name:ShortString):TComponent of object;
TPropHookGetComponent = function(const ComponentPath: String):TComponent of object;
TPropHookGetComponentName = function(AComponent: TComponent):ShortString of object;
TPropHookGetComponentNames = procedure(TypeData: PTypeData;
Proc: TGetStringProc) of object;
@ -1218,7 +1218,7 @@ type
procedure ChainCall(const AMethodName, InstanceName,
InstanceMethod: ShortString; TypeData: PTypeData);
// components
function GetComponent(const Name: ShortString):TComponent;
function GetComponent(const ComponentPath: string): TComponent;
function GetComponentName(AComponent: TComponent): ShortString;
procedure GetComponentNames(TypeData: PTypeData; const Proc: TGetStringProc);
function GetRootClassName: ShortString;
@ -5255,7 +5255,8 @@ begin
end;
end;
function TPropertyEditorHook.GetComponent(const Name: Shortstring): TComponent;
function TPropertyEditorHook.GetComponent(const ComponentPath: string
): TComponent;
var
i: Integer;
begin
@ -5264,9 +5265,11 @@ begin
Exit;
i := GetHandlerCount(htGetComponent);
while GetNextHandlerIndex(htGetComponent, i) and (Result = nil) do
Result := TPropHookGetComponent(FHandlers[htGetComponent][i])(Name);
Result := TPropHookGetComponent(FHandlers[htGetComponent][i])(ComponentPath);
// Note: TWriter only allows pascal identifiers for names, but in general
// there is no restriction.
if (Result = nil) and (LookupRoot is TComponent) then
Result := TComponent(LookupRoot).FindComponent(Name);
Result := TComponent(LookupRoot).FindComponent(ComponentPath);
end;
function TPropertyEditorHook.GetComponentName(

3
packager/basepkgmanager.pas
View File

@ -139,8 +139,11 @@ type
): string; virtual; abstract;
// components
function GetUsableComponentUnits(CurRoot: TPersistent): TFPList; virtual; abstract; // list of TUnitInfo
procedure IterateComponentNames(CurRoot: TPersistent; TypeData: PTypeData;
Proc: TGetStringProc); virtual; abstract;
function FindUsableComponent(CurRoot: TPersistent;
const ComponentPath: string): TComponent; virtual; abstract;
end;
var

124
packager/pkgmanager.pas
View File

@ -1,4 +1,3 @@
{ $Id$ }
{
/***************************************************************************
pkgmanager.pas
@ -302,8 +301,11 @@ type
ShowDialog: boolean): TModalResult;
// components
function GetUsableComponentUnits(CurRoot: TPersistent): TFPList; override; // list of TUnitInfo
procedure IterateComponentNames(CurRoot: TPersistent; TypeData: PTypeData;
Proc: TGetStringProc); override;
function FindUsableComponent(CurRoot: TPersistent;
const ComponentPath: string): TComponent; override;
end;
@ -3865,30 +3867,13 @@ begin
GetPublishPackageDir(APackage));
end;
procedure TPkgManager.IterateComponentNames(CurRoot: TPersistent;
TypeData: PTypeData; Proc: TGetStringProc);
function TPkgManager.GetUsableComponentUnits(CurRoot: TPersistent): TFPList;
var
FMainUnitInfo: TUnitInfo;
FMainUnitInfoValid: boolean;
FMainOwner: TObject;
FMainOwnerValid: boolean;
procedure TraverseComponents(aRoot: TComponent);
var
i: integer;
CurName: String;
begin
if aRoot=nil then exit;
for i := 0 to aRoot.ComponentCount - 1 do
if (aRoot.Components[i] is TypeData^.ClassType) then
begin
CurName:=aRoot.Components[i].Name;
if aRoot<>CurRoot then
CurName:=aRoot.Name+'.'+CurName;
Proc(CurName);
end;
end;
function MainUnitInfo: TUnitInfo;
begin
if not FMainUnitInfoValid then begin
@ -3919,7 +3904,7 @@ var
Result:=FMainOwner;
end;
procedure TraverseOtherRootComponent(AnUnitInfo: TUnitInfo);
procedure CheckUnit(AnUnitInfo: TUnitInfo);
var
Owners: TFPList;
OtherOwner: TObject;
@ -3975,13 +3960,15 @@ var
end;
end;
// this unit can be used -> add components
TraverseComponents(AnUnitInfo.Component);
if Result=nil then
Result:=TFPList.Create;
Result.Add(AnUnitInfo);
end;
var
AnUnitInfo: TUnitInfo;
begin
CurRoot:=GlobalDesignHook.LookupRoot;
Result:=nil;
if not (CurRoot is TComponent) then exit;
{$IFNDEF EnableMultiFormProperties}
exit;
@ -3990,15 +3977,104 @@ begin
FMainOwnerValid:=false;
FMainUnitInfo:=nil;
FMainUnitInfoValid:=false;
TraverseComponents(TComponent(CurRoot));
// search all open designer forms (can be hidden)
AnUnitInfo:=Project1.FirstUnitWithComponent;
while AnUnitInfo<>nil do begin
TraverseOtherRootComponent(AnUnitInfo);
CheckUnit(AnUnitInfo);
AnUnitInfo:=AnUnitInfo.NextUnitWithComponent;
end;
end;
procedure TPkgManager.IterateComponentNames(CurRoot: TPersistent;
TypeData: PTypeData; Proc: TGetStringProc);
procedure CheckComponent(aRoot: TComponent);
var
i: integer;
CurName: String;
begin
if aRoot=nil then exit;
for i := 0 to aRoot.ComponentCount - 1 do
if (aRoot.Components[i] is TypeData^.ClassType) then
begin
CurName:=aRoot.Components[i].Name;
if aRoot<>CurRoot then
CurName:=aRoot.Name+'.'+CurName;
Proc(CurName);
end;
end;
var
UnitList: TFPList;
i: Integer;
begin
if not (CurRoot is TComponent) then exit;
CheckComponent(TComponent(CurRoot));
{$IFNDEF EnableMultiFormProperties}
exit;
{$ENDIF}
UnitList:=GetUsableComponentUnits(CurRoot);
if UnitList=nil then exit;
try
for i:=0 to UnitList.Count-1 do
CheckComponent(TUnitInfo(UnitList[i]).Component);
finally
UnitList.Free;
end;
end;
function TPkgManager.FindUsableComponent(CurRoot: TPersistent;
const ComponentPath: string): TComponent;
procedure CheckComponent(const RootName, SubPath: string; aRoot: TComponent);
var
i: integer;
begin
if aRoot=nil then exit;
if (SysUtils.CompareText(RootName,aRoot.Name)<>0) then exit;
for i := 0 to aRoot.ComponentCount - 1 do
if SysUtils.CompareText(aRoot.Components[i].Name,SubPath)=0 then begin
Result:=aRoot.Components[i];
exit;
end;
end;
var
UnitList: TFPList;
SubPath: String;
p: LongInt;
RootName: String;
i: Integer;
begin
Result:=nil;
if not (CurRoot is TComponent) then exit;
SubPath:=ComponentPath;
p:=System.Pos('.',SubPath);
if p<1 then
RootName:=''
else begin
RootName:=copy(ComponentPath,1,p-1);
SubPath:=copy(SubPath,p+1,length(SubPath));
end;
if (RootName='') or (SysUtils.CompareText(RootName,TComponent(CurRoot).Name)=0)
then
CheckComponent(TComponent(CurRoot).Name,SubPath,TComponent(CurRoot));
{$IFNDEF EnableMultiFormProperties}
exit;
{$ENDIF}
if p<1 then exit;
UnitList:=GetUsableComponentUnits(CurRoot);
if UnitList=nil then exit;
try
for i:=0 to UnitList.Count-1 do begin
CheckComponent(RootName,SubPath,TUnitInfo(UnitList[i]).Component);
if Result<>nil then exit;
end;
finally
UnitList.Free;
end;
end;
function TPkgManager.OnProjectInspectorOpen(Sender: TObject): boolean;
var
Dependency: TPkgDependency;