home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / utils / sv.zip / SV.PAS < prev   
Pascal/Delphi Source File  |  1989-11-20  |  4KB  |  128 lines
  1. PROGRAM SetVideo;  { Version 1.10 }
  2.  
  3.  
  4. {
  5.   ┌──────────────────────────────────────────────────────┬──────────────────┐
  6.   │  Pinnacle  Software's  Video  Setter                 │      SV.PAS      │
  7.   ├──────────────────────────────────────────────────────┴──────────────────┤
  8.   │  C O P Y R I G H T  (C)  1989  BY   P I N N A C L E    S O F T W A R E  │
  9.   │  P.O. Box 386,  Town of Mount Royal, Montreal, Quebec, Canada  H3P 3C6  │
  10.   ├─────────────────────────────────────────────────────────────────────────┤
  11.   │ This Pinnacle Software product may not be resold.  It may be given away │
  12.   │ or a small distribution fee (not to exceed $10)  may be charged.  Fail- │
  13.   │ ure to comply with these terms may cause warts.                         │
  14.   └─────────────────────────────────────────────────────────────────────────┘
  15. }
  16.  
  17. {
  18.   Change Log
  19.   ──────────
  20.  
  21.   1.10  Added OK parameter to skip "Enter if okay" prompt.
  22.         Cosmetic changes.
  23.  
  24. }
  25.  
  26.  
  27.  
  28. USES CRT;
  29.  
  30. CONST
  31.   Cop : STRING[80] =
  32.     '         By Pinnacle Software, PO Box 163 Cartierville, Quebec, Canada H4K 2J5';
  33.  
  34. VAR
  35.   Choice    : CHAR;
  36.     OrigMode  : INTEGER;
  37.     Parameter : STRING[80];
  38.  
  39. FUNCTION Upper(msg : STRING) : STRING;
  40. VAR
  41.   cntr : BYTE;
  42. BEGIN
  43.   IF LENGTH(msg) <> 0 THEN FOR cntr := 1 TO LENGTH(msg) DO
  44.   msg[cntr] := UPCASE(msg[cntr]);
  45.   Upper := msg;
  46. END;
  47.  
  48. BEGIN
  49.   IF (ParamStr(1) = '?')
  50.   OR (Upper(ParamStr(1)) = 'HELP')
  51.   OR (Upper(ParamStr(1)) = '/H')
  52.   THEN
  53.   BEGIN
  54.     WRITELN;
  55.     WRITELN('For menu-driven operation, enter:  SV');
  56.     WRITELN;
  57.        WRITELN('This program can also be called with the video option on the command line.');
  58.       WRITELN;
  59.       WRITELN('For example:  SV E');
  60.     WRITELN;
  61.        WRITELN('To skip the verification step, add "OK" to the command line.');
  62.       WRITELN;
  63.       WRITELN('For example:  SV E OK');
  64.         WRITELN;
  65.     HALT;
  66.     END;
  67.   IF LENGTH(PARAMSTR(1)) = 0 THEN
  68.     BEGIN
  69.     CLRSCR;
  70.         WRITELN('┌─────────────────────────────────┐');
  71.       WRITELN('│ PRESS A KEY TO SELECT AN EFFECT │');
  72.     WRITELN('└─────────────────────────────────┘');
  73.     WRITELN;
  74.     WRITELN('KEY   COLS ROWS  COLOR   VIDEO CARD');
  75.     WRITELN('═══   ════ ════  ═════   ══════════');
  76.         WRITELN(' X     40 x 25   B & W   CGA  color');
  77.         WRITELN(' Y     40 x 25   Color   CGA  color');
  78.         WRITELN(' B     80 x 25   B & W   CGA  color');
  79.         WRITELN(' K     80 x 25   Color   CGA  color');
  80.         WRITELN(' M     80 x 25   B & W   Monochrome');
  81.         WRITELN(' E     80 x 43   Color   EGA  color');
  82.         WRITELN(' V     80 x 50   Color   VGA  color');
  83.     WRITELN;
  84.     WRITELN('┌─────────────────────────────────┐');
  85.     WRITELN('│   C = Clear Screen   Q = Quit   │');
  86.         WRITELN('└─────────────────────────────────┘');
  87.     WRITELN;
  88.         WRITE('Your choice:  ');
  89.         REPEAT
  90.             Choice := UPCASE(READKEY);
  91.         UNTIL POS(Choice,'XYBKMEVCQ') > 0;
  92.         WRITELN(Choice);
  93.     END
  94.     ELSE
  95.     BEGIN
  96.         Parameter := PARAMSTR(1);
  97.         Choice := UPCASE(Parameter[1]);
  98.     END;
  99.     OrigMode := LastMode;
  100.     CASE Choice OF
  101.   'X' : TextMode(BW40);
  102.     'Y' : TextMode(CO40);
  103.   'B' : TextMode(BW80);
  104.     'K' : TextMode(CO80);
  105.   'M' : TextMode(MONO);
  106.     'E' : TextMode(CO80 + Font8x8);
  107.     'V' : TextMode(CO80 + Font8x8);
  108.     'Q' : BEGIN WRITELN; WRITELN('Nothing done.'); END;
  109.     'C' : CLRSCR;
  110.     ELSE
  111.         WRITELN;
  112.         WRITELN(Choice,' is not a valid option.');
  113.         WRITELN;
  114.         WRITELN('Nothing done.');
  115.     END;
  116.     IF  (POS(Choice,'CQ') = 0)
  117.   AND (Upper(ParamStr(2)) <> 'OK')
  118.   THEN
  119.     BEGIN
  120.       CLRSCR;
  121.       WRITELN('Press  ENTER  if everything looks okay.');
  122.       WRITELN;
  123.       WRITE  ('Press another key to restore last mode.');
  124.       Choice := READKEY;
  125.       WRITELN;
  126.       IF Choice <> #13 THEN TextMode(OrigMode);
  127.     END;
  128. END.