unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Db, DBTables, Grids, DBGrids;
type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
MyTable: TTable;
DataSource1: TDataSource;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure ExportToASCII;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ExportToASCII;
const
FASCIISeparator:string=' | ';
var
I: Integer;
Dlg: TSaveDialog;
ASCIIFile: TextFile;
Res, FASCIIFieldNames: Boolean;
FASCIIFileName:string;
begin
with MyTable do
begin
if Active then
if (FieldCount > 0) and (RecordCount > 0) then
begin
Dlg := TSaveDialog.Create(Application);
Dlg.FileName := FASCIIFileName;
Dlg.Filter := 'ASCII-Fiels (*.asc)|*.asc';
Dlg.Options := Dlg.Options+[ofPathMustExist,
ofOverwritePrompt, ofHideReadOnly];
Dlg.Title := 'Экспоритровать данные в ASCII-файл';
try
Res := Dlg.Execute;
if Res then
FASCIIFileName := Dlg.FileName;
finally
Dlg.Free;
end;
if Res then
begin
AssignFile(ASCIIFile, FASCIIFileName);
Rewrite(ASCIIFile); First;
if FASCIIFieldNames then
begin
for I := 0 to FieldCount-1 do
begin
write(ASCIIFile, Fields[I].FieldName);
if I <> FieldCount-1 then
write(ASCIIFile, FASCIISeparator);
end;
write(ASCIIFile, #13#10);
end;
while not EOF do
begin
for I := 0 to FieldCount-1 do
begin
write(ASCIIFile, Fields[I].Text);
if I <> FieldCount-1 then
write(ASCIIFile, FASCIISeparator);
end;
Next;
if not EOF then
write(ASCIIFile, #13#10);
end;
CloseFile(ASCIIFile);
if IOResult <> 0 then
MessageDlg('Ошибка при создании или переписывании '+
'в ASCII-файл', mtError, [mbOK], 0);
end;
end
else
MessageDlg('Нет данных для экспортирования.',
mtInformation, [mbOK], 0)
else
MessageDlg('Таблица должна быть открытой, чтобы данные '+
'можно было экспортировать в ASCII-формат.', mtError, [mbOK], 0);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ExportToASCII;
end;
end.
|