home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap08 / howto03 / delphi10 / creatabs / tabcreat.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-04-14  |  16.1 KB  |  672 lines
  1. unit TABCREAT;
  2.  
  3. interface
  4.  
  5. uses
  6. {$IFDEF WIN32}
  7.   Bde, Windows,
  8. {$ELSE}
  9.   DbiProcs, DbiTypes, DbiErrs, WinTypes, WinProcs,
  10. {$ENDIF}
  11.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  12.   DBTables, DB, Grids, DBGrids, StdCtrls, DBCtrls, Mask, Buttons,
  13.   ExtCtrls;
  14.  
  15. type
  16.   TCreateTableForm = class(TForm)
  17.     TargetDatabase: TDatabase;
  18.     StructureDataSource: TDataSource;
  19.     StructureDBGrid: TDBGrid;
  20.     StructureTable: TTable;
  21.     CreateQuery: TQuery;
  22.     FieldNameDBEdit: TDBEdit;
  23.     TypeDBComboBox: TDBComboBox;
  24.     KeyDBCheckBox: TDBCheckBox;
  25.     SizeDBEdit: TDBEdit;
  26.     DecDBEdit: TDBEdit;
  27.     TableNameLabel: TLabel;
  28.     FieldNameLabel: TLabel;
  29.     TypeLabel: TLabel;
  30.     SizeLabel: TLabel;
  31.     TableNameEdit: TEdit;
  32.     DecLabel: TLabel;
  33.     SqlStatmentMemo: TMemo;
  34.     OkBitBtn: TBitBtn;
  35.     CancelBitBtn: TBitBtn;
  36.     StructureDBNavigator: TDBNavigator;
  37.     OrderLabel: TLabel;
  38.     OrderDBEdit: TDBEdit;
  39.     AddFieldButton: TButton;
  40.     DeleteFieldButton: TButton;
  41.     CancelFieldButton: TButton;
  42.     SaveFieldButton: TButton;
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure FormDestroy(Sender: TObject);
  45.     procedure OkBitBtnClick(Sender: TObject);
  46.     procedure StructureTableBeforePost(DataSet: TDataSet);
  47.     procedure CancelBitBtnClick(Sender: TObject);
  48.     procedure StructureTableAfterPost(DataSet: TDataSet);
  49.     procedure TableNameEditExit(Sender: TObject);
  50.     procedure TableNameEditKeyPress(Sender: TObject;
  51.       var Key: Char);
  52.     procedure FieldNameDBEditKeyPress(Sender: TObject;
  53.       var Key: Char);
  54.     procedure TypeDBComboBoxChange(Sender: TObject);
  55.     procedure StructureDataSourceDataChange(Sender: TObject;
  56.       Field: TField);
  57.     procedure StructureTableAfterDelete(DataSet: TDataSet);
  58.     procedure StructureTableAfterInsert(DataSet: TDataSet);
  59.     procedure AddFieldButtonClick(Sender: TObject);
  60.     procedure StructureTableNewRecord(DataSet: TDataset);
  61.     procedure DeleteFieldButtonClick(Sender: TObject);
  62.     procedure CancelFieldButtonClick(Sender: TObject);
  63.     procedure SaveFieldButtonClick(Sender: TObject);
  64.   private
  65.     { Private declarations }
  66.     procedure BuildSqlStatement;
  67.     procedure SetUiState;
  68.   public
  69.     { Public declarations }
  70.     procedure ExceptionHandler(Sender: TObject; E: Exception);
  71.   end;
  72.  
  73. var
  74.   CreateTableForm: TCreateTableForm;
  75.  
  76. implementation
  77.  
  78. {$R *.DFM}
  79.  
  80. const
  81.   {
  82.     Constants naming the data types available for creating tables
  83.     on an Interbase server.
  84.   }
  85.   ibBlob     = 'BLOB';
  86.   ibChar     = 'CHAR';
  87.   ibDate     = 'DATE';
  88.   ibDecimal  = 'DECIMAL';
  89.   ibDouble   = 'DOUBLE PRECISION';
  90.   ibFloat    = 'FLOAT';
  91.   ibInteger  = 'INTEGER';
  92.   ibNumeric  = 'NUMERIC';
  93.   ibSmallint = 'SMALLINT';
  94.   ibVarchar  = 'VARCHAR';
  95.  
  96.   { Constant naming the Structure table's file name. }
  97.   tbStructure = '___STRCT.DB';
  98.  
  99.   {
  100.     Constants naming the fields in the temporary Structure table.
  101.   }
  102.   stFieldName = 'Field Name';
  103.   stType      = 'Type';
  104.   stSize      = 'Size';
  105.   stDec       = 'Dec';
  106.   stKey       = 'Key';
  107.   stOrder     = 'Order';
  108.  
  109.   {
  110.     Constants naming indexes in the temporary Structure table.
  111.   }
  112.   inUniqueName = 'UniqueName';
  113.   inFieldOrder = 'FieldOrder';
  114.  
  115.  
  116. { Application wide custom excelption handler. }
  117. procedure TCreateTableForm.ExceptionHandler(Sender: TObject;
  118.   E: Exception);
  119. begin
  120.   {
  121.     The purpose of this exception handler is to catch key
  122.     violations in the StructureTable. Key violations are
  123.     raised as EDBEngineErrors.
  124.   }
  125.   if E is EDBEngineError then
  126.   begin
  127.  
  128.     with EDBEngineError(E).Errors[Pred(EDBEngineError(E).ErrorCount )] do
  129.     begin
  130.  
  131.       { Is it a Key violation error? }
  132.       if (ErrorCode = DBIERR_KEYVIOL) then
  133.       begin
  134.  
  135.         if Message = 'Key violation.' then
  136.         begin
  137.           E.Message :=
  138.             'The field name ''' +
  139.             StructureTable.FieldByName( stFieldName ).AsString +
  140.             ''' is already used';
  141.         end
  142.  
  143.         { This branch is applicable only for a Paradox 7.0 table }
  144.         else
  145.         begin
  146.           E.Message :=
  147.             'Ther order number '''+
  148.             StructureTable.FieldByName( stOrder ).AsString +
  149.             ''' is already used ';
  150.         end;
  151.       end;
  152.     end;
  153.   end;
  154.  
  155.   { Let the user know what's wrong. }
  156.   MessageBeep( $FFFF );
  157.   Application.ShowException( E );
  158.  
  159. end;
  160.  
  161.  
  162. procedure TCreateTableForm.FormCreate(Sender: TObject);
  163. begin
  164.  
  165.   try
  166.     TargetDatabase.Open;
  167.   except
  168.     on EDatabaseError do
  169.     begin
  170.       { Could not open database; probably bad login. }
  171.       Application.Terminate;
  172.     end;
  173.   end;
  174.  
  175.  
  176.   try
  177.  
  178.     {
  179.       Create the structure table on disk. Notice the usage of
  180.       the Private directory of the current session to give
  181.       the temporary structure table a place where to live.
  182.     }
  183.  
  184.     with StructureTable do
  185.     begin
  186.  
  187.       DatabaseName := Session.PrivateDir;
  188.       TableName    := tbStructure;
  189.       TableType    := ttParadox;
  190.  
  191.       {
  192.         Define the... structure of the temporary structure table.
  193.       }
  194.       with FieldDefs do
  195.       begin
  196.         Clear;
  197.         Add( stFieldName,   ftString,   31,  true  );
  198.         Add( stType,        ftString,   18,  true  );
  199.         Add( stSize,        ftSmallint,  0,  false );
  200.         Add( stDec,         ftSmallint,  0,  false );
  201.         Add( stKey,         ftBoolean,   0,  false );
  202.         Add( stOrder,       ftSmallint,  0,  true  );
  203.       end;
  204.  
  205.       {
  206.         Define its indexes.
  207.       }
  208.       with IndexDefs do
  209.       begin
  210.         Add( inUniqueName, stFieldName, [ixPrimary, ixUnique] );
  211.  
  212. {$IFDEF WIN32}
  213.         { Paradox 7.0 format supports unique secondary indexes. }
  214.         Add( inFieldOrder, stOrder,      [ixUnique]            );
  215. {$ELSE}
  216.         { Paradox 5.0 does not. The index options must be given
  217.           nonetheless. }
  218.         Add( inFieldOrder, stOrder,      [ixCaseInsensitive]   );
  219. {$ENDIF}
  220.       end;
  221.  
  222.       CreateTable;
  223.  
  224.       { Display the table according to ascending values of the
  225.         Order field. }
  226.       IndexName := inFieldOrder;
  227.  
  228.     end;
  229.  
  230.     StructureTable.Open;
  231.  
  232.   except
  233.     on EDatabaseError do
  234.     begin
  235.       { Couldn't create the Structure table. }
  236.       Application.Terminate;
  237.     end;
  238.   end;
  239.  
  240.   { Initialize the combo box. }
  241.   with TypeDBComboBox.Items do
  242.   begin
  243.     { Add supported Interbase field types to the combo box list}
  244.     Add( ibBlob );
  245.     Add( ibChar );
  246.     Add( ibDate );
  247.     Add( ibDecimal );
  248.     Add( ibDouble );
  249.     Add( ibFloat );
  250.     Add( ibInteger );
  251.     Add( ibNumeric );
  252.     Add( ibSmallint );
  253.     Add( ibVarchar );
  254.   end;
  255.  
  256.  
  257.   {
  258.     Make sure all data aware controls get to the right data fields.
  259.   }
  260.   FieldNameDBEdit.DataField := stFieldName;
  261.   TypeDBComboBox.DataField  := stType;
  262.   SizeDBEdit.DataField      := stSize;
  263.   DecDBEdit.DataField       := stDec;
  264.   KeyDBCheckBox.DataField   := stKey;
  265.   OrderDBEdit.DataField     := stOrder;
  266.  
  267.   {
  268.     Set up the application wide exception handler.
  269.   }
  270.   Application.OnException := ExceptionHandler;
  271.  
  272. end;
  273.  
  274. procedure TCreateTableForm.FormDestroy(Sender: TObject);
  275. begin
  276.  
  277.   StructureTable.Close;
  278.   {
  279.     The structure table is temporary. Delete it.
  280.   }
  281.   StructureTable.DeleteTable;
  282.  
  283.   TargetDatabase.Close;
  284.  
  285. end;
  286.  
  287. procedure TCreateTableForm.OkBitBtnClick(Sender: TObject);
  288. begin
  289.  
  290.   if TableNameEdit.Text = '' then
  291.   begin
  292.     raise EDataBaseError.Create( 'Missing Table Name' );
  293.   end;
  294.  
  295.   if StructureTable.State in [dsInsert, dsEdit] then
  296.   begin
  297.     StructureTable.Post;
  298.   end;
  299.  
  300.   {
  301.     Make sure the sql statement is up to date even if previous
  302.     error conditions occurred on the name field,
  303.   }
  304.   BuildSqlStatement;
  305.  
  306.   {
  307.     Move the sql statment to the Query object, and execute it.
  308.     Note that if execution fails, it will raise an exception
  309.     that will be caught (and displayed) by the application wide
  310.     exception handler.
  311.   }
  312.   With CreateQuery do
  313.   begin
  314.     Close;
  315.     Sql.Clear;
  316.     Sql.AddStrings( SqlStatmentMemo.Lines );
  317.     ExecSql;
  318.   end;
  319.  
  320.   MessageBeep( $FFFF );
  321.   ShowMessage( 'Table created successfully.' );
  322.  
  323. end;
  324.  
  325. procedure TCreateTableForm.CancelBitBtnClick(Sender: TObject);
  326. begin
  327.  
  328.   Close;
  329.  
  330. end;
  331.  
  332. procedure TCreateTableForm.StructureTableBeforePost(
  333.   DataSet: TDataSet);
  334. var
  335.   CurrentType: String;
  336. begin
  337.  
  338.   {
  339.     Note that Field Name, Type and Order are required by the
  340.     structure of the Structure table. Other fields might need
  341.     information, depending on what type the user has selected.
  342.   }
  343.  
  344.   CurrentType := TypeDBComboBox.Items[ TypeDBComboBox.ItemIndex ];
  345.  
  346.   if (CurrentType = ibChar) or
  347.      (CurrentType = ibVarchar) or
  348.      (CurrentType = ibDecimal) or
  349.      (CurrentType = ibNumeric) then
  350.   begin
  351.     if StructureTable.FieldByName( stSize ).isNull then
  352.     begin
  353.       raise EDataBaseError.Create( 'Missing Size' );
  354.     end;
  355.   end;
  356.  
  357.   if (CurrentType = ibDecimal) or
  358.      (CurrentType = ibNumeric) then
  359.   begin
  360.     if StructureTable.FieldByName( stDec ).isNull then
  361.     begin
  362.       raise EDataBaseError.Create( 'Missing Decimals' );
  363.     end;
  364.   end;
  365.  
  366. end;
  367.  
  368. procedure TCreateTableForm.StructureTableAfterPost(
  369.   DataSet: TDataSet);
  370. begin
  371.  
  372.   BuildSqlStatement;
  373.  
  374. end;
  375.  
  376. procedure TCreateTableForm.StructureTableAfterDelete(
  377.   DataSet: TDataSet);
  378. begin
  379.  
  380.   BuildSqlStatement;
  381.  
  382. end;
  383.  
  384. procedure TCreateTableForm.StructureTableAfterInsert(
  385.   DataSet: TDataSet);
  386. begin
  387.  
  388.   With StructureTable do
  389.   begin
  390.     FieldByName( stOrder ).AsInteger := Succ( RecordCount );
  391.     FieldByName( stKey   ).AsBoolean := False;
  392.   end;
  393.  
  394. end;
  395.  
  396. procedure TCreateTableForm.StructureTableNewRecord(
  397.   DataSet: TDataset);
  398. begin
  399.  
  400.   SetUiState;
  401.  
  402. end;
  403.  
  404. procedure TCreateTableForm.BuildSqlStatement;
  405. var
  406.   CurrentRecord:    TBookmark;
  407.   FieldLine:        String;
  408.   PrimaryKeyFields: String;
  409.   NeedComma:        Boolean;
  410. begin
  411.   {
  412.     The SQL statment that will be used to create the table on
  413.     the Interbase server will be built and stored in the
  414.     SqlStatmentMemo component. In this way, the user can actually
  415.     see what will be sent to the server.
  416.   }
  417.   with SqlStatmentMemo.Lines do
  418.   begin
  419.  
  420.     Clear;
  421.     Add( 'CREATE TABLE ' + TableNameEdit.Text + ' (' );
  422.  
  423.     {
  424.       The building process is straightforward: scan through the
  425.       Structure Table and add lines to the SQL statment as you
  426.       go, taking into account all relevant SQL syntax rules.
  427.     }
  428.     with StructureTable do
  429.     begin
  430.       DisableControls;
  431.  
  432.       {
  433.         Since the scanning process will move the table pointer to
  434.         the bottom, use a bookmark so that you can get back to
  435.         the current record at the end of the loop.
  436.       }
  437.       CurrentRecord := GetBookmark;
  438.  
  439.       {
  440.         Initialize all loop entry conditions.
  441.       }
  442.       PrimaryKeyFields := '';
  443.       NeedComma := False;
  444.       First;
  445.  
  446.       { Scan through the structure table. }
  447.  
  448.       while not Eof do
  449.       begin
  450.  
  451.         { If needed, add a comma to the end of the last line. }
  452.         if NeedComma then
  453.         begin
  454.           Strings[Pred(Count)] := Strings[Pred(Count)] + ',';
  455.         end;
  456.  
  457.         { Start building the new line, add the field name. }
  458.         FieldLine := '  ' + FieldByName( stFieldName ).AsString +
  459.                      '  ' + FieldByName( stType).AsString;
  460.  
  461.         { Add the field size if present. }
  462.         if not FieldByName( stSize).IsNull then
  463.         begin
  464.           FieldLine := FieldLine + '( ' +
  465.                        FieldByName( stSize ).AsString;
  466.  
  467.           { Add the field precision if present. }
  468.           if not FieldByName( stDec).IsNull then
  469.           begin
  470.             FieldLine := FieldLine + ', ' +
  471.                          FieldByName( stDec ).AsString;
  472.           end;
  473.           FieldLine := FieldLine + ' )';
  474.         end;
  475.  
  476.         { Check out for key fields. }
  477.         if FieldByName( stKey ).AsBoolean then
  478.         begin
  479.  
  480.           { Add the NOT NULL constraint. }
  481.           FieldLine := FieldLine + ' NOT NULL';
  482.  
  483.           { Expand the primary key clause. }
  484.           if PrimaryKeyFields <> '' then
  485.           begin
  486.             PrimaryKeyFields := PrimaryKeyFields + ', ';
  487.           end;
  488.           PrimaryKeyFields := PrimaryKeyFields +
  489.                               FieldByName( stFieldName ).AsString;
  490.         end;
  491.  
  492.         { Add the newly constructed line. }
  493.         Add( FieldLine );
  494.         NeedComma := True;
  495.         Next;
  496.       end;
  497.  
  498.       GotoBookmark( CurrentRecord );
  499.       EnableControls;
  500.       FreeBookmark( CurrentRecord );
  501.  
  502.       { If there is a primary key, add its clause. }
  503.       if PrimaryKeyFields <> '' then
  504.       begin
  505.         Strings[Pred(Count)] := Strings[Pred(Count)] + ',';
  506.         Add( '  PRIMARY KEY (' + PrimaryKeyFields + ')' );
  507.       end;
  508.     end;
  509.     Add( ');' );
  510.   end;
  511. end;
  512.  
  513. procedure TCreateTableForm.SetUiState;
  514. var
  515.   CurrentType: String;
  516. begin;
  517.  
  518.   CurrentType :=  TypeDBComboBox.Items[ TypeDBComboBox.ItemIndex ];
  519.  
  520.   {
  521.     Allow the user to create a table only if there exists at least
  522.     one field.
  523.   }
  524.   OkBitBtn.Enabled := Not (
  525.     StructureTable.BOF and StructureTable.EOF
  526.   );
  527.  
  528.   {
  529.     If the user is editing SetUiState will be called only from
  530.     the TypeDBComboBox's OnChange event handler, so initialize
  531.     fields according to the field type selected by the user.
  532.   }
  533.   if StructureTable.State in [dsInsert, dsEdit] then
  534.   begin
  535.     StructureTable.FieldByName( stSize ).Clear;
  536.     StructureTable.FieldByName( stDec  ).Clear;
  537.     StructureTable.FieldByName( stKey  ).AsBoolean := False;
  538.   end;
  539.  
  540.   {
  541.     Set visibile and enabled properties as required.
  542.   }
  543.   if (CurrentType = ibChar) or (CurrentType = ibVarchar) then
  544.   begin
  545.     SizeDBEdit.Enabled := True;
  546.     SizeDBEdit.Color := clWindow;
  547.     SizeLabel.Enabled  := True;
  548.     DecDBEdit.Enabled := False;
  549.     DecDBEdit.Color := clBtnFace;
  550.     DecLabel.Enabled := False;
  551.     KeyDBCheckBox.Enabled := True;
  552.   end
  553.  
  554.   else if (CurrentType = ibDecimal ) or
  555.           (CurrentType = ibNumeric) then
  556.   begin
  557.     SizeDBEdit.Enabled := True;
  558.     SizeDBEdit.Color := clWindow;
  559.     SizeLabel.Enabled  := True;
  560.     DecDBEdit.Enabled := True;
  561.     DecDBEdit.Color := clWindow;
  562.     DecLabel.Enabled := True;
  563.     KeyDBCheckBox.Enabled := True;
  564.   end
  565.  
  566.   else if (CurrentType = ibBlob ) then
  567.   begin
  568.     SizeDBEdit.Enabled := False;
  569.     SizeDBEdit.Color := clBtnFace;
  570.     SizeLabel.Enabled  := False;
  571.     DecDBEdit.Enabled := False;
  572.     DecDBEdit.Color := clBtnFace;
  573.     DecLabel.Enabled := False;
  574.     KeyDBCheckBox.Enabled := False;
  575.   end
  576.  
  577.   else
  578.   begin
  579.     SizeDBEdit.Enabled := False;
  580.     SizeDBEdit.Color := clBtnFace;
  581.     SizeLabel.Enabled  := False;
  582.     DecDBEdit.Enabled := False;
  583.     DecDBEdit.Color := clBtnFace;
  584.     DecLabel.Enabled := False;
  585.     KeyDBCheckBox.Enabled := True;
  586.   end;
  587.  
  588. end;
  589.  
  590. procedure TCreateTableForm.TableNameEditExit(Sender: TObject);
  591. begin
  592.  
  593.   BuildSqlStatement;
  594.  
  595. end;
  596.  
  597. procedure TCreateTableForm.TableNameEditKeyPress(Sender: TObject;
  598.   var Key: Char);
  599. begin
  600.  
  601.   Key := UpCase( Key );
  602.   if Key = ' ' then
  603.   begin
  604.     Key := '_'
  605.   end;
  606.  
  607. end;
  608.  
  609. procedure TCreateTableForm.FieldNameDBEditKeyPress(Sender: TObject;
  610.   var Key: Char);
  611. begin
  612.  
  613.   Key := UpCase( Key );
  614.   if Key = ' ' then
  615.   begin
  616.     Key := '_'
  617.   end;
  618.  
  619. end;
  620.  
  621. procedure TCreateTableForm.TypeDBComboBoxChange(Sender: TObject);
  622. begin
  623.  
  624.   SetUiState;
  625.  
  626. end;
  627.  
  628. procedure TCreateTableForm.StructureDataSourceDataChange(
  629.   Sender: TObject; Field: TField);
  630. begin
  631.  
  632.   if StructureDataSource.DataSet <> Nil then
  633.   begin
  634.     if StructureDataSource.DataSet.State in [dsBrowse] then
  635.     begin
  636.       SetUiState;
  637.     end;
  638.   end;
  639.  
  640. end;
  641.  
  642. procedure TCreateTableForm.AddFieldButtonClick(Sender: TObject);
  643. begin
  644.  
  645.   FieldNameDBEdit.SetFocus;
  646.   StructureTable.Append;
  647.  
  648. end;
  649.  
  650. procedure TCreateTableForm.DeleteFieldButtonClick(Sender: TObject);
  651. begin
  652.  
  653.   StructureTable.Delete;
  654.  
  655. end;
  656.  
  657. procedure TCreateTableForm.CancelFieldButtonClick(Sender: TObject);
  658. begin
  659.  
  660.   StructureTable.Cancel;
  661.  
  662. end;
  663.  
  664. procedure TCreateTableForm.SaveFieldButtonClick(Sender: TObject);
  665. begin
  666.  
  667.   StructureTable.Post;
  668.  
  669. end;
  670.  
  671. end.
  672.