Mega Code Archive
An Iterative ASCII Export
<![CDATA[
Title: An Iterative ASCII-Export
Question: All in one procedure, Delimiter- and SaveFile Dialog, no parameters cause of speed
Show the export data in a memo with dynamic linenumbers
Answer:
The procedure exports records from a Table
to a specified ASCIIFile text file. Fields are
separated by provided Delimiter Dialog character.
All the forms are created by dynamic and the owner is the application.
This means that when the application is destroyed, all the components are also destroyed.
procedure ExportToASCII_Iterative;
var
i: Integer;
dlg: TSaveDialog;
ASCIIFileName: String[150];
ASCIIFile: TextFile;
Delimiter: String[20];
Res: Boolean;
begin
Application.CreateForm(TDelimitFrm, DelimitFrm);
with grunddatFrmModule.tblGrund do begin // the table to be exported!
DelimitFrm:=TDelimitFrm.create(Application);
DelimitFrm.ShowModal;
if (DelimitFrm.OKBtn.ModalResult = idOK) then
Delimiter := DelimitFrm.Select.Text;
if Delimiter = '^M^J' then Delimiter := ^M^J;
if Active then
if (FieldCount 0) and (RecordCount 0) then begin
dlg := TSaveDialog.Create(Owner);
dlg.Filter := 'ASCII-Dateien (*.asc)|*.asc';
dlg.Options := Dlg.Options+[ofPathMustExist,
ofOverwritePrompt, ofHideReadOnly];
dlg.Title := 'Data to ASCII export';
try
Res := dlg.Execute;
if Res then
ASCIIFileName := Dlg.FileName;
finally
dlg.Free;
end;
if Res then begin
AssignFile(ASCIIFile, ASCIIFileName);
Rewrite(ASCIIFile);
First;
begin
for I := 0 to FieldCount-1 do begin
Write(ASCIIFile, Fields[I].FieldName);
if I FieldCount-1 then
Write(ASCIIFile, Delimiter);
end;
Write(ASCIIFile, Delimiter);
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, Delimiter);
end;
Next;
if not EOF then
Write(ASCIIFile, Delimiter);
end;
CloseFile(ASCIIFile);
if IOResult 0 then
MessageDlg('Fault to ASCII-Write', mtError, [mbOK], 0);
end; {field count}
end; {Res check}
end else {FieldCount else}
MessageDlg('No Data to be exported',mtInformation, [mbOK], 0)
else {Active else}
MessageDlg('Table has to be open, mtError, [mbOK], 0);
end;
end;
(* ================================================================= *)
(* Ende von ASCIIEXP *)
afterwards you can put the data in a memo and switch a linenumber off and on:
procedure TForm1.linetonumber(met: boolean);
var i: integer;
mypos: integer;
mystr: string[250];
begin
if met then
for i:= 1 to memo1.Lines.Count - 1 do begin
memo1.Lines.Strings[i]:= inttostr(i)+' '+memo1.Lines.Strings[i];
memo1.readonly:= true;
memo1.Font.Style:= [fsBold];
end
// check if linenumber was on before
else if pos(inttostr(1), memo1.lines.Strings[1]) 0 then begin
for i:= 1 to memo1.Lines.Count - 1 do begin
mypos:= pos(inttostr(i), memo1.lines.Strings[i]);
if pos(inttostr(i), memo1.lines.Strings[i]) 0 then begin
mystr:= memo1.Lines.Strings[i];
delete(mystr, mypos, (length(inttostr(i))+1));
memo1.Lines.Strings[i]:= mystr;
end;
end;
memo1.readonly:= false;
memo1.Font.Style:=[];
end;
end;
]]>