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

implemented showing object names for TTIGrid

Browse Source 
git-svn-id: trunk@6521 -
This commit is contained in:
mattias 2005-01-09 13:48:06 +00:00
parent 8f4126458f
commit 9ce30e43e9
2 changed files with 169 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

215
components/rtticontrols/rttigrids.pas
View File

@ -78,8 +78,21 @@ type
tgsDefaultDrawing // set during default drawing
);
TTIGridStates = set of TTIGridState;
TTIGridCellType = (
tgctNone, // out or undefined
tgctValue, // a normal property cell
tgctPropName, // header cell for property name
tgctPropNameAlt,// header cell for alternative prop name (e.g. FixedRows>1)
tgctObjectName, // header cell for object name
tgctObjectNameAlt,// header cell for alternative obj name (e.g. FixedCols>1)
tgctCorner // corner cell left, top of grid
);
TTIGridOption = (
tgoStartIndexAtOne // start shown object index at 1
);
TTIGridOptions = set of TTIGridOption;
TTICustomGrid = class;
{ TTIGridProperty }
TTIGridProperty = class
@ -110,7 +123,7 @@ type
FOnHeaderClick: THdrEvent;
FOnHeaderSized: THdrEvent;
FHeaderPropHook: TPropertyEditorHook;
FSaveOnChangeTIObject: boolean;
FTIOptions: TTIGridOptions;
FTIStates: TTIGridStates;
FTIObjectCount: integer;
FProperties: TList;
@ -119,6 +132,7 @@ type
procedure SetFilter(const AValue: TTypeKinds);
procedure SetListDirection(const AValue: TTIListDirection);
procedure SetListObject(const AValue: TObject);
procedure SetTIOptions(const NewOptions: TTIGridOptions);
protected
procedure ReloadTIList;
procedure LoadCollection;
@ -134,10 +148,11 @@ type
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure Loaded; override;
procedure SaveChanges; virtual;
procedure ClearProperties;
procedure DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect;
aState: TGridDrawState); virtual;
procedure DrawObjectName(Index: integer; aRect: TRect;
aState: TGridDrawState);
procedure GetCellEditor(aCol, aRow: integer;
var PropEditor: TPropertyEditor;
var IndependentEditor: boolean);
@ -145,14 +160,14 @@ type
function GridStateToPropEditState(GridState: TGridDrawState
): TPropEditDrawState;
function GetTIObject(Index: integer): TPersistent;
procedure MapCell(aCol, aRow: integer;
var ObjectIndex, PropertyIndex: integer;
var CellType: TTIGridCellType);
public
property ListObject: TObject read FListObject write SetListObject;
property ListDirection: TTIListDirection read FListDirection
write SetListDirection default tldObjectsAsRows;
property DefaultRowHeight default 20;
property SaveOnChangeTIObject: boolean read FSaveOnChangeTIObject
write FSaveOnChangeTIObject
default true;
property Filter: TTypeKinds read FFilter write SetFilter default AllTypeKinds;
property PropertyEditorHook: TPropertyEditorHook read FHeaderPropHook;
property TIObjectCount: integer read FTIObjectCount;
@ -160,6 +175,7 @@ type
property Properties[Index: integer]: TTIGridProperty read GetProperties;
property OnHeaderClick: THdrEvent read FOnHeaderClick write FOnHeaderClick;
property OnHeaderSized: THdrEvent read FOnHeaderSized write FOnHeaderSized;
property TIOptions: TTIGridOptions read FTIOptions write SetTIOptions;
end;
@ -247,11 +263,19 @@ procedure TTICustomGrid.SetListObject(const AValue: TObject);
begin
if FListObject=AValue then exit;
FListObject:=AValue;
if SaveOnChangeTIObject then
SaveChanges;
ReloadTIList;
end;
procedure TTICustomGrid.SetTIOptions(const NewOptions: TTIGridOptions);
var
ChangedOptions: TTIGridOptions;
begin
if FTIOptions=NewOptions then exit;
ChangedOptions:=(FTIOptions-NewOptions)+(NewOptions-FTIOptions);
FTIOptions:=NewOptions;
if tgoStartIndexAtOne in ChangedOptions then Invalidate;
end;
procedure TTICustomGrid.ReloadTIList;
begin
if ([csLoading,csDestroying]*ComponentState)<>[] then begin
@ -379,11 +403,6 @@ begin
ReloadTIList;
end;
procedure TTICustomGrid.SaveChanges;
begin
// TODO
end;
procedure TTICustomGrid.ClearProperties;
var
i: Integer;
@ -398,6 +417,9 @@ var
OldDefaultDrawing: boolean;
PropEditor: TPropertyEditor;
IndependentEditor: boolean;
ObjectIndex: integer;
PropertyIndex: integer;
CellType: TTIGridCellType;
begin
OldDefaultDrawing:=tgsDefaultDrawing in FTIStates;
Include(FTIStates,tgsDefaultDrawing);
@ -410,20 +432,73 @@ begin
Exclude(FTIStates,tgsDefaultDrawing);
end;
if goColSpanning in Options then CalcCellExtent(acol, arow, aRect);
debugln('TTICustomGrid.DefaultDrawCell A Col=',dbgs(aCol),' Row=',dbgs(aRow));
// fetch a property editor and draw cell
PropEditor:=nil;
GetCellEditor(aCol,aRow,PropEditor,IndependentEditor);
if PropEditor<>nil then begin
debugln('TTICustomGrid.DefaultDrawCell B ',dbgsName(PropEditor),' ',PropEditor.GetName,' ',PropEditor.GetValue);
try
if gdFixed in aState then
PropEditor.PropDrawName(Canvas,aRect,GridStateToPropEditState(aState))
else
PropEditor.PropDrawValue(Canvas,aRect,GridStateToPropEditState(aState));
finally
if IndependentEditor then PropEditor.Free;
Canvas.FillRect(aRect);
//debugln('TTICustomGrid.DefaultDrawCell A Col=',dbgs(aCol),' Row=',dbgs(aRow));
MapCell(aCol,aRow,ObjectIndex,PropertyIndex,CellType);
if CellType in [tgctValue,tgctPropName] then begin
// fetch a property editor and draw cell
PropEditor:=nil;
GetCellEditor(aCol,aRow,PropEditor,IndependentEditor);
if PropEditor<>nil then begin
//debugln('TTICustomGrid.DefaultDrawCell B ',dbgsName(PropEditor),' ',PropEditor.GetName,' ',PropEditor.GetValue);
try
if gdFixed in aState then
PropEditor.PropDrawName(Canvas,aRect,GridStateToPropEditState(aState))
else
PropEditor.PropDrawValue(Canvas,aRect,GridStateToPropEditState(aState));
finally
if IndependentEditor then PropEditor.Free;
end;
end;
end else if CellType=tgctObjectName then begin
DrawObjectName(ObjectIndex,aRect,aState);
end;
end;
procedure TTICustomGrid.DrawObjectName(Index: integer; aRect: TRect;
aState: TGridDrawState);
function GetTIObjectName(ObjIndex: integer): string;
var
ACollectionItem: TCollectionItem;
AnObject: TPersistent;
begin
Result:='';
AnObject:=GetTIObject(ObjIndex);
if AnObject is TComponent then
Result:=TComponent(AnObject).Name
else if AnObject is TCollectionItem then begin
ACollectionItem:=TCollectionItem(AnObject);
Result:=ACollectionItem.DisplayName;
// the default DisplayName is the ClassName, which is not informative
if CompareText(Result,ACollectionItem.ClassName)=0 then Result:='';
end;
if Result='' then begin
if tgoStartIndexAtOne in TIOptions then
Result:=IntToStr(ObjIndex+1)
else
Result:=IntToStr(ObjIndex);
end;
end;
procedure FixRectangle;
begin
case Canvas.TextStyle.Alignment of
Classes.taLeftJustify: Inc(aRect.Left, 3);
Classes.taRightJustify: Dec(aRect.Right, 3);
end;
Inc(aRect.Top, 2);
end;
var
ObjectName: String;
begin
if aState=[] then ;
if (Index<0) or (Index>=TIObjectCount) then exit;
ObjectName:=GetTIObjectName(Index);
if ObjectName<>'' then begin
FixRectangle;
Canvas.TextRect(aRect,ARect.Left,ARect.Top,ObjectName);
end;
end;
@ -435,41 +510,29 @@ var
EditorClass: TPropertyEditorClass;
Hook: TPropertyEditorHook;
GridProperty: TTIGridProperty;
PersistentList: TPersistentSelectionList;
ok: Boolean;
CurObject: TPersistent;
IsHeader: Boolean;
CellType: TTIGridCellType;
begin
PropEditor:=nil;
IndependentEditor:=true;
if ListDirection=tldObjectsAsRows then begin
ObjectIndex:=aRow-FixedRows;
PropertyIndex:=aCol-FixedCols;
IsHeader:=(aRow>=0) and (aRow<FixedRows);
end else begin
ObjectIndex:=aCol-FixedCols;
PropertyIndex:=aRow-FixedRows;
IsHeader:=(aCol>=0) and (aCol<FixedCols);
end;
if (PropertyIndex>=0) and (PropertyIndex<PropertyCount) then begin
MapCell(aCol,aRow,ObjectIndex,PropertyIndex,CellType);
if CellType in [tgctValue,tgctPropName] then begin
GridProperty:=Properties[PropertyIndex];
if IsHeader then begin
if CellType=tgctPropName then begin
IndependentEditor:=false;
PropEditor:=GridProperty.Editor;
end
else if (ObjectIndex>=0) and (ObjectIndex<TIObjectCount) then begin
else begin
CurObject:=GetTIObject(ObjectIndex);
if CurObject<>nil then begin
ok:=false;
Hook:=nil;
PersistentList:=nil;
try
Hook:=TPropertyEditorHook.Create;
Hook.LookupRoot:=CurObject;
PersistentList:=TPersistentSelectionList.Create;
PersistentList.Add(CurObject);
EditorClass:=TPropertyEditorClass(GridProperty.Editor.ClassType);
PropEditor:=EditorClass.Create(Hook,PersistentList,1);
PropEditor:=EditorClass.Create(Hook,1);
PropEditor.SetPropEntry(0,CurObject,GridProperty.PropInfo);
PropEditor.Initialize;
ok:=true;
@ -479,10 +542,6 @@ begin
PropEditor.free;
except
end;
try
PersistentList.free;
except
end;
try
Hook.free;
except
@ -497,19 +556,13 @@ end;
procedure TTICustomGrid.FreeCellEditor(PropEditor: TPropertyEditor);
var
Hook: TPropertyEditorHook;
PersistentList: TPersistentSelectionList;
begin
if PropEditor=nil then exit;
Hook:=PropEditor.PropertyHook;
PersistentList:=PropEditor.ComponentList;
try
PropEditor.free;
except
end;
try
PersistentList.free;
except
end;
try
Hook.free;
except
@ -533,6 +586,60 @@ begin
end;
end;
procedure TTICustomGrid.MapCell(aCol, aRow: integer; var ObjectIndex,
PropertyIndex: integer; var CellType: TTIGridCellType);
var
PropHeaderLines: LongInt;
ObjectHeaderLines: LongInt;
PropertyIndexValid: Boolean;
ObjectIndexValid: Boolean;
PropertyIndexInHeader: Boolean;
ObjectIndexInHeader: Boolean;
begin
if ListDirection=tldObjectsAsRows then begin
ObjectIndex:=aRow-FixedRows;
PropertyIndex:=aCol-FixedCols;
PropHeaderLines:=FixedRows;
ObjectHeaderLines:=FixedCols;
end else begin
ObjectIndex:=aCol-FixedCols;
PropertyIndex:=aRow-FixedRows;
PropHeaderLines:=FixedCols;
ObjectHeaderLines:=FixedRows;
end;
PropertyIndexValid:=(PropertyIndex>=0) and (PropertyIndex<PropertyCount);
ObjectIndexValid:=(ObjectIndex>=0) and (ObjectIndex<TIObjectCount);
PropertyIndexInHeader:=(PropertyIndex<0)
and (PropertyIndex>=-PropHeaderLines);
ObjectIndexInHeader:=(ObjectIndex<0)
and (ObjectIndex>=-ObjectHeaderLines);
//debugln('TTICustomGrid.MapCell A ',dbgs(aCol),',',dbgs(aRow),' ',
// dbgs(PropertyIndex),',',dbgs(ObjectIndex),' ',
// dbgs(PropertyIndexValid),',',dbgs(ObjectIndexValid),
// ' ',dbgs(PropertyIndexInHeader),',',dbgs(ObjectIndexInHeader));
CellType:=tgctNone;
if PropertyIndexValid then begin
if ObjectIndexValid then
CellType:=tgctValue
else if ObjectIndexInHeader then begin
if ObjectIndex=-1 then
CellType:=tgctPropName
else
CellType:=tgctPropNameAlt;
end;
end else if ObjectIndexValid then begin
if PropertyIndexInHeader then begin
if PropertyIndex=-1 then
CellType:=tgctObjectName
else
CellType:=tgctObjectNameAlt;
end;
end else begin
if PropertyIndexInHeader and ObjectIndexInHeader then
CellType:=tgctCorner;
end;
end;
{ TTIGridProperty }
procedure TTIGridProperty.SetTitle(const AValue: string);

23
ideintf/propedits.pp
View File

@ -285,16 +285,13 @@ type
TPropertyEditor=class
private
FComponents: TPersistentSelectionList;
FOnSubPropertiesChanged: TNotifyEvent;
FPropertyHook: TPropertyEditorHook;
FPropCount: Integer;
FPropList: PInstPropList;
function GetPrivateDirectory: ansistring;
public
constructor Create(Hook:TPropertyEditorHook;
APersistentList: TPersistentSelectionList;
APropCount:Integer); virtual;
constructor Create(Hook:TPropertyEditorHook; APropCount:Integer); virtual;
destructor Destroy; override;
procedure Activate; virtual;
procedure Deactivate; virtual;
@ -365,7 +362,6 @@ type
property FirstValue:ansistring read GetValue write SetValue;
property OnSubPropertiesChanged: TNotifyEvent
read FOnSubPropertiesChanged write FOnSubPropertiesChanged;
property ComponentList: TPersistentSelectionList read FComponents;
end;
TPropertyEditorClass=class of TPropertyEditor;
@ -862,8 +858,7 @@ type
procedure SetElementValue(Element: TListElementPropertyEditor;
NewValue: ansistring); virtual;
public
constructor Create(Hook:TPropertyEditorHook;
APersistentList: TPersistentSelectionList; APropCount:Integer); override;
constructor Create(Hook:TPropertyEditorHook; APropCount:Integer); override;
destructor Destroy; override;
function GetAttributes: TPropertyAttributes; override;
function GetElementCount: integer;
@ -1863,7 +1858,7 @@ begin
end;
// create a test property editor for the property
PropEditor := EdClass.Create(AHook,ASelection,1);
PropEditor := EdClass.Create(AHook,1);
PropEditor.SetPropEntry(0, Instance, PropInfo);
PropEditor.Initialize;
// with PropInfo^ do begin
@ -1900,7 +1895,7 @@ begin
begin
EdClass := GetEditorClass(Candidates[I], Instance);
if EdClass = nil then Continue;
PropEditor := EdClass.Create(AHook, ASelection, SelCount);
PropEditor := EdClass.Create(AHook, SelCount);
AddEditor := True;
for J := 0 to SelCount - 1 do
begin
@ -1960,12 +1955,11 @@ end;
{ TPropertyEditor }
constructor TPropertyEditor.Create(Hook: TPropertyEditorHook;
APersistentList: TPersistentSelectionList; APropCount:Integer);
APropCount:Integer);
var
PropListSize: Integer;
begin
FPropertyHook:=Hook;
FComponents:=APersistentList;
PropListSize:=APropCount * SizeOf(TInstProp);
GetMem(FPropList,PropListSize);
FillChar(FPropList^,PropListSize,0);
@ -3038,7 +3032,6 @@ constructor TNestedPropertyEditor.Create(Parent: TPropertyEditor);
begin
FParentEditor:=Parent;
FPropertyHook:=Parent.PropertyHook;
FComponents:=Parent.FComponents;
FPropList:=Parent.FPropList;
FPropCount:=Parent.PropCount;
end;
@ -3371,9 +3364,9 @@ begin
end;
constructor TListPropertyEditor.Create(Hook: TPropertyEditorHook;
APersistentList: TPersistentSelectionList; APropCount: Integer);
APropCount: Integer);
begin
inherited Create(Hook, APersistentList, APropCount);
inherited Create(Hook, APropCount);
SavedElements:=TList.Create;
SavedPropertyEditors:=TList.Create;
end;
@ -6116,7 +6109,7 @@ begin
PersistentList:=TPersistentSelectionList.Create;
PersistentList.Add(AComponent);
Hook:=GlobalDesignHook;
MethodPropEditor:=TMethodPropertyEditor.Create(Hook,PersistentList,1);
MethodPropEditor:=TMethodPropertyEditor.Create(Hook,1);
MethodPropEditor.SetPropEntry(0, AComponent, PropInfo);
MethodPropEditor.Initialize;
MethodPropEditor.Edit;