mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-23 00:39:44 +02:00
implemented basic TTIGrid showing value cells
git-svn-id: trunk@6518 -
This commit is contained in:
mattias
parent
f771e4ab9a
commit
893a0a64e3
@ -24,7 +24,8 @@ unit RTTIGrids;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, ObjectInspector, PropEdits, RTTICtrls, Grids;
|
||||
Classes, SysUtils, LCLProc, ObjectInspector, PropEdits, TypInfo, RTTICtrls,
|
||||
Grids;
|
||||
|
||||
type
|
||||
{ TTICustomPropertyGrid }
|
||||
@ -72,37 +73,93 @@ type
|
||||
|
||||
|
||||
TTIListDirection = (tldObjectsAsRows, tldObjectsAsColumns);
|
||||
TTIGridState = (tgsRebuildTIListNeeded);
|
||||
TTIGridState = (
|
||||
tgsRebuildTIListNeeded,
|
||||
tgsDefaultDrawing // set during default drawing
|
||||
);
|
||||
TTIGridStates = set of TTIGridState;
|
||||
TTICustomGrid = class;
|
||||
|
||||
{ TTIGridProperty }
|
||||
|
||||
TTIGridProperty = class
|
||||
private
|
||||
FEditor: TPropertyEditor;
|
||||
FGrid: TTICustomGrid;
|
||||
FIndex: integer;
|
||||
FTitle: string;
|
||||
procedure SetTitle(const AValue: string);
|
||||
public
|
||||
constructor Create(TheGrid: TTICustomGrid; TheEditor: TPropertyEditor;
|
||||
TheIndex: integer);
|
||||
function PropInfo: PPropInfo;
|
||||
public
|
||||
property Editor: TPropertyEditor read FEditor;
|
||||
property Grid: TTICustomGrid read FGrid;
|
||||
property Index: integer read FIndex;
|
||||
property Title: string read FTitle write SetTitle;
|
||||
end;
|
||||
|
||||
{ TTICustomGrid }
|
||||
|
||||
TTICustomGrid = class(TCustomGrid)
|
||||
private
|
||||
FAutoFreeHook: boolean;
|
||||
FFilter: TTypeKinds;
|
||||
FListDirection: TTIListDirection;
|
||||
FListObject: TObject;
|
||||
FOnHeaderClick: THdrEvent;
|
||||
FOnHeaderSized: THdrEvent;
|
||||
FPropertyEditorHook: TPropertyEditorHook;
|
||||
FSaveOnChangeTIObject: boolean;
|
||||
FTIStates: TTIGridStates;
|
||||
procedure SetAutoFreeHook(const AValue: boolean);
|
||||
FTIObjectCount: integer;
|
||||
FProperties: TList;
|
||||
function GetProperties(Index: integer): TTIGridProperty;
|
||||
function GetPropertyCount: integer;
|
||||
procedure SetFilter(const AValue: TTypeKinds);
|
||||
procedure SetListDirection(const AValue: TTIListDirection);
|
||||
procedure SetListObject(const AValue: TObject);
|
||||
protected
|
||||
procedure ReloadTIList;
|
||||
procedure LoadCollection;
|
||||
procedure AddHeaderPropertyEditor(Prop: TPropertyEditor);
|
||||
procedure DrawCell(aCol, aRow: Integer; aRect: TRect;
|
||||
aState: TGridDrawState); override;
|
||||
procedure CalcCellExtent(aCol, aRow: Integer; var aRect: TRect); virtual;
|
||||
procedure HeaderClick(IsColumn: Boolean; index: Integer); override;
|
||||
procedure HeaderSized(IsColumn: Boolean; index: Integer); override;
|
||||
procedure GetAutoFillColumnInfo(const Index: Integer;
|
||||
var aMin,aMax,aPriority: Integer); override;
|
||||
public
|
||||
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 GetCellEditor(aCol, aRow: integer;
|
||||
var PropEditor: TPropertyEditor;
|
||||
var IndependentEditor: boolean);
|
||||
procedure FreeCellEditor(PropEditor: TPropertyEditor);
|
||||
function GridStateToPropEditState(GridState: TGridDrawState
|
||||
): TPropEditDrawState;
|
||||
function GetTIObject(Index: integer): TPersistent;
|
||||
public
|
||||
property ListObject: TObject read FListObject write SetListObject;
|
||||
property ListDirection: TTIListDirection read FListDirection write SetListDirection;
|
||||
property ListDirection: TTIListDirection read FListDirection
|
||||
write SetListDirection default tldObjectsAsRows;
|
||||
property DefaultRowHeight default 20;
|
||||
property AutoFreeHook: boolean read FAutoFreeHook write SetAutoFreeHook;
|
||||
property SaveOnChangeTIObject: boolean read FSaveOnChangeTIObject
|
||||
write FSaveOnChangeTIObject
|
||||
default true;
|
||||
property Filter: TTypeKinds read FFilter write SetFilter default AllTypeKinds;
|
||||
property PropertyEditorHook: TPropertyEditorHook read FPropertyEditorHook;
|
||||
property TIObjectCount: integer read FTIObjectCount;
|
||||
property PropertyCount: integer read GetPropertyCount;
|
||||
property Properties[Index: integer]: TTIGridProperty read GetProperties;
|
||||
property OnHeaderClick: THdrEvent read FOnHeaderClick write FOnHeaderClick;
|
||||
property OnHeaderSized: THdrEvent read FOnHeaderSized write FOnHeaderSized;
|
||||
end;
|
||||
|
||||
|
||||
@ -157,7 +214,7 @@ implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('RTTI',[TTIPropertyGrid,TTIGrid]);
|
||||
RegisterComponents('RTTI',[TTIPropertyGrid]);
|
||||
end;
|
||||
|
||||
{ TTICustomStringGrid }
|
||||
@ -169,10 +226,21 @@ begin
|
||||
ReloadTIList;
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.SetAutoFreeHook(const AValue: boolean);
|
||||
function TTICustomGrid.GetPropertyCount: integer;
|
||||
begin
|
||||
if FAutoFreeHook=AValue then exit;
|
||||
FAutoFreeHook:=AValue;
|
||||
Result:=FProperties.Count;
|
||||
end;
|
||||
|
||||
function TTICustomGrid.GetProperties(Index: integer): TTIGridProperty;
|
||||
begin
|
||||
Result:=TTIGridProperty(FProperties[Index]);
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.SetFilter(const AValue: TTypeKinds);
|
||||
begin
|
||||
if FFilter=AValue then exit;
|
||||
FFilter:=AValue;
|
||||
ReloadTIList;
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.SetListObject(const AValue: TObject);
|
||||
@ -202,36 +270,106 @@ end;
|
||||
procedure TTICustomGrid.LoadCollection;
|
||||
var
|
||||
TheCollection: TCollection;
|
||||
ObjectCount: LongInt;
|
||||
CurItem: TCollectionItem;
|
||||
HeaderLines: LongInt;
|
||||
PropCount: LongInt;
|
||||
begin
|
||||
TheCollection:=FListObject as TCollection;
|
||||
ObjectCount:=TheCollection.Count;
|
||||
FTIObjectCount:=TheCollection.Count;
|
||||
if ListDirection=tldObjectsAsRows then begin
|
||||
HeaderLines:=FixedRows;
|
||||
RowCount:=HeaderLines+ObjectCount
|
||||
RowCount:=HeaderLines+FTIObjectCount
|
||||
end else begin
|
||||
HeaderLines:=FixedCols;
|
||||
ColCount:=HeaderLines+ObjectCount;
|
||||
ColCount:=HeaderLines+FTIObjectCount;
|
||||
end;
|
||||
// get first object to create the grid header
|
||||
if ObjectCount=0 then exit;
|
||||
if FTIObjectCount=0 then exit;
|
||||
CurItem:=TheCollection.Items[0];
|
||||
if not (CurItem is TPersistent) then begin
|
||||
debugln('TTICustomGrid.LoadCollection First CollectionItem=',dbgsName(CurItem));
|
||||
exit;
|
||||
end;
|
||||
|
||||
// get header properties
|
||||
FPropertyEditorHook.LookupRoot:=CurItem;
|
||||
ClearProperties;
|
||||
GetPersistentProperties(CurItem, FFilter, FPropertyEditorHook,
|
||||
@AddHeaderPropertyEditor,nil);
|
||||
PropCount:=PropertyCount;
|
||||
if ListDirection=tldObjectsAsRows then begin
|
||||
ColCount:=FixedCols+PropCount;
|
||||
end else begin
|
||||
RowCount:=FixedRows+PropCount;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.AddHeaderPropertyEditor(Prop: TPropertyEditor);
|
||||
var
|
||||
NewProperty: TTIGridProperty;
|
||||
begin
|
||||
NewProperty:=TTIGridProperty.Create(Self,Prop,FProperties.Count);
|
||||
FProperties.Add(NewProperty);
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
|
||||
aState: TGridDrawState);
|
||||
begin
|
||||
if Assigned(OnDrawCell) and not (csDesigning in ComponentState) then begin
|
||||
PrepareCanvas(aCol, aRow, aState);
|
||||
if DefaultDrawing then
|
||||
Canvas.FillRect(aRect);
|
||||
OnDrawCell(Self,aCol,aRow,aRect,aState)
|
||||
end else
|
||||
DefaultDrawCell(aCol,aRow,aRect,aState);
|
||||
DrawCellGrid(aCol,aRow,aRect,aState);
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.CalcCellExtent(aCol, aRow: Integer; var aRect: TRect);
|
||||
begin
|
||||
if (aCol=0) and (aRow=0) and (ARect.Left=0) then ;
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.HeaderClick(IsColumn: Boolean; index: Integer);
|
||||
begin
|
||||
inherited HeaderClick(IsColumn, index);
|
||||
if Assigned(OnHeaderClick) then OnHeaderClick(Self, IsColumn, index);
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.HeaderSized(IsColumn: Boolean; index: Integer);
|
||||
begin
|
||||
inherited HeaderSized(IsColumn, index);
|
||||
if Assigned(OnHeaderSized) then OnHeaderSized(Self, IsColumn, index);
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.GetAutoFillColumnInfo(const Index: Integer; var aMin,
|
||||
aMax, aPriority: Integer);
|
||||
begin
|
||||
if (aMin=0) and (aMax=0) then ;
|
||||
if (Index<FixedCols) then
|
||||
aPriority := 0
|
||||
else
|
||||
aPriority := 1;
|
||||
end;
|
||||
|
||||
constructor TTICustomGrid.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
FPropertyEditorHook:=TPropertyEditorHook.Create;
|
||||
FFilter:=[{tkUnknown,}tkInteger,tkChar,tkEnumeration,
|
||||
tkFloat,{tkSet,tkMethod,}tkSString,tkLString,tkAString,
|
||||
tkWString,tkVariant,{tkArray,tkRecord,tkInterface,}
|
||||
{tkClass,tkObject,}tkWChar,tkBool,tkInt64,
|
||||
tkQWord{,tkDynArray,tkInterfaceRaw}];
|
||||
FProperties:=TList.Create;
|
||||
FListDirection:=tldObjectsAsRows;
|
||||
end;
|
||||
|
||||
destructor TTICustomGrid.Destroy;
|
||||
begin
|
||||
ClearProperties;
|
||||
FreeThenNil(FProperties);
|
||||
FreeThenNil(FPropertyEditorHook);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -243,7 +381,170 @@ end;
|
||||
|
||||
procedure TTICustomGrid.SaveChanges;
|
||||
begin
|
||||
// TODO
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.ClearProperties;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if FProperties=nil then exit;
|
||||
for i:=0 to FProperties.Count-1 do TObject(FProperties[i]).Free;
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect;
|
||||
aState: TGridDrawState);
|
||||
var
|
||||
OldDefaultDrawing: boolean;
|
||||
PropEditor: TPropertyEditor;
|
||||
IndependentEditor: boolean;
|
||||
begin
|
||||
OldDefaultDrawing:=tgsDefaultDrawing in FTIStates;
|
||||
Include(FTIStates,tgsDefaultDrawing);
|
||||
try
|
||||
PrepareCanvas(aCol, aRow, aState);
|
||||
finally
|
||||
if OldDefaultDrawing then
|
||||
Include(FTIStates,tgsDefaultDrawing)
|
||||
else
|
||||
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;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTICustomGrid.GetCellEditor(aCol, aRow: integer;
|
||||
var PropEditor: TPropertyEditor; var IndependentEditor: boolean);
|
||||
var
|
||||
ObjectIndex: Integer;
|
||||
PropertyIndex: Integer;
|
||||
EditorClass: TPropertyEditorClass;
|
||||
Hook: TPropertyEditorHook;
|
||||
GridProperty: TTIGridProperty;
|
||||
PersistentList: TPersistentSelectionList;
|
||||
ok: Boolean;
|
||||
CurObject: TPersistent;
|
||||
begin
|
||||
PropEditor:=nil;
|
||||
IndependentEditor:=true;
|
||||
if ListDirection=tldObjectsAsRows then begin
|
||||
ObjectIndex:=aRow-FixedRows;
|
||||
PropertyIndex:=aCol-FixedCols;
|
||||
end else begin
|
||||
ObjectIndex:=aCol-FixedCols;
|
||||
PropertyIndex:=aRow-FixedRows;
|
||||
end;
|
||||
if (PropertyIndex>=0) and (PropertyIndex<PropertyCount)
|
||||
and (ObjectIndex>=0) and (ObjectIndex<TIObjectCount) then 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);
|
||||
GridProperty:=Properties[PropertyIndex];
|
||||
EditorClass:=TPropertyEditorClass(GridProperty.Editor.ClassType);
|
||||
PropEditor:=EditorClass.Create(Hook,PersistentList,1);
|
||||
PropEditor.SetPropEntry(0,CurObject,GridProperty.PropInfo);
|
||||
PropEditor.Initialize;
|
||||
ok:=true;
|
||||
finally
|
||||
if not ok then begin
|
||||
try
|
||||
PropEditor.free;
|
||||
except
|
||||
end;
|
||||
try
|
||||
PersistentList.free;
|
||||
except
|
||||
end;
|
||||
try
|
||||
Hook.free;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
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
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTICustomGrid.GridStateToPropEditState(GridState: TGridDrawState
|
||||
): TPropEditDrawState;
|
||||
begin
|
||||
Result:=[];
|
||||
if gdSelected in GridState then Include(Result,pedsSelected);
|
||||
if gdFocused in GridState then Include(Result,pedsFocused);
|
||||
end;
|
||||
|
||||
function TTICustomGrid.GetTIObject(Index: integer): TPersistent;
|
||||
begin
|
||||
Result:=nil;
|
||||
if (Index<0) or (Index>=TIObjectCount) then exit;
|
||||
if ListObject is TCollection then begin
|
||||
Result:=TCollection(ListObject).Items[Index];
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TTIGridProperty }
|
||||
|
||||
procedure TTIGridProperty.SetTitle(const AValue: string);
|
||||
begin
|
||||
if FTitle=AValue then exit;
|
||||
FTitle:=AValue;
|
||||
end;
|
||||
|
||||
constructor TTIGridProperty.Create(TheGrid: TTICustomGrid;
|
||||
TheEditor: TPropertyEditor; TheIndex: integer);
|
||||
begin
|
||||
FGrid:=TheGrid;
|
||||
FEditor:=TheEditor;
|
||||
FIndex:=TheIndex;
|
||||
FTitle:=TheEditor.GetName;
|
||||
end;
|
||||
|
||||
function TTIGridProperty.PropInfo: PPropInfo;
|
||||
begin
|
||||
Result:=Editor.GetPropInfo;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
@ -365,6 +365,7 @@ 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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user