home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 1997 October
/
Chip_1997-10_cd.bin
/
tema
/
sw602
/
wintext
/
disk1
/
data.1
/
EXPORT.TXT
< prev
next >
Wrap
Text File
|
1995-10-16
|
2KB
|
73 lines
Program Export_Ascii;
// export dokumentu do ASCII
type Str60 = string[60];
type Str130 = string[130];
type Str230 = string[230];
var
Fname : Str130;
ErrMsg : Str230;
ff : file;
function out(var f : file; var buf : str60; eoln : boolean) : boolean;
begin
if eoln then out := writeln(f, buf)
else out := write(f, buf)
end;
function Sendtext(var f : file) : boolean;
var
cur, tmp, lEnd : integer;
line_end, ok : boolean;
S : str60;
begin
CaretHome;
ok:=true;
repeat { text of each line }
RightOfLine;
lEnd:=GetCaretPos;
LeftOfLine;
tmp:=GetCaretPos;
repeat { text of this line }
cur:=GetCaretPos;
line_end:= cur = lEnd;
if line_end or (cur - tmp >= 50)
then begin
S:=GetText(tmp, cur);
tmp:=cur;
ok:=out(f, S, line_end);
end
else CharRight;
until line_end or not ok;
until not ok or not LineDown;
Sendtext:=ok;
end;
begin
if Input_box_msg(
"Export do ASCII",
"soubor, do n∞ho₧ chcete zapisovat :",
Fname,
130)
then
begin
Strtrim(Fname);
if rewrite(ff, Fname)
then begin
if Sendtext(ff)
then begin
close(ff);
Info_box("", "Export proveden")
end
else Info_box("Chyba",
"Chyba p°i zßpisu souboru");
end
else begin
ErrMsg := "Soubor """ + Fname;
ErrMsg := ErrMsg + """ nelze otev°φt !";
Info_box("Chyba", ErrMsg);
end;
end
end.