home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / tema / 602propc / disk12 / data.12 / WINTEXT / MAKRA / SOURCES / EXPORT.TXT < prev    next >
Text File  |  1995-10-16  |  2KB  |  73 lines
  1. Program Export_Ascii;
  2. // export dokumentu do ASCII
  3.  
  4. type Str60  = string[60];
  5. type Str130 = string[130];
  6. type Str230 = string[230];
  7.  
  8. var
  9.   Fname  : Str130;
  10.   ErrMsg : Str230;
  11.   ff : file;
  12.  
  13. function out(var f : file; var buf : str60; eoln : boolean) : boolean;
  14. begin
  15.   if eoln then out := writeln(f, buf)
  16.           else out := write(f, buf)
  17. end;
  18.  
  19. function Sendtext(var f : file) : boolean;
  20. var
  21.   cur, tmp, lEnd : integer;
  22.   line_end, ok : boolean;
  23.   S : str60;
  24. begin
  25.   CaretHome;
  26.   ok:=true;
  27.   repeat                   { text of each line }
  28.     RightOfLine; 
  29.     lEnd:=GetCaretPos;
  30.     LeftOfLine;
  31.     tmp:=GetCaretPos;
  32.     repeat                 { text of this line }
  33.       cur:=GetCaretPos;
  34.       line_end:= cur = lEnd;
  35.       if line_end or (cur - tmp >= 50) 
  36.       then begin
  37.              S:=GetText(tmp, cur);
  38.              tmp:=cur;
  39.              ok:=out(f, S, line_end);
  40.            end
  41.       else CharRight;
  42.     until line_end or not ok;
  43.   until not ok or not LineDown;
  44.   Sendtext:=ok;
  45. end;
  46.  
  47. begin
  48.   if Input_box_msg(
  49.        "Export do ASCII", 
  50.        "soubor, do n∞ho₧ chcete zapisovat :",
  51.        Fname,
  52.        130) 
  53.   then 
  54.     begin
  55.       Strtrim(Fname);
  56.       if rewrite(ff, Fname)
  57.       then begin
  58.              if Sendtext(ff) 
  59.                then begin
  60.                        close(ff);
  61.                        Info_box("", "Export proveden")
  62.                     end
  63.                else Info_box("Chyba", 
  64.                       "Chyba p°i zßpisu souboru");
  65.             end
  66.       else begin
  67.              ErrMsg := "Soubor """ + Fname;
  68.              ErrMsg := ErrMsg + """ nelze otev°φt !";
  69.              Info_box("Chyba", ErrMsg);
  70.            end;
  71.     end
  72. end.
  73.