home *** CD-ROM | disk | FTP | other *** search
/ norge.freeshell.org (192.94.73.8) / 192.94.73.8.tar / 192.94.73.8 / pub / computers / cpm / alphatronic / TP_301A.ZIP / mc-mod03.inc < prev    next >
Text File  |  1985-01-01  |  5KB  |  195 lines
  1. {.PA}
  2. {*******************************************************************}
  3. {*  SOURCE CODE MODULE: MC-MOD03                                   *}
  4. {*  PURPOSE:            Read, Save and Print a spread sheet.       *}
  5. {*                      Display on-line manual.                    *}
  6. {*******************************************************************}
  7.  
  8. type
  9.   String3 = string[3];
  10.  
  11. var
  12.   FileName: string[14];
  13.   Line: string[100];
  14.  
  15. function Exist(FileN: AnyString): boolean;
  16. var F: file;
  17. begin
  18.    {$I-}
  19.    assign(F,FileN);
  20.    reset(F);
  21.    {$I+}
  22.    if IOResult<>0 then Exist:=false
  23.    else Exist:=true;
  24. end;
  25.  
  26.  
  27. procedure GetFileName(var Line: AnyString; FileType:String3);
  28. begin
  29.   Line:='';
  30.   repeat
  31.     Read(Kbd,Ch);
  32.     if Upcase(Ch) in ['A'..'Z',^M] then
  33.     begin
  34.       write(Upcase(Ch));
  35.       Line:=Line+Ch;
  36.     end;
  37.   until (Ch=^M) or (length(Line)=8);
  38.   if Ch=^M then Delete(Line,Length(Line),1);
  39.   if Line<>'' then Line:=Line+'.'+FileType;
  40. end;
  41.  
  42. {.CP20}
  43.  
  44. procedure Save;
  45. var I: screenIndex;
  46. J: integer;
  47. begin
  48.   HighVideo;
  49.   Msg('Save: Enter filename  ');
  50.   GetFileName(Filename,'MCS');
  51.   if FileName<>'' then
  52.   begin
  53.     Assign(MCFile,FileName);
  54.     Rewrite(MCFile);
  55.     for I:='A' to FXmax do
  56.     begin
  57.       for J:=1 to FYmax do
  58.       write(MCfile,Screen[I,J]);
  59.     end;
  60.     Grid;
  61.     Close(MCFile);
  62.     LowVideo;
  63.     GotoCell(FX,FY);
  64.   end;
  65. end;
  66.  
  67. {.CP30}
  68.  
  69. procedure Load;
  70. begin
  71.   HighVideo;
  72.   Msg('Load: Enter filename  ');
  73.   GetFileName(Filename,'MCS');
  74.   if (Filename<>'') then if (not exist(FileName)) then
  75.   repeat
  76.     Msg('File not Found: Enter another filename  ');
  77.     GetFileName(Filename,'MCS');
  78.   until exist(FileName) or (FileName='');
  79.   if FileName<>'' then
  80.   begin
  81.     ClrScr;
  82.     Msg('Please Wait. Loading definition...');
  83.     Assign(MCFile,FileName);
  84.     Reset(MCFile);
  85.     for FX:='A' to FXmax do
  86.      for FY:=1 to FYmax do read(MCFile,Screen[FX,FY]);
  87.     FX:='A'; FY:=1;
  88.     LowVideo;
  89.     UpDate;
  90.   end;
  91.   GotoCell(FX,FY);
  92. end;
  93.  
  94.  
  95. {.PA}
  96.  
  97. procedure Print;
  98. var
  99.   I:      screenIndex;
  100.   J,Count,
  101.   LeftMargin: Integer;
  102.   P:          string[20];
  103.   MCFile:     Text;
  104. begin
  105.   HighVideo;
  106.   Msg('Print: Enter filename "P" for Printer> ');
  107.   GetFileName(Filename,'LST');
  108.   Msg('Left margin > ');  Read(LeftMargin);
  109.   if FileName='P.LST' then FileName:='Printer';
  110.   Msg('Printing to: ' + FileName + '....');
  111.   Assign(MCFile,FileName);
  112.   Rewrite(MCFile);
  113.   For Count:=1 to 5 do Writeln(MCFile);
  114.   for J:=1 to FYmax do
  115.   begin
  116.     Line:='';
  117.     for I:='A' to FXmax do
  118.     begin
  119.       with Screen[I,J] do
  120.       begin
  121.         while (Length(Line)<XPOS[I]-4) do Line:=Line+' ';
  122.         if (Constant in CellStatus) or (Formula in CellStatus) then
  123.         begin
  124.           if not (Locked in CellStatus) then
  125.           begin
  126.             if DEC>0 then Str(Value:FW:DEC,P) else Str(Value:FW,P);
  127.             Line:=Line+P;
  128.           end;
  129.         end else Line:=Line+Contents;
  130.       end; { With }
  131.     end; { One line }
  132.     For Count:=1 to LeftMargin do Write(MCFile,' ');
  133.     writeln(MCFile,Line);
  134.   end; { End Column }
  135.   Grid;
  136.   Close(MCFile);
  137.   LowVideo;
  138.   GotoCell(FX,FY);
  139. end;
  140.  
  141. {.PA}
  142.  
  143. procedure Help;
  144. var
  145.   H: text;
  146.   HelpFileName: string[14];
  147.   Line: string[80];
  148.   I,J: integer;
  149.   Bold: boolean;
  150.  
  151. begin
  152.   if Exist('MC.HLP') then
  153.   begin
  154.     Assign(H,'MC.HLP');
  155.     Reset(H);
  156.     while not Eof(H) do
  157.     begin
  158.       Readln(H,Line);
  159.       ClrScr; I:=1; Bold:=false; LowVideo;
  160.       repeat
  161.         For J:=1 to Length(Line) do
  162.         begin
  163.           if Line[J]=^B then
  164.           begin
  165.             Bold:=not Bold;
  166.             if Bold then HighVideo else LowVideo;
  167.           end else write(Line[J]);
  168.         end;
  169.         Writeln;
  170.         I:=I+1;
  171.         Readln(H,Line);
  172.       until Eof(H) or (I>23) or (Copy(Line,1,3)='.PA');
  173.       GotoXY(26,24); HighVideo;
  174.       write('<<< Please press any key to continue >>>');
  175.       LowVideo;
  176.       read(Kbd,Ch);
  177.     end;
  178.     GotoXY(20,24); HighVideo;
  179.     write('<<< Please press <RETURN> to start MicroCalc >>>');
  180.     LowVideo;
  181.     Readln(Ch);
  182.     UpDate;
  183.   end else { Help file did not exist }
  184.   begin
  185.     Msg('To get help the file MC.HLP must be on your disk. Press <RETURN>');
  186.     repeat Read(kbd,Ch) until Ch=^M;
  187.     GotoCell(FX,FY);
  188.   end;
  189. end;
  190.  
  191. toCell(FX,FY);
  192.   end;
  193. end;
  194.  
  195.