Board index » delphi » How to create Fields during runtime

How to create Fields during runtime

I would like to create new fields in an existing Paradox table during
run time in a delphi 1.1 program. Can this be done or do I have to
create a new table using the CreateTable statement?

Jan Derk Stegeman

 

Re:How to create Fields during runtime


In article <325A3FD0.1...@nlr.nl>, From Jan Derk Stegeman
<stege...@nlr.nl>, the following was written:

Quote
> I would like to create new fields in an existing Paradox table during
> run time in a delphi 1.1 program. Can this be done or do I have to
> create a new table using the CreateTable statement?

> Jan Derk Stegeman

You can use SQL:

ALTER TABLE "employee.db" ADD BUILDING_NO SMALLINT

You will need to add a Tquery component.  Change the SQL property to
your SQL statment and then execute with:

MyQuery.ExecSQL;

For more information look at the database desktop help(local sql).

God Bless,

--
Jay Schwisow j...@weldnet.com
10/08/96 22:47
---------
Using: OUI PRO 1.5.0.2 from http://www.dvorak.com

Re:How to create Fields during runtime


Hi folks.

I have a "toast" to you.

I dont know english. I will try. :)

A sample code to read a file with tables structures (INI format).
I use this code to modify/create tables. It's made for Paradox
Files.

Enjoi it.

[]'s
Nileo

--------------------------

File with tables structure (APPNAME.TBL)
;
;Field Types (only valid first char)
;
; Alpha     - ftString
; Date      - ftDate
; Logical   - ftBoolean
; Short     - ftSmallInt
; Integer   - ftInteger
; Currency  - ftCurrency
; Number    - ftFloat
; Memo      - ftMemo

;
; Index files
;
; 1o Param, Index Key
;   Ex.: Field1+Field2+Field3+...
;
; 2o Param (optional), Kind
;   Ex.: Unique+Descending
;
; Primary    - Primary Key
; Unique     - ...
; Descending - ...

;To force rebuild
;
;Rebuild=true
;

;
;Example
;

[Tables]
Table1=Depart           ;Departaments
Table2=Employee

[Depart]
Field1=DepatCode,Alpha,15
Field2=Name,Alpha,40
Field3=Emp_Counter,Number
Index1=+DepartCode,Primary
Rebuild=True

[Employee]
Field1=DepartCode,Alpha,15
Field2=EmpID,Alpha,5
Field3=Name,Date
Field4=Salary,Currency
Index1=DepartCode+EmpID,Primary

-------------------------

Att.
DEFAULTBLEXT contains ".DB" (Table file ext)
DEFAULIDXEXT contains ".PX" (Index file ext)

Put this code into main form

procedure TFormMain.FormCreate(Sender: TObject);
begin

 {
  .....
 }

    try

      { I made Depart table always opened, so i can test this}

      {Try to open in exclusive mode}
      if FileExists( DataBasePath + '\Depart' + DEFAULTBLEXT) then
        with TBL_Dummy do {TBL_Dummy is a TTable object}
        begin
          Close;
          Exclusive := True;
          DataBaseName := DataBasePath;
          TableName := 'Depart';
          Open;  {Try to Open Exclusive}
          Close; {Opned, close and continue}
        end;

      {Scan Tables}
      Application.CreateForm(TFormDataBase, FormDataBase);
      if (FormDataBase.ShowModal <> mrOk) then
      begin
        Beep;
        Application.MessageBox( 'Can't scan/create Tables.',
                                AppName, mb_OK + mb_IconExclamation);
        Application.Terminate;
        Exit;
      end;

    except
      {Tables alread oppened, don't scan}
    end; {try}

    with TBL_Dummy do
    begin
      Close;
      Exclusive := False;
      DataBaseName := DataBasePath;
      TableName := 'TABLEX';
      Open;  
    end;

 {
  .....
 }

end

-----------------------------------------

Creat a form with 3 labels, 2 TTable objects (TBL_Source & TBL_Dest) & a
timer.

unit DataBase;

interface

uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  StdCtrls, SysUtils, DB, IniFiles, DBTables, ExtCtrls;

type
  TFormDataBase = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    TBL_Source: TTable;
    TBL_Dest: TTable;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    lTableInfo : TIniFile;
    lTableNames,
    lTableFields,
    lTableIndex : TStringList;
    Scanned,
    WithError : Boolean;
    TmpFileName : String;
    procedure ScanTable(lTableName : String);
    procedure MakeTable( const lTableName, lExtensao : String;
                         const lTableFields, lTableIndex : TStringList);
    procedure MakeField( const lFieldString : String;
                         var lFieldName : String;
                         var lFieldType : TFieldType;
                         var lFieldSize : Integer);
    procedure MakeIndex( const lIndexString : String;
                         var lIndexFields : String;
                         var lIndexOptions : TIndexOptions);
  public
    { Public declarations }
  end;

var
  FormDataBase: TFormDataBase;

implementation

const MAXTABLES = 10;
      MAXFIELDS = 30;
      MAXINDEX  = 3; {max index by table}

{$R *.DFM}

procedure TFormDataBase.FormCreate(Sender: TObject);
begin
  lTableInfo := TIniFile.Create( ApplicationPath + '\' + AppName +
'.tbl');
  lTableNames := TStringList.Create;
  lTableFields := TStringList.Create;
  lTableIndex := TStringList.Create;
  WithError := False;
  Scanned := False;
  TmpFileName := Copy( '~' + AppName, 1, 8);
end;

procedure TFormDataBase.FormActivate(Sender: TObject);
var i : Integer;
    s : string;
begin

  if Scanned then Exit;

  Label1.Refresh;
  Label3.Refresh;

  for i := 1 to MAXTABLES do
  begin
    s := lTableInfo.ReadString( 'Tables', 'Table' + IntToStr(i), '');
    if s = '' then break;

    lTableNames.Add(s);

  end;

  for i := 0 to lTableNames.Count - 1 do
  begin
    Label2.Caption := 'Table: ' + lTableNames.Strings[i];
    Label2.Refresh;
    ScanTable( lTableNames.Strings[i]);
  end;

  Scanned := True;
  Hide;

end;

procedure TFormDataBase.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin

  lTableInfo.Free;
  lTableNames.Free;
  lTableFields.Free;
  lTableIndex.Free;

  if WithError then
    ModalResult := mrCancel
  else
    ModalResult := mrOk;

  Action := caFree;
  Release;

end;

procedure TFormDataBase.MakeField( const lFieldString : String;
                                  var lFieldName : String;
                                  var lFieldType : TFieldType;
                                  var lFieldSize : Integer);
var j : Integer;
    n, t, s : String;
begin

  lFieldName := lFieldString;
  while Pos( ' ', lFieldName) > 0 do
    Delete( lFieldName, Pos( ' ', lFieldName), 1);

  j := Pos( ',', lFieldName);                  
{DepatCode,Alpha,15}/{Salary,Currency}
  n := Copy( lFieldName, 1, j - 1);             {DepatCode}/{Salary}
  s := Copy( lFieldName, j + 1,                 {Alpha,15}/{Currency}
             Length( lFieldName) - j);
  j := Pos( ',', s);
  if j > 0 then
  begin
    t := Copy( s, 1, j - 1);                     {Alpha}
    s := Copy( s, j + 1, Length(s) - j);
  end
  else
  begin
    t := s;                                      {Currency}
    s := '0';
  end;

  lFieldName := n;

  case UpCase( t[1]) of
    'A' : lFieldType := ftString;
    'C' : lFieldType := ftCurrency;
    'L' : lFieldType := ftBoolean;
    'D' : lFieldType := ftDate;
    'I' : lFieldType := ftInteger;
    'S' : lFieldType := ftSmallInt;
    'N' : lFieldType := ftFloat;
    'M' : lFieldType := ftMemo;
  else
    lFieldType := ftUnknown;
    WithError := True;
  end;

  lFieldSize := 0;
  try
    lFieldSize := StrToInt( s);
  except
    WithError := True;
  end;

end;

procedure TFormDataBase.MakeIndex( const lIndexString : String;
                                  var lIndexFields : String;
                                  var lIndexOptions : TIndexOptions);
var j : Integer;
    s, t : String;
begin

  lIndexFields := '';
  lIndexOptions := [];

  s := lIndexString;
  while Pos( ' ', s) > 0 do
    Delete( s, Pos( ' ', s), 1);

  j := Pos( ',', s);          
{+Field1+Field2+Field3,Primary+Unique+Descending}
  if j = 0 then
  begin
    lIndexFields := s;
    t := '';
  end
  else
  begin
    lIndexFields := Copy( s, 1, j - 1);            
{+Field1+Field2+Field3}
    t := UpperCase( Copy( s, j + 1, Length(s) -
j));{+PRIMARY+UNIQUE+DESCENDING}
  end;

  {Index Fields}
  {Change '+' to ';'}
  while Pos( '+', lIndexFields) > 0 do
  begin
    lIndexFields[Pos( '+', lIndexFields)] := ';';
  end;
  {Out first '+'}
  if lIndexFields[1] = ';' then
    lIndexFields := Copy( lIndexFields, 2, Length( lIndexFields) - 1);

  {Index Options}
  {Out first '+'}
  if t[1] = '+' then
    t := Copy( t, 2, Length( t) - 1);

  s := t;
  while Length( t) > 0 do
  begin
    j := Pos( '+', t);
    if j > 0 then
    begin
      s := Copy( t, 1, j - j);
      t := Copy( t, j + 1, Length( t) - j);
    end
    else
      t := '';
    if s = 'PRIMARY' then
      lIndexOptions := lIndexOptions + [ixPrimary,ixUnique]
    else if s = 'UNIQUE' then
      lIndexOptions := lIndexOptions + [ixUnique]
    else if s = 'DESCENDING' then
      lIndexOptions := lIndexOptions + [ixDescending];
  end;

end;

procedure TFormDataBase.MakeTable( const lTableName, lExtensao : String;
                                  const lTableFields, lTableIndex :
TStringList);
var i : Integer;
    Table1 : TTable;
    lFieldName : String;
    lFieldType : TFieldType;
    lFieldSize : Integer;
    lIndexFields : String;
    lIndexOptions : TIndexOptions;
begin
  Table1 := TTable.Create(Self);
  with Table1 do
  begin
    Active := False;
    DataBaseName := DataBasePath;
    TableName := lTableName;
    TableType := ttParadox;
    with FieldDefs do
    begin
      Clear;
      for i := 0 to lTableFields.Count - 1 do
      begin
        MakeField(lTableFields.Strings[i], lFieldName, lFieldType,
lFieldSize);
        Add(lFieldName, lFieldType, lFieldSize, false);
      end;
    end;
    with IndexDefs do
    begin
      Clear;
      for i := 0 to lTableIndex.Count - 1 do
      begin
        MakeIndex(lTableIndex.Strings[i], lIndexFields, lIndexOptions);
        Add('Index' + IntToStr(i), lIndexFields, lIndexOptions);
      end;
    end;
    try
      CreateTable;
    except
      WithError := True;
    end;
  end;
  Table1.Close;
  Table1.Free;
end;

procedure TFormDataBase.ScanTable(lTableName : String);
var i, j : Integer;
    Remonta : Boolean;
    lFieldName : String;
    lFieldType : TFieldType;
    lFieldSize : Integer;
    lIndexFields : String;
    lIndexOptions : TIndexOptions;
begin

  lTableFields.Clear;
  lTableIndex.Clear;

  for i := 1 to MAXFIELDS do
  begin
    lFieldName := lTableInfo.ReadString( lTableName, 'Field' +
IntToStr(i), '');
    if lFieldName = '' then break;

    lTableFields.Add(lFieldName);

  end;

  for i := 1 to MAXINDEX do
  begin
    lIndexFields := lTableInfo.ReadString( lTableName, 'Index' +
IntToStr(i), '');
    if lIndexFields = '' then break;

    lTableIndex.Add(lIndexFields);

  end;

  if FileExists( DataBasePath + '\' + lTableName + DEFAULTBLEXT) then
  begin

    Rebuild :=
...

read more »

Other Threads