DataMuseum.dk

top - metrics - download

    Length: 4480 (0x1180)
    Types: TextFile
    Names: »MC-MOD03.INC«

└─⟦d482c3728⟧ Bits:30005987 Turbo Pascal v2.00A (Jet80)
    └─⟦this⟧ »MC-MOD03.INC« 

TextFile

æ.PAå
æ*******************************************************************å
æ*  SOURCE CODE MODULE: MC-MOD03                                   *å
æ*  PURPOSE:            Read, Save and Print a spread sheet.       *å
æ*                      Display on-line manual.                    *å
æ*******************************************************************å

type
  String3 = stringÆ3Å;

var
  FileName: stringÆ14Å;
  Line: stringÆ100Å;

function Exist(FileN: AnyString): boolean;
var F: file;
begin
   æ$I-å
   assign(F,FileN);
   reset(F);
   æ$I+å
   if IOResult<>0 then Exist:=false
   else Exist:=true;
end;


procedure GetFileName(var Line: AnyString; FileType:String3);
begin
  Line:='';
  repeat
    Read(Kbd,Ch);
    if Upcase(Ch) in Æ'A'..'Z',^MÅ then
    begin
      write(Upcase(Ch));
      Line:=Line+Ch;
    end;
  until (Ch=^M) or (length(Line)=8);
  if Ch=^M then Delete(Line,Length(Line),1);
  if Line<>'' then Line:=Line+'.'+FileType;
end;

æ.CP20å

procedure Save;
var I: screenIndex;
J: integer;
begin
  HighVideo;
  Msg('Save: Enter filename  ');
  GetFileName(Filename,'MCS');
  if FileName<>'' then
  begin
    Assign(MCFile,FileName);
    Rewrite(MCFile);
    for I:='A' to FXmax do
    begin
      for J:=1 to FYmax do
      write(MCfile,ScreenÆI,JÅ);
    end;
    Grid;
    Close(MCFile);
    LowVideo;
    GotoCell(FX,FY);
  end;
end;

æ.CP30å

procedure Load;
begin
  HighVideo;
  Msg('Load: Enter filename  ');
  GetFileName(Filename,'MCS');
  if (Filename<>'') then if (not exist(FileName)) then
  repeat
    Msg('File not Found: Enter another filename  ');
    GetFileName(Filename,'MCS');
  until exist(FileName) or (FileName='');
  if FileName<>'' then
  begin
    ClrScr;
    Msg('Please Wait. Loading definition...');
    Assign(MCFile,FileName);
    Reset(MCFile);
    for FX:='A' to FXmax do
     for FY:=1 to FYmax do read(MCFile,ScreenÆFX,FYÅ);
    FX:='A'; FY:=1;
    LowVideo;
    UpDate;
  end;
  GotoCell(FX,FY);
end;


æ.PAå

procedure Print;
var
  I:      screenIndex;
  J,Count,
  LeftMargin: Integer;
  P:          stringÆ20Å;
  MCFile:     Text;
begin
  HighVideo;
  Msg('Print: Enter filename "P" for Printer> ');
  GetFileName(Filename,'LST');
  Msg('Left margin > ');  Read(LeftMargin);
  if FileName='P.LST' then FileName:='Printer';
  Msg('Printing to: ' + FileName + '....');
  Assign(MCFile,FileName);
  Rewrite(MCFile);
  For Count:=1 to 5 do Writeln(MCFile);
  for J:=1 to FYmax do
  begin
    Line:='';
    for I:='A' to FXmax do
    begin
      with ScreenÆI,JÅ do
      begin
        while (Length(Line)<XPOSÆIÅ-4) do Line:=Line+' ';
        if (Constant in CellStatus) or (Formula in CellStatus) then
        begin
          if not (Locked in CellStatus) then
          begin
            if DEC>0 then Str(Value:FW:DEC,P) else Str(Value:FW,P);
            Line:=Line+P;
          end;
        end else Line:=Line+Contents;
      end; æ With å
    end; æ One line å
    For Count:=1 to LeftMargin do Write(MCFile,' ');
    writeln(MCFile,Line);
  end; æ End Column å
  Grid;
  Close(MCFile);
  LowVideo;
  GotoCell(FX,FY);
end;

æ.PAå

procedure Help;
var
  H: text;
  HelpFileName: stringÆ14Å;
  Line: stringÆ80Å;
  I,J: integer;
  Bold: boolean;

begin
  if Exist('MC.HLP') then
  begin
    Assign(H,'MC.HLP');
    Reset(H);
    while not Eof(H) do
    begin
      Readln(H,Line);
      ClrScr; I:=1; Bold:=false; LowVideo;
      repeat
        For J:=1 to Length(Line) do
        begin
          if LineÆJÅ=^B then
          begin
            Bold:=not Bold;
            if Bold then HighVideo else LowVideo;
          end else write(LineÆJÅ);
        end;
        Writeln;
        I:=I+1;
        Readln(H,Line);
      until Eof(H) or (I>23) or (Copy(Line,1,3)='.PA');
      GotoXY(26,24); HighVideo;
      write('<<< Please press any key to continue >>>');
      LowVideo;
      read(Kbd,Ch);
    end;
    GotoXY(20,24); HighVideo;
    write('<<< Please press <RETURN> to start MicroCalc >>>');
    LowVideo;
    Readln(Ch);
    UpDate;
  end else æ Help file did not exist å
  begin
    Msg('To get help the file MC.HLP must be on your disk. Press <RETURN>');
    repeat Read(kbd,Ch) until Ch=^M;
    GotoCell(FX,FY);
  end;
end;

«eof»