home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / QDB / GLIMPSE.ZIP / g_main.pas < prev    next >
Pascal/Delphi Source File  |  1998-06-30  |  4KB  |  150 lines
  1. unit G_main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   QDB, QDBView, Menus, StdCtrls, Grids;
  8.  
  9. type
  10.   TG_form = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     File1: TMenuItem;
  13.     Open1: TMenuItem;
  14.     Close1: TMenuItem;
  15.     N1: TMenuItem;
  16.     Exit1: TMenuItem;
  17.     OpenDialog: TOpenDialog;
  18.     QI: TQDBItem;
  19.     Grid: TStringGrid;
  20.     procedure Open1Click(Sender: TObject);
  21.     procedure Close1Click(Sender: TObject);
  22.     procedure Exit1Click(Sender: TObject);
  23.     procedure QIWarnNoData(Sender: TObject);
  24.   private
  25.     { Private declarations }
  26.   public
  27.     { Public declarations }
  28.     procedure DisplayRow(r: integer);
  29.   end;
  30.  
  31. var
  32.   G_form: TG_form;
  33.  
  34. implementation
  35.  
  36. uses
  37.   TypInfo;
  38.  
  39. {$R *.DFM}
  40.  
  41. const
  42.   colofs = 2;   // first two columns are reserved
  43.   rowofs = 2;   // first two rows are reserved
  44.  
  45. procedure TG_form.DisplayRow(r: integer);
  46. var
  47.   n: integer;
  48. begin
  49.   // row number in first cell
  50.   Grid.Cells[0,r]:=IntToStr(r-rowofs);
  51.   // key in the next
  52.   Grid.Cells[1,r]:=QI.Key;
  53.   // and then the field values as strings
  54.   for n:=0 to Grid.ColCount-1-colofs do
  55.     Grid.Cells[n+colofs,r]:=QI.AsString[n];
  56. end;
  57.  
  58. procedure TG_form.Open1Click(Sender: TObject);
  59. var
  60.   n: integer;
  61.   r: integer;
  62. begin
  63.   with OpenDialog do
  64.   begin
  65.     if Execute then
  66.     begin
  67.       try
  68.         // if it isn't a QDB file we have an exception to handle
  69.         QI.FileName:=FileName;
  70.         // load the field info
  71.         QI.FetchStructure;
  72.         // a column for every field plus two extra
  73.         Grid.ColCount:=QI.FieldCount+colofs;
  74.         // a row for every item plus two extra
  75.         if QI.Count > 0 then
  76.           Grid.RowCount:=rowofs+QI.Count
  77.         else
  78.         begin
  79.           // except for an empty file ...
  80.           // we need to show an extra empty row
  81.           Grid.RowCount:=rowofs+1;
  82.           for n:=0 to Grid.ColCount-1 do
  83.             Grid.Cells[n,rowofs]:='';
  84.         end;
  85.         // left column is fixed
  86.         Grid.FixedCols:=1;
  87.         // top two rows are fixed
  88.         Grid.FixedRows:=2;
  89.         // fill in the first two column headings
  90.         Grid.Cells[0,0]:='Field Name';
  91.         Grid.Cells[0,1]:='Field Type';
  92.         Grid.Cells[1,0]:='Key';
  93.         Grid.Cells[1,1]:='';
  94.         // then add the rest
  95.         for n:=0 to Grid.ColCount-colofs do
  96.         begin
  97.           // the field name on top
  98.           Grid.Cells[n+colofs,0]:=QI.FieldNames[n];
  99.           // and the kind of field beneath
  100.           Grid.Cells[n+colofs,1]:=GetEnumName(TypeInfo(TQDBFieldType),ord(QI.FieldTypes[n]));
  101.         end;
  102.         // then if the file isn't empty
  103.         if QI.Count > 0 then
  104.         begin
  105.           r:=rowofs;
  106.           // go to the start of the file ...
  107.           // and display each item as a separate row
  108.           QI.FirstItem;
  109.           repeat
  110.             DisplayRow(r);
  111.             inc(r);
  112.             QI.NextItem;
  113.           until QI.EoF;
  114.           // we hit end of file before we have displayed
  115.           // the last item so we do it now
  116.           DisplayRow(r);
  117.         end;
  118.       except
  119.         // handle the exception if the file isn't QDB
  120.         on EQDBFileError do
  121.         begin
  122.           ShowMessage(Filename + ' is not a valid QDB file');
  123.           QI.Filename:='';
  124.         end;
  125.         else
  126.           raise;
  127.       end;
  128.     end;
  129.   end;
  130. end;
  131.  
  132. procedure TG_form.Close1Click(Sender: TObject);
  133. begin
  134.   QI.Filename:='';
  135. end;
  136.  
  137. procedure TG_form.Exit1Click(Sender: TObject);
  138. begin
  139.   QI.FileName:=''                    ;;
  140.   Close;
  141. end;
  142.  
  143. procedure TG_form.QIWarnNoData(Sender: TObject);
  144. begin
  145.   // a dummy handler to stop the exception when we
  146.   // operate on an empty file
  147. end;
  148.  
  149. end.
  150.