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

ideintf: apply patches of Alexander S. Klenin (issue #0013326)

Browse Source 
- ClassPropEdit: Make subproperties type filter configurable
  - ClassPropEdit: Refactor TClassPropertyEditor and TPersistentPropertyEditor
  - Object Inspector: Do not show objects without properties of appropriate kind
  - Object inspector: Do not show events on Properties page, even for nested objects

git-svn-id: trunk@19016 -
This commit is contained in:
paul 2009-03-18 06:37:40 +00:00
parent d8ead49984
commit a075ba45c5
2 changed files with 134 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
ideintf/objectinspector.pp
View File

@ -392,6 +392,7 @@ type
procedure SetSubPropertiesColor(const AValue: TColor);
procedure UpdateScrollBar;
procedure FillComboboxItems;
function PropInfoFilter(const APropInfo: PPropInfo): Boolean;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
@ -1181,6 +1182,12 @@ begin
end;
end;
function TOICustomPropertyGrid.PropInfoFilter(
const APropInfo: PPropInfo): Boolean;
begin
Result := HasSubpropertiesInFilter(APropInfo, FFilter);
end;
function TOICustomPropertyGrid.GetRowByPath(
const PropPath: string): TOIPropertyGridRow;
// searches PropPath. Expands automatically parent rows
@ -1569,8 +1576,9 @@ begin
for a:=0 to FRows.Count-1 do Rows[a].Free;
FRows.Clear;
// get properties
GetPersistentProperties(FSelection, FFilter, FPropertyEditorHook,
@AddPropertyEditor,nil);
GetPersistentProperties(
FSelection, FFilter, FPropertyEditorHook, @AddPropertyEditor,
@PropInfoFilter, nil);
// sort
FRows.Sort(@SortGridRows);
for a:=0 to FRows.Count-1 do begin
@ -1627,7 +1635,9 @@ begin
exit;
end;
end;
NewRow:=TOIPropertyGridRow.Create(Self,PropEditor,nil, WidgetSets);
if PropEditor is TClassPropertyEditor then
(PropEditor as TClassPropertyEditor).SubPropsTypeFilter := FFilter;
NewRow := TOIPropertyGridRow.Create(Self, PropEditor, nil, WidgetSets);
FRows.Add(NewRow);
if FRows.Count>1 then begin
NewRow.FPriorBrother:=Rows[FRows.Count-2];
@ -1749,6 +1759,8 @@ procedure TOICustomPropertyGrid.AddSubEditor(PropEditor:TPropertyEditor);
var NewRow:TOIPropertyGridRow;
NewIndex:integer;
begin
if PropEditor is TClassPropertyEditor then
(PropEditor as TClassPropertyEditor).SubPropsTypeFilter := FFilter;
NewRow:=TOIPropertyGridRow.Create(Self,PropEditor,FExpandingRow, []);
NewIndex:=FExpandingRow.Index+1+FExpandingRow.ChildCount;
NewRow.Index:=NewIndex;
@ -4635,7 +4647,8 @@ begin
end;
PropertyGrid := CreateGrid(PROPS, oipgpProperties, 0);
EventGrid := CreateGrid([tkMethod], oipgpEvents, 1);
// Nested or referenced objects may have events too.
EventGrid := CreateGrid([tkClass, tkMethod], oipgpEvents, 1);
FavouriteGrid := CreateGrid(PROPS + [tkMethod], oipgpFavourite, 2);
FavouriteGrid.Favourites := FFavourites;
RestrictedGrid := CreateGrid(PROPS + [tkMethod], oipgpRestricted, 3);

165
ideintf/propedits.pp
View File

@ -549,10 +549,22 @@ type
editing of the object's properties as sub-properties of the property. }
TClassPropertyEditor = class(TPropertyEditor)
private
FSubPropsTypeFilter: TTypeKinds;
procedure SetSubPropsTypeFilter(const AValue: TTypeKinds);
function PropInfoFilter(const APropInfo: PPropInfo): Boolean;
protected
function GetSelections: TPersistentSelectionList; virtual;
public
constructor Create(
Hook: TPropertyEditorHook; APropCount: Integer); override;
function GetAttributes: TPropertyAttributes; override;
procedure GetProperties(Proc: TGetPropEditProc); override;
function GetValue: ansistring; override;
property SubPropsTypeFilter: TTypeKinds
read FSubPropsTypeFilter write SetSubPropsTypeFilter default tkAny;
end;
{ TMethodPropertyEditor
@ -580,17 +592,16 @@ type
in the same form that is type compatible with the property being edited
(e.g. the ActiveControl property). }
TPersistentPropertyEditor = class(TPropertyEditor)
TPersistentPropertyEditor = class(TClassPropertyEditor)
protected
function FilterFunc(const ATestEditor: TPropertyEditor): Boolean;
function GetPersistentReference: TPersistent; virtual;
function GetSelections: TPersistentSelectionList; virtual;
function GetSelections: TPersistentSelectionList; override;
function CheckNewValue(APersistent: TPersistent): boolean; virtual;
public
function AllEqual: Boolean; override;
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
procedure GetProperties(Proc:TGetPropEditProc); override;
function GetEditLimit: Integer; override;
function GetValue: AnsiString; override;
procedure GetValues(Proc: TGetStringProc); override;
@ -1595,6 +1606,11 @@ type
procedure WritePublishedProperties(Instance: TPersistent);
procedure EditCollection(AComponent: TComponent; ACollection: TCollection; APropertyName: String);
// Returns true if given property should be displayed on the property list
// filtered by AFilter.
function HasSubpropertiesInFilter(
const APropInfo: PPropInfo; const AFilter: TTypeKinds): Boolean;
const
NoDefaultValue = Longint($80000000);
@ -4003,6 +4019,13 @@ end;
{ TClassPropertyEditor }
constructor TClassPropertyEditor.Create(Hook: TPropertyEditorHook;
APropCount: Integer);
begin
inherited Create(Hook, APropCount);
FSubPropsTypeFilter := tkAny;
end;
function TClassPropertyEditor.GetAttributes: TPropertyAttributes;
begin
Result := [paMultiSelect, paSubProperties, paReadOnly];
@ -4010,26 +4033,48 @@ end;
procedure TClassPropertyEditor.GetProperties(Proc: TGetPropEditProc);
var
I: Integer;
SubItem: TPersistent;
Selection: TPersistentSelectionList;
selection: TPersistentSelectionList;
begin
Selection := TPersistentSelectionList.Create;
selection := GetSelections;
if selection = nil then exit;
GetPersistentProperties(
selection, SubPropsTypeFilter, PropertyHook, Proc, @PropInfoFilter, nil);
selection.Free;
end;
function TClassPropertyEditor.GetSelections: TPersistentSelectionList;
var
i: Integer;
subItem: TPersistent;
begin
Result := TPersistentSelectionList.Create;
try
for I := 0 to PropCount - 1 do begin
SubItem := TPersistent(GetObjectValueAt(I));
if SubItem<>nil then
Selection.Add(SubItem);
for i := 0 to PropCount - 1 do begin
subItem := TPersistent(GetObjectValueAt(i));
if subItem <> nil then
Result.Add(subItem);
end;
GetPersistentProperties(Selection,tkProperties,PropertyHook,Proc,nil);
finally
Selection.Free;
except
Result.Free;
raise;
end;
end;
function TClassPropertyEditor.GetValue: ansistring;
begin
Result:='('+GetPropType^.Name+')';
Result:='(' + GetPropType^.Name + ')';
end;
function TClassPropertyEditor.PropInfoFilter(
const APropInfo: PPropInfo): Boolean;
begin
Result := HasSubpropertiesInFilter(APropInfo, SubPropsTypeFilter);
end;
procedure TClassPropertyEditor.SetSubPropsTypeFilter(const AValue: TTypeKinds);
begin
if FSubPropsTypeFilter = AValue then exit;
FSubPropsTypeFilter := AValue;
end;
{ TMethodPropertyEditor }
@ -4072,7 +4117,7 @@ begin
NewMethodName := GetFormMethodName;
DebugLn('### TMethodPropertyEditor.Edit B FormMethodName=',NewMethodName);
if not IsValidIdent(NewMethodName) then
raise EPropertyError.Create('Method name '+NewMethodName+' must be an identifier');
raise EPropertyError.Create('Method name "'+NewMethodName+'" must be an identifier');
SetValue(NewMethodName); // this will jump to the method
PropertyHook.RefreshPropertyValues;
end else
@ -4293,18 +4338,12 @@ begin
Result := TPersistent(GetObjectValue);
end;
function TPersistentPropertyEditor.GetSelections:
TPersistentSelectionList;
var
I: Integer;
function TPersistentPropertyEditor.GetSelections: TPersistentSelectionList;
begin
Result := nil;
if (GetPersistentReference <> nil) and AllEqual then
begin
Result := TPersistentSelectionList.Create;
for I := 0 to PropCount - 1 do
Result.Add(TPersistent(GetObjectValueAt(I)));
end;
Result := inherited GetSelections
else
Result := nil;
end;
function TPersistentPropertyEditor.CheckNewValue(APersistent: TPersistent): boolean;
@ -4356,18 +4395,6 @@ begin
Result := Result + [paSubProperties, paVolatileSubProperties];
end;
procedure TPersistentPropertyEditor.GetProperties(Proc: TGetPropEditProc);
var
LPersistents: TPersistentSelectionList;
begin
LPersistents := GetSelections;
if LPersistents <> nil then
begin
GetPersistentProperties(LPersistents, tkAny, PropertyHook, Proc, nil);
LPersistents.Free;
end;
end;
function TPersistentPropertyEditor.GetEditLimit: Integer;
begin
Result := MaxIdentLength;
@ -4378,19 +4405,18 @@ var
Component: TComponent;
APersistent: TPersistent;
begin
Result:='';
APersistent:=GetPersistentReference;
Result := '';
APersistent := GetPersistentReference;
if APersistent is TComponent then begin
Component:=TComponent(APersistent);
if Assigned(PropertyHook) then begin
Result:=PropertyHook.GetComponentName(Component);
end else begin
Component := TComponent(APersistent);
if Assigned(PropertyHook) then
Result := PropertyHook.GetComponentName(Component)
else begin
if Assigned(Component) then
Result:=Component.Name;
Result := Component.Name;
end;
end else if APersistent<>nil then begin
Result:='('+APersistent.ClassName+')';
end;
end else if APersistent <> nil then
Result := inherited GetValue;
end;
procedure TPersistentPropertyEditor.GetValues(Proc: TGetStringProc);
@ -6742,6 +6768,49 @@ begin
TCollectionPropertyEditor.ShowCollectionEditor(ACollection, AComponent, APropertyName);
end;
function HasSubpropertiesInFilter(
const APropInfo: PPropInfo; const AFilter: TTypeKinds): Boolean;
var
visited: TFPList;
procedure Rec(A: PPropInfo);
var
propList: PPropList;
i: Integer;
ti: PTypeInfo;
begin
ti := A^.PropType;
//DebugLn('HasSubpropertiesInFilter: ', ti^.Name);
Result :=
(ti^.Kind <> tkClass) or
// Since components are selectable in the designer,
// there is always a possibility that some descendant class may have
// properties of the required kind.
(GetTypeData(ti)^.ClassType.InheritsFrom(TComponent));
// Class properties may directly or indirectly refer to the same class,
// so we must avoid infinite recursion.
if Result or (visited.IndexOf(ti) >= 0) then exit;
visited.Add(ti);
for i := 0 to GetPropList(ti, propList) - 1 do begin
if propList^[i]^.PropType^.Kind in AFilter then
Rec(propList^[i]);
if Result then break;
end;
FreeMem(propList);
visited.Delete(visited.Count - 1);
end;
begin
visited := TFPList.Create;
try
//DebugLn('HasSubpropertiesInFilter -> ', APropInfo^.Name, ': ', APropInfo^.PropType^.Name);
Rec(APropInfo);
//DebugLn('HasSubpropertiesInFilter <- ', BoolToStr(Result, true));
finally
visited.Free;
end;
end;
{ TNoteBookActiveControlPropertyEditor }
function TNoteBookActiveControlPropertyEditor.CheckNewValue(