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
public
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; begin
aMsgDlg := CreateMessageDialog(Msg, DlgType, buttons); aMsgDlg.Font.style := []; aMsgDlg.setbounds(300,410,450,120);
CaptionIndex := 0;
for i := 0 to aMsgDlg.ComponentCount - 1 do begin if (aMsgDlg.Components[i] is TButton) then
begin
dlgButton := TButton(aMsgDlg.Components[i]);
dlgButton.Left := 100*(i-2) + 10*(i+1);
dlgbutton.width := 100; 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' 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
table2.Edit;
table2.FieldByName(s1).AsString := table1.fieldbyname(s1).asstring;
table2.Post;
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])); 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!');
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; end;
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;
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
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;
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. |
D. Annies hat folgendes geschrieben: