home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / ifp1s157 / ifpinit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-25  |  5.8 KB  |  248 lines
  1. unit ifpinit;
  2.  
  3. interface
  4.  
  5. uses crt, graph, dos, ifpglobl, ifpcomon, IFPScrPt;
  6.  
  7. procedure init;
  8.  
  9. implementation
  10.  
  11. procedure init;
  12.   var
  13.     xint: integer;
  14.  
  15.   procedure rjustify(a : string);
  16.     begin
  17.     GotoXY(1 + lo(WindMax) - length(a), wherey);
  18.     x2:=WhereX;
  19.     Write(a)
  20.     end; {rjustify}
  21.  
  22.   procedure border(ch: char);
  23.     var
  24.       i : byte;
  25.  
  26.     begin
  27.     TextColor(LightCyan);
  28.     for i:=1 to twidth do
  29.       Write(ch);
  30.     TextColor(LightGray);
  31.     end; {border}
  32.  
  33.   procedure checkparams;
  34.     var
  35.       s: string;
  36.       parm: word;
  37.  
  38.     function deletejunk(s: string): string;
  39.       var
  40.         x: byte;
  41.  
  42.       begin
  43.       while (Length(s) > 0) and ((s[1] = ' ') or (s[1] = '-') or (s[1] = '/')) do
  44.         s:=Copy(s, 2, 255);
  45.       while (Length(s) > 0) and (s[Length(s)] = ' ') do
  46.         Dec(s[0]);
  47.       if Length(s) > 0 then
  48.         for x:=1 to Length(s) do
  49.           s[x]:=UpCase(s[x]);
  50.       deletejunk:=s;
  51.       end;
  52.  
  53.     begin {checkparams}
  54.     for parm:=1 to ParamCount do
  55.       begin
  56.       s:=deletejunk(ParamStr(parm));
  57.       if s = 'B' then
  58.         DirectVideo:=false;
  59.       if s = 'D' then
  60.         DirectVideo:=true;
  61.       if s = 'M' then
  62.         mono:=true;
  63.       if s = 'C' then
  64.         mono:=false;
  65.       if s = 'F' then
  66.         FifoOn:=true;
  67.       if s = 'NP' then
  68.         ReadPartitionTable:=false;
  69.       if s = 'NV' then
  70.         novgacheck:=true;
  71.       if Copy(s, 1, 2) = 'AP' then
  72.         begin
  73.         PrinterRec.Mode:='A';
  74.         if s[3] = ':' then
  75.           with PrinterRec do
  76.             begin
  77.             Destination:='F';
  78.             Filename:=deletejunk(Copy(s, 4, 255));
  79.             HiStrip:=true;
  80.             HeaderStr:='';
  81.             if tlength = 25 then
  82.               ScreensPerPage:=2
  83.             else
  84.               ScreensPerPage:=1;
  85.             ScreenCount:=0;
  86.             end
  87.         end;
  88.       if (s = '?') or (s = 'H') then
  89.         begin
  90.         Assign(output, '');
  91.         ReWrite(output);
  92.         Assign(input, '');
  93.         Reset(input);
  94.         Writeln('INFOPLUS ', qversion, '  Compiled: ', qdate);
  95.         Writeln;
  96.         Writeln('Syntax:');
  97.         Writeln('  INFOPLUS [B][D][M][C][F][NP][NV][AP[:filename]][H][?]');
  98.         Writeln('where:');
  99.         Writeln('  B  = Write to screen using BIOS (default under Desqview)');
  100.         Writeln('  D  = Write directly to screen memory (default)');
  101.         Writeln('  M  = Use monochrome colors (default under MODE BWxx)');
  102.         Writeln('  C  = Use normal colors (default)');
  103.         Writeln('  F  = Leave 16550 FIFO''s enabled');
  104.         Writeln('  NV = Do not perform VGA chipset detection');
  105.         Writeln('  NP = Do not read Partition Table');
  106.         Writeln('  AP = AutoPrint all screens, ask for setup');
  107.         Writeln('  AP:filename = AutoPrint to a file or device');
  108.         Writeln('  H or ? = This help screen');
  109.         Writeln;
  110.         Writeln('ex: INFOPLUS B M NV');
  111.         Writeln('      Run infoplus using BIOS, monochrome colors, no VGA check.');
  112.         Writeln;
  113.         Halt
  114.         end;
  115.       end;
  116.     end;
  117.  
  118.   begin {init}
  119.   mono:=false;
  120.   vidmode:=LastMode;
  121.   attrsave:=TextAttr;
  122.   CheckBreak:=False;
  123.   resetvideo:=false;
  124.   novgacheck:=false;
  125.   ReadPartitionTable:=true;
  126.   FifoOn:=false;
  127.   if (Lo(LastMode) = 0) or (Lo(LastMode) = 1) then
  128.     begin
  129.     TextMode(LastMode + 2);
  130.     resetvideo:=true
  131.     end;
  132.   with regs do
  133.     begin
  134.     AH:=$0F;
  135.     intr($10, regs);
  136.     twidth:=AH;
  137.     vidpg:=BH
  138.     end;
  139.   detectgraph(graphdriver, xint);
  140.   if (graphdriver = EGA) or (graphdriver = MCGA) or (graphdriver = VGA) then
  141.     with regs do
  142.       begin
  143.       AX:=$1130;
  144.       BH:=$00;
  145.       intr($10, regs);
  146.       tlength:=DL + 1;
  147.       CheckSnow:=False;
  148.       end
  149.   else
  150.     tlength:=25;
  151.   with regs do
  152.     begin
  153.     Intr($11, regs);
  154.     equip:=AX;
  155.     Intr($12, regs);
  156.     DOSmem:=longint(AX) shl 10;
  157.     AH:=$19;
  158.     MsDos(regs);
  159.     currdrv:=AL;
  160.     AH:=$34;
  161.     MsDos(regs);
  162.     DOScseg:=ES;
  163.     DOScofs:=BX
  164.     end;
  165.   SwapVectors;
  166.   for i:=$00 to $FF do
  167.     GetIntVec(i, intvec[i]);
  168.   SwapVectors;
  169. {
  170.   intvec[$00]:=saveint00;
  171.   intvec[$02]:=saveint02;
  172.   intvec[$1B]:=saveint1B;
  173.   intvec[$23]:=saveint23;
  174.   intvec[$24]:=saveint24;
  175.   intvec[$34]:=saveint34;
  176.   intvec[$35]:=saveint35;
  177.   intvec[$36]:=saveint36;
  178.   intvec[$37]:=saveint37;
  179.   intvec[$38]:=saveint38;
  180.   intvec[$39]:=saveint39;
  181.   intvec[$3A]:=saveint3A;
  182.   intvec[$3B]:=saveint3B;
  183.   intvec[$3C]:=saveint3C;
  184.   intvec[$3D]:=saveint3D;
  185.   intvec[$3E]:=saveint3E;
  186.   intvec[$3F]:=saveint3F;
  187.   intvec[$75]:=saveint75;
  188. }
  189.   with regs do
  190.     begin
  191.     AX:=$3700;
  192.     MsDos(regs);
  193.     switchar:=Chr(DL)
  194.     end;
  195.   dirsep:=['\'];
  196.   if switchar <> '/' then
  197.     dirsep:=dirsep + ['/'];
  198.   with regs do
  199.     begin
  200.     AH:=$52;
  201.     MsDos(regs);
  202.     devseg:=ES;
  203.     devofs:=BX
  204.     end;
  205.   lastdrv:=Mem[devseg:devofs + $0021];
  206.   if (Lo(LastMode) = 2) or (Lo(LastMode) = 7) then
  207.     mono:=true;
  208.   with regs do
  209.     begin
  210.     AX:=$2B01;
  211.     CX:=$4445; {DE}
  212.     DX:=$5351; {SQ}
  213.     MsDos(regs);
  214.     if AL <> $FF then
  215.       DirectVideo:=False;
  216.     end;
  217.   if ParamCount > 0 then
  218.     checkparams;
  219.   Textcolor(LightGreen);
  220.   TextBackground(Blue);
  221.   Clrscr;
  222.   Write('INFO+');
  223.   Textcolor(lightgray);
  224.   Write(' - Information on all computer functions');
  225.   rjustify(qversion);
  226.   Writeln;
  227.   border(#223);
  228.   GotoXY(1, tlength - 1);
  229.   border(#220);
  230.   Write('Page ');
  231.   x1:=wherex;
  232.   Textcolor(Lightgreen);
  233.   rjustify('F1 Enter PgUp PgDn Home End Esc Alt-P');
  234.   pg:=0;
  235.   endit:=false;
  236.   if osmajor >= 3 then
  237.     with regs do
  238.       begin
  239.       AX:=$3800;
  240.       DS:=seg(country);
  241.       DX:=ofs(country);
  242.       MsDos(regs);
  243.       ccode:=BX;
  244.       decimal:=Chr(country[9]);
  245.       end;
  246.   end; {init}
  247. end.
  248.