1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:

function GetFieldType(aFieldType:TFieldType):String;
begin
  case aFieldType of
    ftUnknown    :Result:='Unknown or undetermined';
    ftString     :Result:='Character or string field';
    ftSmallint   :Result:='16-bit integer field';
    ftInteger    :Result:='32-bit integer field';
    ftWord       :Result:='16-bit unsigned integer field';
    ftBoolean    :Result:='Boolean field';
    ftFloat      :Result:='Floating-point numeric field';
    ftCurrency   :Result:='Money field';
    ftBCD        :Result:='Binary-Coded Decimal field';
    ftDate       :Result:='Date field';
    ftTime       :Result:='Time field';
    ftDateTime   :Result:='Date and time field';
    ftBytes      :Result:='Fixed number of bytes (binary storage)';
    ftVarBytes   :Result:='Variable number of bytes (binary storage)';
    ftAutoInc    :Result:='Auto-incrementing 32-bit integer counter field';
    ftBlob       :Result:='Binary Large OBject field';
    ftMemo       :Result:='Text memo field';
    ftGraphic    :Result:='Bitmap field';
    ftFmtMemo    :Result:='Formatted text memo field';
    ftParadoxOle :Result:='Paradox OLE field';
    ftDBaseOle   :Result:='dBASE OLE field';
    ftTypedBinary:Result:='Typed binary field';
    ftCursor     :Result:='Output cursor from an Oracle stored procedure (TParam only)';
    ftFixedChar  :Result:='Fixed character field';
    ftWideString :Result:='Wide string field';
    ftLargeInt   :Result:='Large integer field';
    ftADT        :Result:='Abstract Data Type field';
    ftArray      :Result:='Array field';
    ftReference  :Result:='REF field';
    ftDataSet    :Result:='DataSet field';
    ftOraBlob    :Result:='BLOB fields in Oracle 8 tables';
    ftOraClob    :Result:='CLOB fields in Oracle 8 tables';
    ftVariant    :Result:='Data of unknown or undetermined type';
    ftInterface  :Result:='References to interfaces (IUnknown)';
    ftIDispatch  :Result:='References to IDispatch interfaces';
    ftGuid       :Result:='globally unique identifier (GUID) values';
  end; // case
end; // GetFieldType

resourcestring
  rsFmtByte='%d Byte';

procedure ViewDataset(aLV:TListView; aDS:TDataSet);
var i:Integer;
begin
  with aDS do
  begin
    with aLV do
    begin
      Items.BeginUpdate;
      try
        Items.Clear;
        for i:=0 to FieldCount-1 do
        begin
          with Items.Add do
          begin
            Caption:=Fields[i].DisplayName;
            SubItems.Add(GetFieldType(Fields[i].DataType));
            SubItems.Add(Format(rsFmtByte, [Fields[i].DataSize]));
            ImageIndex:=0;
          end; // with
        end; // for i
        finally
          Items.EndUpdate;
      end; // try
    end; // with
  end; // with
end; // ViewDataset

procedure TForm4.Button6Click(Sender: TObject);
begin
  viewdataset(listview1, datasource2.DataSet);
end;					

1:
2:
3:
4:
5:
6:
7:

...
      with AddFieldDef do begin
        Name := 'Field2';
        DataType := ftString;
        Size := 30;//Feldgröße 30 Zeichen
      end;
...					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:

unit buchtab_pas;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables, ComCtrls;

type
  TForm4 = class(TForm)
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    DBGrid2: TDBGrid;
    DataSource2: TDataSource;
    OpenDialog1: TOpenDialog;
    OpenDialog2: TOpenDialog;
    Button1: TButton;
    Button2: TButton;
    Table1: TTable;
    Table2: TTable;
    ListBox1: TListBox;
    Button3: TButton;
    Query1: TQuery;
    Button4: TButton;
    ListBox2: TListBox;
    Button5: TButton;
    Button6: TButton;
    StringGrid1: TStringGrid;
    Button7: TButton;
    TableNeu: TTable;
    DBGrid3: TDBGrid;
    DataSource3: TDataSource;
    Button8: TButton;
    StringGrid2: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure kop(sender: tobject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form4        : TForm4;
  s1, s2, t, r : string;
    ft         : array[1..250] of TfieldType;
    x          : integer;

implementation

uses buch;

{$R *.dfm}

procedure TForm4.FormCreate(Sender: TObject);
begin
  stringgrid1.Cells[0,0] := 'Feldname';
  stringgrid1.Cells[1,0] := 'Feldtyp';
  stringgrid1.Cells[2,0] := 'Feldgröße (Byte)';
  stringgrid1.Cells[3,0] := 'Feldbezeichner';
  stringgrid1.Cells[4,0] := 'Ja';
  stringgrid1.Options := stringgrid1.Options + [goediting];
  x := 1;
  stringgrid2.Cells[0,0] := 'Feldname';
  stringgrid2.Cells[1,0] := 'Feldtyp';
  stringgrid2.Cells[2,0] := 'F-größe';
  stringgrid2.Cells[3,0] := 'Feldbezeichner';
  stringgrid2.Cells[4,0] := 'Ja';
end;

function xMessageDlg(const Msg: string; DlgType : TMsgDlgType;
            Buttons : TMsgDlgButtons; Captions: array of string; myFont:TFont) : Integer;
var aMsgDlg         : TForm;
    CaptionIndex, i : integer;
    dlgButton       : TButton;  // uses stdctrls
begin
  aMsgDlg := CreateMessageDialog(Msg, DlgType, buttons);  // Dlg erzeugen
  aMsgDlg.Font.style := [];   //myFont, zB. [fsitalic] ;
  aMsgDlg.setbounds(300,410,450,120);
  CaptionIndex := 0;
  for i := 0 to aMsgDlg.ComponentCount - 1 do  // alle Objekte des Dialoges testen
  begin    // wenn es ein Button ist, dann...
    if (aMsgDlg.Components[i] is TButton) then
    begin
      dlgButton := TButton(aMsgDlg.Components[i]);
      dlgButton.Left := 100*(i-2) + 10*(i+1);
      dlgbutton.width := 100;   // 68;
      if CaptionIndex > High(Captions) then Break;
      dlgButton.Caption := Captions[CaptionIndex];
      Inc(CaptionIndex);
    end;
  end;
  Result := aMsgDlg.ShowModal;
end;

procedure TForm4.Button1Click(Sender: TObject);
var i : integer;
begin
  getdir(0, s1);
  opendialog1.Filter := 'Tabellen (*.dbf)|*.dbf';
  table1.active := false;
  if opendialog1.Execute then
  begin
    if opendialog1.FileName = s1 + '\' + 'schultss.DBF' then
      table1.DatabaseName := 'schuelertss'  //fest!
    else
      table1.DatabaseName := '';
    table1.TableName := opendialog1.FileName;
    datasource1.DataSet := table1;
    dbgrid1.DataSource := datasource1;
    table1.Active := true;
    listbox1.Clear;
    for i := 0 to Table1.FieldCount - 1 do
    begin
      s1 := concat(inttostr(i),' ', table1.fields[i].fieldname);
      listbox1.items.add(s1);
    end;
    button2.setfocus;
  end;  
end;

procedure TForm4.Button2Click(Sender: TObject);
var i, j : integer;
begin
  for j := 1 to stringgrid1.RowCount-1 do
  for i := 0 to stringgrid1.ColCount-1 do stringgrid1.Cells[i,j] := '';
  opendialog2.Filter := 'Tabellen (*.dbf)|*.dbf';
  if opendialog2.Execute then
  begin
    table2.Active := false;
      table2.DatabaseName := '';
      table2.TableName := opendialog2.FileName;
      t := table2.TableName;
      datasource2.DataSet := table2;
      dbgrid2.DataSource := datasource2;
    table2.Active := true;
    listbox2.Clear;
    for i := 0 to Table2.FieldCount - 1 do
    begin
      s2 := concat(inttostr(i), ' ', table2.fields[i].fieldname);
      listbox2.items.add(s2);
    end;
    button3.Visible := true; button4.Visible := true; button5.Visible := true;
    button6.SetFocus;
  end;
end;

procedure TForm4.Button3Click(Sender: TObject);
var n, i : integer;
begin
  s1 := listbox1.Items[listbox1.itemindex];
  if (s1 <> '') and (pos(' ', s1) > 0) then
  begin
    n := pos(' ', s1);
    delete(s1, 1, n);
    showmessage(s1);
    if table2.findfield(s1) = NIL then
    begin
      showmessage('Feldname existiert nicht');

      if messagedlgpos('Feld kann erst nach SQL_ALTER_TABLE in den Buchsatz eingetragen '+
                       'werden. Soll Änderung durchgeführt werden? ',
                     mtConfirmation, mbYesNoCancel, 0,200,475) = mrYes then
      begin
        Table2.Active := false;
        with Query1 do
        begin
          Close; SQL.Clear;
          SQL.text := format('ALTER TABLE "%s" ADD COLUMN '+ s1 +' CHAR(30)', [t]);
          ExecSQL;                                              // ********
        end;
        Table2.Active := true;

        listbox2.Clear;
        for i := 0 to Table2.FieldCount - 1 do
        begin
          s2 := concat(inttostr(i), ' ', table2.fields[i].fieldname);
          listbox2.items.add(s2);
        end;
        showmessage('Feldname wurde angehängt');

        kop(self);
      end
      else
      begin
        showmessage('Vorgang abgebrochen'); EXIT;
      end
    end
    else kop(self);
  end;
end;

procedure Tform4.kop(sender: tobject);
begin
  showmessage('Feldname existiert (jetzt), von t1 wird kopiert, t2 wird überschrieben');
  table1.First; table2.First;
  repeat
    if table1.FieldByName(s1).asstring <> '' then
    begin
      {try
        table2.Locate('NAME;VORNAME;KLASSE',
                       VarArrayOf([table1.fieldbyname('NAME').asstring,
                                   table1.fieldbyname('VORNAME').asstring,
                                   table1.fieldbyname('KLASSE').asstring]), []);}
      table2.Edit;
        table2.FieldByName(s1).AsString := table1.fieldbyname(s1).asstring;
      table2.Post;
      {except
        showmessage('Schüler nicht gefunden');
      end;}
    end;
    table1.Next; table2.Next;
  until table1.Eof or table2.Eof;
  form1.q3sort(self);
end;

procedure TForm4.Button4Click(Sender: TObject);
begin
  InputString := InputBox('SQL-Eingabedialog', 'Eingabe:',
    format('select count (*) ' +
           'from "%s" ', [t]));  // 'where FSPRACHE1 LIKE ''F%%'' ', [t]));
  showmessage(inputstring);
  if dbgrid2.fieldcount > 0 then
  begin
    with query1 do
    begin
      close;
        SQL.Text := InputString;
      open;
    end;
    showmessage(query1.Fields[0].asstring);
  end
  else showmessage('Keine Tabelle geladen!');
  //datasource1.dataset := query1; dbgrid1.datasource := datasource1;
end;

procedure TForm4.Button5Click(Sender: TObject);
var n : integer;
begin
  s2 := listbox2.Items[listbox2.itemindex];
  if (s2 <> '') and (pos(' ', s2) > 0) then
  begin
    n := pos(' ', s2);
    delete(s2, 1, n);
    showmessage(s2);
    Table2.Active := false;
    with Query1 do
    begin
      Close; SQL.Clear;
      SQL.text := format('ALTER TABLE "%s" DROP COLUMN '+ s2 , [t]);
      ExecSQL;
    end;
    Table2.Active := true;
  end;
end;

function GetFieldType(aFieldType:TFieldType):String;
begin
  case aFieldType of
    ftUnknown     : begin Result := 'Unknown or undetermined'; r := 'ftUnknown'; ft[x] := aFieldType; inc(x);end;
    ftString      : begin Result := 'Character or string field'; r := 'ftString'; ft[x] := aFieldType; inc(x);end;
    ftSmallint    : begin Result := '16-bit integer field'; r := 'ftSmallint'; ft[x] := aFieldType; inc(x);end;
    ftInteger     : begin Result := '32-bit integer field'; r := 'ftInteger'; ft[x] := aFieldType; inc(x);end;
    ftWord        : begin Result := '16-bit unsigned integer field'; r := 'ftWord'; ft[x] := aFieldType; inc(x);end;
    ftBoolean     : begin Result := 'Boolean field'; r := 'ftBoolean'; ft[x] := aFieldType; inc(x);end;
    ftFloat       : begin Result := 'Floating-point numeric field'; r := 'ftFloat'; ft[x] := aFieldType; inc(x);end;
    ftCurrency    : begin Result := 'Money field'; r := 'ftCurrency'; ft[x] := aFieldType; inc(x);end;
    ftBCD         : begin Result := 'Binary-Coded Decimal field'; r := 'ftBCD'; ft[x] := aFieldType; inc(x);end;
    ftDate        : begin Result := 'Date field'; r := 'ftDate'; ft[x] := aFieldType; inc(x);end;
    ftTime        : begin Result := 'Time field'; r := 'ftTime'; ft[x] := aFieldType; inc(x);end;
    ftDateTime    : begin Result := 'Date and time field'; r := 'ftDateTime'; ft[x] := aFieldType; inc(x);end;
    ftBytes       : begin Result := 'Fixed number of bytes (binary storage)'; r := 'ftBytes'; ft[x] := aFieldType; inc(x);end;
    ftVarBytes    : begin Result := 'Variable number of bytes (binary storage)'; r := 'ftVarBytes'; ft[x] := aFieldType; inc(x);end;
    ftAutoInc     : begin Result := 'Auto-incrementing 32-bit integer counter field'; r := 'ftAutoInc'; ft[x] := aFieldType; inc(x);end;
    ftBlob        : begin Result := 'Binary Large OBject field'; r := 'ftBlob'; ft[x] := aFieldType; inc(x);end;
    ftMemo        : begin Result := 'Text memo field'; r := 'ftMemo'; ft[x] := aFieldType; inc(x);end;
    ftGraphic     : begin Result := 'Bitmap field'; r := 'ftGraphic'; ft[x] := aFieldType; inc(x);end;
    ftFmtMemo     : begin Result := 'Formatted text memo field'; r := 'ftFmtMemo'; ft[x] := aFieldType; inc(x);end;
    ftParadoxOle  : begin Result := 'Paradox OLE field'; r := 'ftParadoxOle'; ft[x] := aFieldType; inc(x);end;
    ftDBaseOle    : begin Result := 'dBASE OLE field'; r := 'ftDBaseOle'; ft[x] := aFieldType; inc(x);end;
    ftTypedBinary : begin Result := 'Typed binary field'; r := 'ftTypedBinary'; ft[x] := aFieldType; inc(x);end;
    ftCursor      : begin Result := 'Output cursor from an Oracle stored procedure (TParam only)'; r := 'ftCursor'; ft[x] := aFieldType; inc(x);end;
    ftFixedChar   : begin Result := 'Fixed character field'; r := 'ftFixedChar'; ft[x] := aFieldType; inc(x);end;
    ftWideString  : begin Result := 'Wide string field'; r := 'ftWideString'; ft[x] := aFieldType; inc(x);end;
    ftLargeInt    : begin Result := 'Large integer field'; r := 'ftLargeInt'; ft[x] := aFieldType; inc(x);end;
    ftADT         : begin Result := 'Abstract Data Type field'; r := 'ftADT'; ft[x] := aFieldType; inc(x);end;
    ftArray       : begin Result := 'Array field'; r := 'ftArray'; ft[x] := aFieldType; inc(x);end;
    ftReference   : begin Result := 'REF field'; r := 'ftReference'; ft[x] := aFieldType; inc(x);end;
    ftDataSet     : begin Result := 'DataSet field'; r := 'ftDataSet'; ft[x] := aFieldType; inc(x);end;
    ftOraBlob     : begin Result := 'BLOB fields in Oracle 8 tables'; r := 'ftOraBlob'; ft[x] := aFieldType; inc(x);end;
    ftOraClob     : begin Result := 'CLOB fields in Oracle 8 tables'; r := 'ftOraClob'; ft[x] := aFieldType; inc(x);end;
    ftVariant     : begin Result := 'Data of unknown or undetermined type'; r := 'ftVariant'; ft[x] := aFieldType; inc(x);end;
    ftInterface   : begin Result := 'References to interfaces (IUnknown)'; r := 'ftInterface'; ft[x] := aFieldType; inc(x);end;
    ftIDispatch   : begin Result := 'References to IDispatch interfaces'; r := 'ftIDispatch'; ft[x] := aFieldType; inc(x);end;
    ftGuid        : begin Result := 'globally unique identifier (GUID) values'; r := 'ftGuid'; ft[x] := aFieldType; inc(x);end;
  end; // case
end; // GetFieldType

resourcestring  rsFmtByte = '%d';

procedure ViewDataset(aDS:TDataSet);
var i, j :Integer;
begin
  j := 0;
  with aDS do
  begin
    for i := 0 to FieldCount-1 do
    begin
      form4.stringgrid1.cells[0,i+1] := Fields[i].DisplayName;
      form4.stringgrid1.cells[1,i+1] := GetFieldType(Fields[i].DataType);
      form4.stringgrid1.cells[2,i+1] := Format(rsFmtByte, [Fields[i].DataSize]);
      form4.stringgrid1.cells[3,i+1] := r;
      form4.stringgrid1.cells[4,i+1] := 'x';  j := i;
    end;
    form4.StringGrid1.RowCount := j+2;
  end;
end;

procedure ViewDataFeld(aDS:TDataSet);
var i : integer;
begin
  with aDS do
  begin
    with fields[form4.listbox1.itemindex] do
    begin
      i := form4.listbox1.itemindex;
      form4.stringgrid2.cells[0,1] := Fields[i].DisplayName;
      form4.stringgrid2.cells[1,1] := GetFieldType(Fields[i].DataType);
      form4.stringgrid2.cells[2,1] := Format(rsFmtByte, [Fields[i].DataSize]);
      form4.stringgrid2.cells[3,1] := r;
      form4.stringgrid2.cells[4,1] := 'x';
    end;
  end;
end;

procedure TForm4.Button6Click(Sender: TObject);
var erg : integer;
begin
  x := 1;
  erg := xmessagedlg('Folgende Tabelle sehen:', mtconfirmation,
               [mbYes, mbNo, mbcancel], ['Tabelle oben', 'Tabelle unten', 'Abbrechen'], self.font);
  case erg of
    mryes    : begin viewdataset(datasource1.DataSet); end;
    mrno     : begin viewdataset(datasource2.DataSet); end;
    mrcancel : begin end;
  end;
end;

procedure TForm4.Button7Click(Sender: TObject);
var n  : integer;
begin
  with TableNeu do
  begin
    close;
    //DatabaseName := 'schuelertss';
    TableName := concat(home, '\', 'NewT',inttostr(j), '.dbf');
    TableType := ttDefault;
    open;
    FieldDefs.Clear;
    for n := 1 to stringgrid1.RowCount-1 do
    begin
      if stringgrid1.Cells[4,n] = 'x' then
      begin
                                    // Name   // Typ            // Größe            //Required
        //FieldDefs.Add(stringgrid1.Cells[0,n], ft[n], strtoint(stringgrid1.Cells[2,n]), False);
        with fielddefs.AddFieldDef do
        begin
          Name := stringgrid1.Cells[0,n];
          Size := strtoint(stringgrid1.Cells[2,n]);
          DataType := ft[n];
          required := false;
        end;
      end;
    end;

    //FieldDefs.Add('Ident_Nr',   ftstring,    8, False);
    // IndexDefs.Clear;  IndexDefs.Add('PrimaryIndex', 'Klasse', NewIndexOptions);

    close;
    CreateTable;
  end;
  datasource3.DataSet := TableNeu;
  dbgrid3.datasource := datasource3;
  TableNeu.Active := true;
end;

procedure TForm4.Button8Click(Sender: TObject);
var n : integer;
begin
  if stringgrid1.Cells[4,1] = 'x' then
  for n := 1 to stringgrid1.RowCount-1 do stringgrid1.Cells[4,n] := ''
  else
  for n := 1 to stringgrid1.RowCount-1 do stringgrid1.Cells[4,n] := 'x'
end;

procedure TForm4.ListBox1Click(Sender: TObject);
begin  ViewDataFeld(datasource1.DataSet);  end;


end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:

procedure TForm4.Button7Click(Sender: TObject);
var n  : integer;
begin
  with TableNeu do
  begin
    close;
    //DatabaseName := 'schuelertss';
    TableName := concat(home, '\', 'NewT',inttostr(j), '.dbf');
    TableType := ttDefault;
    open;
    FieldDefs.Clear;
    for n := 1 to stringgrid1.RowCount-1 do
    begin
      if stringgrid1.Cells[4,n] = 'x' then
      begin
        //--zu erstellen FeldTyp abfragen
        if stringgrid1.Cells[3,n] = 'ftString' then //<<--
          with fielddefs.AddFieldDef do
          begin
            Name := stringgrid1.Cells[0,n];
            Size := strtoint(stringgrid1.Cells[2,n]);
            DataType := ft[n];
            required := false;
        end;
      end;
    end;

    close;
    CreateTable;
  end;
  datasource3.DataSet := TableNeu;
  dbgrid3.datasource := datasource3;
  TableNeu.Active := true;
end;