added example for TTIGrid

git-svn-id: trunk@6523 -
2025-09-03 10:22:38 +02:00 · 2005-01-09 14:51:55 +00:00 · 2005-01-09 14:51:55 +00:00 · e58fafc956
commit e58fafc956
parent 1be6e84c55
7 changed files with 290 additions and 16 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -158,12 +158,17 @@ components/rtticontrols/examples/example2.pas svneol=native#text/pascal
 components/rtticontrols/examples/example3.lfm svneol=native#text/plain
 components/rtticontrols/examples/example3.lrs svneol=native#text/pascal
 components/rtticontrols/examples/example3.pas svneol=native#text/pascal
+components/rtticontrols/examples/examplegrid1.lfm svneol=native#text/plain
+components/rtticontrols/examples/examplegrid1.lrs svneol=native#text/pascal
+components/rtticontrols/examples/examplegrid1.pas svneol=native#text/pascal
 components/rtticontrols/examples/exampleproject1.lpi svneol=native#text/plain
 components/rtticontrols/examples/exampleproject1.lpr svneol=native#text/pascal
 components/rtticontrols/examples/exampleproject2.lpi svneol=native#text/plain
 components/rtticontrols/examples/exampleproject2.lpr svneol=native#text/pascal
 components/rtticontrols/examples/exampleproject3.lpi svneol=native#text/plain
 components/rtticontrols/examples/exampleproject3.lpr svneol=native#text/pascal
+components/rtticontrols/examples/exampleprojectgrid1.lpi svneol=native#text/plain
+components/rtticontrols/examples/exampleprojectgrid1.lpr svneol=native#text/pascal
 components/rtticontrols/rttictrls.lrs svneol=native#text/pascal
 components/rtticontrols/rttictrls.pas svneol=native#text/pascal
 components/rtticontrols/rttigrids.pas svneol=native#text/pascal
--- a/components/rtticontrols/examples/examplegrid1.lfm
+++ b/components/rtticontrols/examples/examplegrid1.lfm
@ -0,0 +1,39 @@
+object Form1: TForm1
+  Caption = 'Form1'
+  ClientHeight = 300
+  ClientWidth = 400
+  OnCreate = Form1Create
+  OnDestroy = Form1Destroy
+  PixelsPerInch = 90
+  HorzScrollBar.Page = 401
+  VertScrollBar.Page = 301
+  Left = 290
+  Height = 300
+  Top = 163
+  Width = 400
+  object TIGrid1: TTIGrid
+    BorderStyle = bsSingle
+    Color = clWhite
+    DefaultRowHeight = 24
+    FixedColor = clBtnFace
+    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goSmoothScroll]
+    Left = 40
+    Height = 166
+    Top = 64
+    Width = 316
+    ColWidths = (
+      64
+      64
+      64
+      64
+      64
+    )
+    RowHeights = (
+      24
+      24
+      24
+      24
+      24
+    )
+  end
+end
--- a/components/rtticontrols/examples/examplegrid1.lrs
+++ b/components/rtticontrols/examples/examplegrid1.lrs
@ -0,0 +1,14 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TForm1','FORMDATA',[
+  'TPF0'#6'TForm1'#5'Form1'#7'Caption'#6#5'Form1'#12'ClientHeight'#3','#1#11'Cl'
+  +'ientWidth'#3#144#1#8'OnCreate'#7#11'Form1Create'#9'OnDestroy'#7#12'Form1Des'
+  +'troy'#13'PixelsPerInch'#2'Z'#18'HorzScrollBar.Page'#3#145#1#18'VertScrollBa'
+  +'r.Page'#3'-'#1#4'Left'#3'"'#1#6'Height'#3','#1#3'Top'#3#163#0#5'Width'#3#144
+  +#1#0#7'TTIGrid'#7'TIGrid1'#11'BorderStyle'#7#8'bsSingle'#5'Color'#7#7'clWhit'
+  +'e'#16'DefaultRowHeight'#2#24#10'FixedColor'#7#9'clBtnFace'#7'Options'#11#15
+  +'goFixedVertLine'#15'goFixedHorzLine'#10'goVertLine'#10'goHorzLine'#13'goRan'
+  +'geSelect'#14'goSmoothScroll'#0#4'Left'#2'('#6'Height'#3#166#0#3'Top'#2'@'#5
+  +'Width'#3'<'#1#9'ColWidths'#1#2'@'#2'@'#2'@'#2'@'#2'@'#0#10'RowHeights'#1#2
+  +#24#2#24#2#24#2#24#2#24#0#0#0#0
+]);
--- a/components/rtticontrols/examples/examplegrid1.pas
+++ b/components/rtticontrols/examples/examplegrid1.pas
@ -0,0 +1,78 @@
+unit ExampleGrid1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, RTTIGrids;
+
+type
+
+  { TMyCollectionItem }
+
+  TMyCollectionItem = class(TCollectionItem)
+  private
+    FInt: integer;
+    FStr: string;
+    FColor: TColor;
+  published
+    property Color: TColor read FColor write FColor;
+    property Str: string read FStr write FStr;
+    property Int: integer read FInt write FInt;
+  end;
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    TIGrid1: TTIGrid;
+    procedure Form1Create(Sender: TObject);
+    procedure Form1Destroy(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+    MyCollection: TCollection;
+  end;
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{ TForm1 }
+
+procedure TForm1.Form1Create(Sender: TObject);
+var
+  NewItem: TMyCollectionItem;
+begin
+  // create a collection with 2 items
+  MyCollection:=TCollection.Create(TMyCollectionItem);
+
+  NewItem:=TMyCollectionItem(MyCollection.Add);
+  NewItem.Color:=clRed;
+  NewItem.Str:='Some';
+  NewItem.Int:=123;
+
+  NewItem:=TMyCollectionItem(MyCollection.Add);
+  NewItem.Color:=clBlue;
+  NewItem.Str:='Text';
+  NewItem.Int:=789;
+
+  // show the collection
+  TIGrid1.ListObject:=MyCollection;
+end;
+
+procedure TForm1.Form1Destroy(Sender: TObject);
+begin
+  // disconnect collection from grid
+  TIGrid1.ListObject:=nil;
+  // free collection
+  MyCollection.Free;
+end;
+
+initialization
+  {$I examplegrid1.lrs}
+
+end.
+
--- a/components/rtticontrols/examples/exampleprojectgrid1.lpi
+++ b/components/rtticontrols/examples/exampleprojectgrid1.lpi
@ -0,0 +1,77 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="5"/>
+    <General>
+      <Flags>
+        <SaveClosedFiles Value="False"/>
+        <SaveOnlyProjectUnits Value="True"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <Title Value="exampleprojectgrid1"/>
+    </General>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="exampleprojectgrid1.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ExampleProjectGrid1"/>
+        <UsageCount Value="20"/>
+      </Unit0>
+      <Unit1>
+        <CursorPos X="15" Y="48"/>
+        <EditorIndex Value="0"/>
+        <Filename Value="examplegrid1.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <Loaded Value="True"/>
+        <ResourceFilename Value="examplegrid1.lrs"/>
+        <TopLine Value="29"/>
+        <UnitName Value="ExampleGrid1"/>
+        <UsageCount Value="20"/>
+      </Unit1>
+    </Units>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="RunTimeTypeInfoControls"/>
+        <MinVersion Minor="1" Valid="True"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="3"/>
+    <SearchPaths>
+      <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
--- a/components/rtticontrols/examples/exampleprojectgrid1.lpr
+++ b/components/rtticontrols/examples/exampleprojectgrid1.lpr
@ -0,0 +1,15 @@
+program ExampleProjectGrid1;
+
+{$mode objfpc}{$H+}
+
+uses
+  Interfaces, // this includes the LCL widgetset
+  Forms
+  { add your units here }, ExampleGrid1;
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+
--- a/components/rtticontrols/rttigrids.pas
+++ b/components/rtticontrols/rttigrids.pas
@ -134,8 +134,9 @@ type
    procedure SetListObject(const AValue: TObject);
    procedure SetTIOptions(const NewOptions: TTIGridOptions);
  protected
-    procedure ReloadTIList;
    procedure LoadCollection;
+    procedure LoadTList;
+    procedure RebuildGridLayout; virtual;
    procedure AddHeaderPropertyEditor(Prop: TPropertyEditor);
    procedure DrawCell(aCol, aRow: Integer; aRect: TRect;
                       aState: TGridDrawState); override;
@ -148,6 +149,7 @@ type
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
+    procedure ReloadTIList;
    procedure ClearProperties;
    procedure DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect;
                              aState: TGridDrawState); virtual;
@ -164,17 +166,16 @@ type
                      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 Filter: TTypeKinds read FFilter write SetFilter default AllTypeKinds;
-    property PropertyEditorHook: TPropertyEditorHook read FHeaderPropHook;
-    property TIObjectCount: integer read FTIObjectCount;
-    property PropertyCount: integer read GetPropertyCount;
-    property Properties[Index: integer]: TTIGridProperty read GetProperties;
+    property ListDirection: TTIListDirection read FListDirection
+                    write SetListDirection default tldObjectsAsRows;
+    property ListObject: TObject read FListObject write SetListObject;
    property OnHeaderClick: THdrEvent read FOnHeaderClick write FOnHeaderClick;
    property OnHeaderSized: THdrEvent read FOnHeaderSized write FOnHeaderSized;
+    property Properties[Index: integer]: TTIGridProperty read GetProperties;
+    property PropertyCount: integer read GetPropertyCount;
+    property TIObjectCount: integer read FTIObjectCount;
    property TIOptions: TTIGridOptions read FTIOptions write SetTIOptions;
  end;
  
@ -194,15 +195,19 @@ type
    property DefaultDrawing;
    property DefaultRowHeight;
    property Enabled;
+    property Filter;
    property FixedColor;
    property FixedCols;
    property FixedRows;
    property Flat;
    property Font;
+    property ListDirection;
    property OnDblClick;
    property OnEditButtonClick;
    property OnEnter;
    property OnExit;
+    property OnHeaderClick;
+    property OnHeaderSized;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
@ -217,6 +222,7 @@ type
    property ShowHint;
    property TabOrder;
    property TabStop;
+    property TIOptions;
    property TitleFont;
    property Visible;
  end;
@ -285,21 +291,37 @@ begin
  Exclude(FTIStates,tgsRebuildTIListNeeded);
  if FListObject is TCollection then begin
    LoadCollection;
+  end else if FListObject is TList then begin
+    LoadTList;
  end else begin
-    // ListObject is not valid -> Clear
-    Clear;
+    // ListObject is not valid
  end;
 end;

 procedure TTICustomGrid.LoadCollection;
 var
  TheCollection: TCollection;
-  CurItem: TCollectionItem;
-  HeaderLines: LongInt;
-  PropCount: LongInt;
 begin
  TheCollection:=FListObject as TCollection;
  FTIObjectCount:=TheCollection.Count;
+  RebuildGridLayout;
+end;
+
+procedure TTICustomGrid.LoadTList;
+var
+  TheList: TList;
+begin
+  TheList:=FListObject as TList;
+  FTIObjectCount:=TheList.Count;
+  RebuildGridLayout;
+end;
+
+procedure TTICustomGrid.RebuildGridLayout;
+var
+  CurItem: TPersistent;
+  HeaderLines: LongInt;
+  PropCount: LongInt;
+begin
  if ListDirection=tldObjectsAsRows then begin
    HeaderLines:=FixedRows;
    RowCount:=HeaderLines+FTIObjectCount
@ -309,7 +331,7 @@ begin
  end;
  // get first object to create the grid header
  if FTIObjectCount=0 then exit;
-  CurItem:=TheCollection.Items[0];
+  CurItem:=GetTIObject(0);
  if not (CurItem is TPersistent) then begin
    debugln('TTICustomGrid.LoadCollection First CollectionItem=',dbgsName(CurItem));
    exit;
@ -525,7 +547,7 @@ begin
    end
    else begin
      CurObject:=GetTIObject(ObjectIndex);
-      if CurObject<>nil then begin
+      if (CurObject<>nil) then begin
        ok:=false;
        Hook:=nil;
        try
@ -578,11 +600,35 @@ begin
 end;

 function TTICustomGrid.GetTIObject(Index: integer): TPersistent;
+var
+  List: TList;
+  AnObject: TObject;
+  ACollection: TCollection;
 begin
  Result:=nil;
  if (Index<0) or (Index>=TIObjectCount) then exit;
  if ListObject is TCollection then begin
-    Result:=TCollection(ListObject).Items[Index];
+    ACollection:=TCollection(ListObject);
+    if csDesigning in ComponentState then begin
+      try
+        Result:=ACollection.Items[Index];
+      except
+      end;
+    end else begin
+      Result:=ACollection.Items[Index];
+    end;
+  end else if ListObject is TList then begin
+    List:=TList(ListObject);
+    if csDesigning in ComponentState then begin
+      try
+        AnObject:=TObject(List[Index]);
+        Result:=AnObject as TPersistent;
+      except
+      end;
+    end else begin
+      AnObject:=TObject(List[Index]);
+      Result:=AnObject as TPersistent;
+    end;
  end;
 end;