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

ideintf: trial to properly fix a bug with showing more than needed in the Methods page of object inspector (part of issue #0013354) by patch of Alexander S. Klenin

Browse Source 
git-svn-id: trunk@19044 -
This commit is contained in:
paul 2009-03-20 15:03:57 +00:00
parent 46b1e4f932
commit 8fe1d7409b
3 changed files with 65 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -2905,7 +2905,7 @@ ideintf/newfield.pas svneol=native#text/pascal
ideintf/newitemintf.pas svneol=native#text/pascal
ideintf/objectinspector.lfm svneol=native#text/plain
ideintf/objectinspector.lrs svneol=native#text/plain
ideintf/objectinspector.pp svneol=native#text/plain
ideintf/objectinspector.pp svneol=native#text/pascal
ideintf/objectinspector_img.lrs svneol=native#text/plain
ideintf/objinspstrconsts.pas svneol=native#text/pascal
ideintf/oifavouriteproperties.pas svneol=native#text/pascal

21
ideintf/objectinspector.pp
View File

@ -392,7 +392,7 @@ type
procedure SetSubPropertiesColor(const AValue: TColor);
procedure UpdateScrollBar;
procedure FillComboboxItems;
function PropInfoFilter(const APropInfo: PPropInfo): Boolean;
function EditorFilter(const AEditor: TPropertyEditor): Boolean;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
@ -1183,12 +1183,6 @@ 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
@ -1578,8 +1572,8 @@ begin
FRows.Clear;
// get properties
GetPersistentProperties(
FSelection, FFilter, FPropertyEditorHook, @AddPropertyEditor,
@PropInfoFilter, nil);
FSelection, FFilter + [tkClass], FPropertyEditorHook, @AddPropertyEditor,
@EditorFilter);
// sort
FRows.Sort(@SortGridRows);
for a:=0 to FRows.Count-1 do begin
@ -2169,6 +2163,12 @@ begin
end;
end;
function TOICustomPropertyGrid.EditorFilter(
const AEditor: TPropertyEditor): Boolean;
begin
Result := IsInteresting(AEditor, FFilter);
end;
procedure TOICustomPropertyGrid.EraseBackground(DC: HDC);
begin
// everything is painted, so erasing the background is not needed
@ -4666,8 +4666,7 @@ begin
end;
PropertyGrid := CreateGrid(PROPS, oipgpProperties, 0);
// Nested or referenced objects may have events too.
EventGrid := CreateGrid([tkClass, tkMethod], oipgpEvents, 1);
EventGrid := CreateGrid([tkMethod], oipgpEvents, 1);
FavouriteGrid := CreateGrid(PROPS + [tkMethod], oipgpFavourite, 2);
FavouriteGrid.Favourites := FFavourites;
RestrictedGrid := CreateGrid(PROPS + [tkMethod], oipgpRestricted, 3);

83
ideintf/propedits.pp
View File

@ -552,7 +552,7 @@ type
private
FSubPropsTypeFilter: TTypeKinds;
procedure SetSubPropsTypeFilter(const AValue: TTypeKinds);
function PropInfoFilter(const APropInfo: PPropInfo): Boolean;
function EditorFilter(const AEditor: TPropertyEditor): Boolean;
protected
function GetSelections: TPersistentSelectionList; virtual;
public
@ -1608,8 +1608,8 @@ procedure EditCollection(AComponent: TComponent; ACollection: TCollection; AProp
// Returns true if given property should be displayed on the property list
// filtered by AFilter.
function HasSubpropertiesInFilter(
const APropInfo: PPropInfo; const AFilter: TTypeKinds): Boolean;
function IsInteresting(
const AEditor: TPropertyEditor; const AFilter: TTypeKinds): Boolean;
const
NoDefaultValue = Longint($80000000);
@ -4026,6 +4026,12 @@ begin
FSubPropsTypeFilter := tkAny;
end;
function TClassPropertyEditor.EditorFilter(
const AEditor: TPropertyEditor): Boolean;
begin
Result := IsInteresting(AEditor, SubPropsTypeFilter);
end;
function TClassPropertyEditor.GetAttributes: TPropertyAttributes;
begin
Result := [paMultiSelect, paSubProperties, paReadOnly];
@ -4038,7 +4044,7 @@ begin
selection := GetSelections;
if selection = nil then exit;
GetPersistentProperties(
selection, SubPropsTypeFilter, PropertyHook, Proc, @PropInfoFilter, nil);
selection, SubPropsTypeFilter + [tkClass], PropertyHook, Proc, @EditorFilter);
selection.Free;
end;
@ -4065,12 +4071,6 @@ begin
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;
@ -4388,11 +4388,11 @@ function TPersistentPropertyEditor.GetAttributes: TPropertyAttributes;
begin
Result := [paMultiSelect];
if Assigned(GetPropInfo^.SetProc) then
Result := Result + [paValueList, paSortList, paRevertable]
Result += [paValueList, paSortList, paRevertable, paVolatileSubProperties]
else
Result := Result + [paReadOnly];
if GReferenceExpandable and (GetPersistentReference <> nil) and AllEqual then
Result := Result + [paSubProperties, paVolatileSubProperties];
Result := Result + [paSubProperties];
end;
function TPersistentPropertyEditor.GetEditLimit: Integer;
@ -6768,32 +6768,57 @@ begin
TCollectionPropertyEditor.ShowCollectionEditor(ACollection, AComponent, APropertyName);
end;
function HasSubpropertiesInFilter(
const APropInfo: PPropInfo; const AFilter: TTypeKinds): Boolean;
function IsInteresting(
const AEditor: TPropertyEditor; const AFilter: TTypeKinds): Boolean;
var
visited: TFPList;
procedure Rec(A: PPropInfo);
procedure Rec(A: TPropertyEditor);
var
propList: PPropList;
i: Integer;
ti: PTypeInfo;
edClass: TPropertyEditorClass;
ed: TPropertyEditor;
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(TPersistent));
ti := A.GetPropInfo^.PropType;
//DebugLn('IsInteresting: ', ti^.Name);
Result := ti^.Kind <> tkClass;
if Result then exit;
// Subroperties can change if user selects another object =>
// we must show the property, even if it is not interesting currently.
Result := paVolatileSubProperties in A.GetAttributes;
if Result then exit;
if tkClass in AFilter then begin
// We want classes => any non-trivial editor is immediately interesting.
Result := A.ClassType <> TClassPropertyEditor;
if Result then exit;
end
else if
A.GetAttributes * [paSubProperties, paVolatileSubProperties] = []
then exit;
// At this stage, there is nothing interesting left in empty objects.
if A.GetComponent(0) = nil then exit;
// 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;
if 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 not (propList^[i]^.PropType^.Kind in AFilter + [tkClass]) then continue;
edClass := GetEditorClass(propList^[i], A.GetComponent(0));
if edClass = nil then continue;
ed := edClass.Create(nil, 1);
try
ed.SetPropEntry(0, A.GetComponent(0), propList^[i]);
ed.Initialize;
Rec(ed);
finally
ed.Free;
end;
if Result then break;
end;
FreeMem(propList);
@ -6803,9 +6828,9 @@ var
begin
visited := TFPList.Create;
try
//DebugLn('HasSubpropertiesInFilter -> ', APropInfo^.Name, ': ', APropInfo^.PropType^.Name);
Rec(APropInfo);
//DebugLn('HasSubpropertiesInFilter <- ', BoolToStr(Result, true));
//DebugLn('IsInteresting -> ', AEditor.GetPropInfo^.Name, ': ', AEditor.GetPropInfo^.PropType^.Name);
Rec(AEditor);
//DebugLn('IsInteresting <- ', BoolToStr(Result, true));
finally
visited.Free;
end;