home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk15 / dbtools.pak / DBBROWSE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  9.8 KB  |  328 lines
  1. {
  2.   See the README.TXT for instructions on installing the demo db components
  3.   from the BDETable into COMPLIB.DCL.  These components are required for
  4.   properly viewing or building the demo applications in this directory.
  5. }
  6.  
  7. unit Dbbrowse;
  8.  
  9. interface
  10.  
  11. uses WinTypes, WinProcs, Classes, Graphics, Forms, DbForm, Controls, DB,
  12.   Grids, Outline, BDETable, DBGrids, DBTables;
  13.  
  14. type
  15.   TDbBrowseForm = class(TDbForm)
  16.     DbOutline: TOutline;
  17.     DbTables: TTableList;
  18.     TableFields: TFieldList;
  19.     TableIndices: TIndexList;
  20.     DbTablesNAME: TStringField;
  21.     DbTablesDATE: TDateField;
  22.     DbTablesTIME: TTimeField;
  23.     DbTablesVIEW: TBooleanField;
  24.     DbTablesEXTENSION: TStringField;
  25.     TableFieldsNAME: TStringField;
  26.     TableFieldsTYPE: TWordField;
  27.     TableFieldsSUBTYPE: TWordField;
  28.     TableFieldsUNITS1: TWordField;
  29.     TableFieldsUNITS2: TWordField;
  30.     TableFieldsLENGTH: TWordField;
  31.     TableIndicesNAME: TStringField;
  32.     TableIndicesUNIQUE: TBooleanField;
  33.     procedure FormActivate(Sender: TObject);
  34.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  35.     procedure DbOutlineExpand(Sender: TObject; Index: Longint);
  36.   public
  37.     constructor Create (AOwner: TComponent; const Name: string);
  38.     destructor Destroy; override; { Not normal, but symmetric with Create }
  39.     procedure CreateTableView;
  40.   end;
  41.  
  42. implementation
  43.  
  44. {$R *.DFM}
  45.  
  46. uses SysUtils, DbMain, Dbtable, DbSQL, DbiTypes;
  47.  
  48. type
  49.  
  50. { Browse node classes }
  51.  
  52.    TDbBrowseNode = class
  53.    private
  54.       FForm: TDbBrowseForm;
  55.       FBrowseName: TFileName;
  56.       FExpandedOnce: Boolean;
  57.    protected
  58.       property ExpandedOnce: Boolean read FExpandedOnce;
  59.    public
  60.       constructor Create (AForm: TDbBrowseForm; ParentIdx: Longint;
  61.                           const BrowseName: TFileName;
  62.                           const Description: string);
  63.       procedure Expand (ParentIdx: Longint); virtual;
  64.       property Form: TDbBrowseForm read FForm;
  65.       property BrowseName: TFileName read FBrowseName;
  66.    end;
  67.  
  68.    TDbBrowseDatabaseNode = class (TDbBrowseNode)
  69.       procedure Expand (ParentIdx: Longint); override;
  70.    end;
  71.  
  72.    TDbBrowseTableNode = class (TDbBrowseNode)
  73.       procedure Expand (ParentIdx: Longint); override;
  74.    end;
  75.  
  76.    TDbBrowseFieldNode = class (TDbBrowseNode);
  77.    TDbBrowseIndexNode = class (TDbBrowseNode);
  78.  
  79. { Create a browse node and add it to DbOutline }
  80.  
  81. constructor TDbBrowseNode.Create (AForm: TDbBrowseForm; ParentIdx: Longint;
  82.                                  const BrowseName: TFileName;
  83.                                  const Description: string);
  84. begin
  85.   FForm := AForm;
  86.   FBrowseName := BrowseName;
  87.   FExpandedOnce := False;
  88.   Form.DbOutline.AddChildObject (ParentIdx, Description, Self)
  89. end;
  90.  
  91. { Expand nothing - for nodes that have nothing to expand }
  92.  
  93. procedure TDbBrowseNode.Expand (ParentIdx: Longint);
  94. begin
  95.   FExpandedOnce := True;
  96. end;
  97.  
  98. { Get database description for initial browse node }
  99.  
  100. function GetDbDesc (const Name: TFileName): string;
  101. var
  102.   Desc: TDatabaseDesc;
  103. begin
  104.   Desc := TDatabaseDesc.Create (Name);
  105.   try
  106.     Result := Format ('%-16s  Type: %s',
  107.                       [Desc.Description.szName, Desc.Description.szDbType])
  108.   finally
  109.     Desc.Free
  110.   end
  111. end;
  112.  
  113. function GetFieldType (Form: TDbBrowseForm): string;
  114. const
  115.    Types: array [fldUNKNOWN..fldLOCKINFO] of string [8] =
  116.           ('Unknown', 'String', 'Date', 'Blob', 'Boolean', 'Int16',
  117.            'Int32', 'Float64', 'Decimal', 'Bytes', 'Time', 'DateTime',
  118.            'UInt16', 'UInt32', 'Float80', 'VarBytes', 'LockInfo');
  119.  
  120.    Subtypes: array [fldstMONEY..fldstTYPEDBINARY] of string [14] =
  121.              ('Money', 'Memo', 'Binary', 'Formatted Memo', 'OLE',
  122.               'Graphic', 'dBase OLE', 'User Typed');
  123. var
  124.    FType, FSubtype, FUnits1, FUnits2, FLen: Word;
  125. begin
  126.    with Form do
  127.    begin
  128.       FType := TableFieldsTYPE.Value;
  129.       if FType < Low (Types)  then FType := Low (Types) else
  130.       if FType > High (Types) then FType := Low (Types);
  131.  
  132.       FSubtype := TableFieldsSUBTYPE.Value;
  133.       if FSubtype < Low (Subtypes)  then FSubtype := 0 else
  134.       if FSubtype > High (Subtypes) then FSubtype := 0;
  135.  
  136.       FUnits1 := TableFieldsUNITS1.Value;
  137.       FUnits2 := TableFieldsUNITS2.Value;
  138.       FLen    := TableFieldsLENGTH.Value;
  139.  
  140.       case FType of
  141.          fldDATE,
  142.          fldTIME,
  143.          fldTIMESTAMP,
  144.          fldBOOL,
  145.          fldINT16,
  146.          fldINT32,
  147.          fldUINT16,
  148.          fldUINT32,
  149.          fldLOCKINFO:
  150.             Result := Types [FType];
  151.  
  152.          fldZSTRING,
  153.          fldBYTES,
  154.          fldVARBYTES:
  155.             Result := Format ('%s(%d)', [Types [FType], FUnits1]);
  156.  
  157.          fldFLOATIEEE,
  158.          fldFLOAT,
  159.          fldBCD,
  160.          fldBLOB:
  161.             begin
  162.                Result := Types [FType];
  163.                if FSubtype > 0 then
  164.                   Result := Format ('%s:%s', [Result, Subtypes [FSubtype]]);
  165.                if (FUnits1 > 1) or (FUnits2 > 0) then
  166.                   Result := Format ('%s(%d,%d)', [Result, FUnits1, FUnits2])
  167.             end;
  168.       else
  169.          Result := Format ('%s(%d)', [Types [FType], FLen]);
  170.       end
  171.    end
  172. end;
  173.  
  174. { Expand the tables in a database node }
  175.  
  176. procedure TDbBrowseDatabaseNode.Expand (ParentIdx: Longint);
  177. var
  178.    TableExt: string;
  179.    Description: string;
  180. begin
  181.    if not ExpandedOnce then
  182.       with Form do
  183.       begin
  184.          DbOutline.BeginUpdate;
  185.          try
  186.             DbTables.DatabaseName := Form.Database.DatabaseName;
  187.             DbTables.Active := True;
  188.             
  189.             while not DbTables.EOF do
  190.             begin
  191.                Description := Format ('%-24s %3s %4s %12s %8s',
  192.                                       [DbTablesNAME.Value,
  193.                                        DbTablesEXTENSION.Value,
  194.                                        DbTablesVIEW.AsString,
  195.                                        DbTablesDATE.DisplayText,
  196.                                        DbTablesTIME.DisplayText]);
  197.                if DbTablesEXTENSION.AsString = '' then
  198.                  TableExt := DbTablesNAME.Value
  199.                else
  200.                  TableExt := Format ('%s.%s', [DbTablesNAME.Value,
  201.                                      DbTablesEXTENSION.Value]);
  202.                TDbBrowseTableNode.Create (Form, ParentIdx, TableExt, Description);
  203.                DbTables.Next
  204.             end;
  205.             
  206.             DbTables.Active := False;
  207.          finally
  208.             DbOutline.EndUpdate;
  209.          end;
  210.       end;
  211.  
  212.    inherited Expand (ParentIdx);
  213. end;
  214.  
  215. { Expand the fields and indicies in a table node }
  216.  
  217. procedure TDbBrowseTableNode.Expand (ParentIdx: Longint);
  218. var
  219.    Description: string;
  220. begin
  221.    if not ExpandedOnce then
  222.       with Form do
  223.       begin
  224.          DbOutline.BeginUpdate;
  225.          try
  226.             TableIndices.DatabaseName := Database.DatabaseName;
  227.             TableIndices.TableName := BrowseName;
  228.             TableIndices.Active := True;
  229.             
  230.             while not TableIndices.EOF do
  231.             begin
  232.               if TableIndicesUNIQUE.Value then Description := 'Unique'
  233.               else                             Description := '';
  234.               Description := Format ('%s Index %s',
  235.                                      [Description, TableIndicesNAME.AsString]);
  236.               TDbBrowseIndexNode.Create (Form, ParentIdx, TableIndicesNAME.AsString,
  237.                                          Description);
  238.               TableIndices.Next
  239.             end;
  240.             
  241.             TableIndices.Active := False;
  242.             
  243.             TableFields.DatabaseName := Database.DatabaseName;
  244.             TableFields.TableName := BrowseName;
  245.             TableFields.Active := True;
  246.             
  247.             while not TableFields.EOF do
  248.             begin
  249.                Description := Format ('Field %-16s %s',
  250.                               [TableFieldsNAME.AsString, GetFieldType (Form)]);
  251.                TDbBrowseFieldNode.Create (Form, ParentIdx, TableFieldsNAME.AsString,
  252.                                           Description);
  253.                TableFields.Next
  254.             end;
  255.             
  256.             TableFields.Active := False;
  257.          finally
  258.             DbOutline.EndUpdate;
  259.          end;
  260.       end;
  261.  
  262.    inherited Expand (ParentIdx);
  263. end;
  264.  
  265. { Expand an outline node }
  266.  
  267. procedure TDbBrowseForm.DbOutlineExpand(Sender: TObject; Index: Longint);
  268. begin
  269.    TDbBrowseNode (DbOutline [Index].Data).Expand (Index)
  270. end;
  271.  
  272. { Create a new table viewer }
  273.  
  274. procedure TDbBrowseForm.CreateTableView;
  275. var
  276.   BNode: TDbBrowseNode;
  277. begin
  278.   with DbOutline do
  279.     if SelectedItem <> 0 then
  280.     begin
  281.       BNode := TDbBrowseNode (DbOutline [SelectedItem].Data);
  282.  
  283.       if BNode is TDbBrowseTableNode then
  284.          TTableViewForm.Create (Application, Database, BNode.BrowseName)
  285.       else
  286.          raise Exception.CreateFmt ('%s is not a table', [BNode.BrowseName]);
  287.     end
  288.     else raise Exception.Create ('First select a table');
  289. end;
  290.  
  291. { Browse an open database }
  292.  
  293. constructor TDbBrowseForm.Create (AOwner: TComponent; const Name: string);
  294. begin
  295.   inherited Create (AOwner);
  296.   Database := Session.OpenDatabase (Name);
  297.   Caption := 'Browse - Database ' + Database.DatabaseName;
  298.   TDbBrowseDatabaseNode.Create (Self, 0, Database.DatabaseName,
  299.                                 GetDbDesc (Database.DatabaseName));
  300.   Show
  301. end;
  302.  
  303. destructor TDbBrowseForm.Destroy;
  304. var
  305.    Ix: Longint;
  306. begin
  307.    with DbOutline do
  308.    begin
  309.      BeginUpdate;
  310.      for Ix := ItemCount downto 1 do TDbBrowseNode (DbOutline [Ix].Data).Free;
  311.      EndUpdate;
  312.    end;
  313.  
  314.    inherited Destroy;
  315. end;
  316.  
  317. procedure TDbBrowseForm.FormActivate(Sender: TObject);
  318. begin
  319.   DbMainForm.SetActiveForm (nil, nil);
  320. end;
  321.  
  322. procedure TDbBrowseForm.FormClose(Sender: TObject; var Action: TCloseAction);
  323. begin
  324.   DbMainForm.FormCloseActive (Sender, Action);
  325. end;
  326.  
  327. end.
  328.