home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 04 / tricks / vierdemo.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-01-09  |  9.1 KB  |  304 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    VIERDEMO.PAS                        *)
  3. (*                vier Tools mit "Pfiff"                  *)
  4. (*      (c) 1991 Harald und Sabine Reiche & TOOLBOX       *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM Test;
  7.  
  8. USES Dos, Crt;
  9.  
  10. TYPE
  11.   strng = STRING [80];
  12.  
  13. VAR
  14.   sw, ws, bl, inv, s, z : INTEGER;
  15.   farbe, futast         : CHAR;
  16.   al                    : strng;
  17.  
  18. LABEL 1;
  19.  
  20.   PROCEDURE RD(VAR n : CHAR);
  21.   TYPE
  22.     str5  = STRING [ 5];
  23.     str16 = STRING [16];
  24.   VAR
  25.     Regs : Registers;
  26.     a    : WORD;
  27.  
  28.     FUNCTION SCAN : WORD;            (* Turbo 6.0:        *)
  29.     VAR                              (* ASM               *)
  30.       Regs : Registers;              (*   MOV AH,10h      *)
  31.     BEGIN                            (*   INT 16h         *)
  32.       WITH Regs DO BEGIN             (* END;              *)
  33.         ah := $10;                   (* -- Return-Wert    *)
  34.         Intr($16, Regs);             (* sowieso in AX!    *)
  35.         SCAN := ax;
  36.       END;
  37.     END;
  38.  
  39.   BEGIN
  40.     futast := ' ';
  41.     a      := SCAN;
  42.  
  43.     { für alle Eventualitäten sind hier Tastenkombi-       }
  44.     { nationen aufgeführt, die in der jetzigen Einstellung }
  45.     { von INP nicht genutzt werden.                        }
  46.     { Bei doppelten Ziffern gilt jeweils eine für den      }
  47.     { Siemens PC-D, die andere für Kompatible              }
  48.  
  49.     CASE a OF
  50.         283        : futast := Chr(27);
  51.        3592, 35920 : futast := ^H;
  52.       15104        : futast := ';';
  53.       15360        : futast := '<';
  54.       15616        : futast := '=';
  55.       15872        : futast := '>';
  56.       16128        : futast := '?';
  57.       16384        : futast := '@';
  58.       16640        : futast := 'A';
  59.       16896        : futast := 'B';
  60.       17152        : futast := 'C';
  61.       17408        : futast := 'D';
  62.       18176, 18400 : futast := 'G';
  63.       18432, 18656 : futast := 'H';
  64.       18688, 18912 : futast := 'I';
  65.       19200, 19424 : futast := 'K';
  66.       19712, 19936 : futast := 'M';
  67.       20224, 20448 : futast := 'O';
  68.       20480, 20704 : futast := 'P';
  69.       20736, 20960 : futast := 'Q';
  70.       20992, 21216 : futast := 'R';
  71.       21248, 21472 : futast := 'S';
  72.       21504        : futast := 'T';
  73.       21760        : futast := 'U';
  74.       22016        : futast := 'V';
  75.       22272        : futast := 'W';
  76.       22528        : futast := 'X';
  77.       22784        : futast := 'Y';
  78.       23040        : futast := 'Z';
  79.       23296        : futast := '[';
  80.       23552        : futast := '\';
  81.       23808        : futast := ']';
  82.       24064        : futast := '^';
  83.       24320        : futast := '-';
  84.       24576        : futast := '`';
  85.       24832        : futast := 'a';
  86.       25088        : futast := 'b';
  87.       25344        : futast := 'c';
  88.       25600        : futast := 'd';
  89.       25856        : futast := 'e';
  90.       26112        : futast := 'f';
  91.       26368        : futast := 'g';
  92.       26624        : futast := 'h';
  93.       26880        : futast := 'i';
  94.       27136        : futast := 'j';
  95.       27392        : futast := 'k';
  96.       27648        : futast := 'l';
  97.       27904        : futast := 'm';
  98.       28160        : futast := 'n';
  99.       28416        : futast := 'o';
  100.       28672        : futast := 'p';
  101.       28928        : futast := 'q';
  102.       29440, 29664 : futast := 's';
  103.       29696, 29920 : futast := 't';
  104.       29952, 30176 : futast := 'u';
  105.       30208, 30432 : futast := 'v';
  106.       30464, 30688 : futast := 'w';
  107.       33280        : futast := 'é';
  108.       33792,34016  : futast := 'ä';
  109.       34048,40960  : futast := 'á';
  110.       34304,41216  : futast := 'í';
  111.       35072        : futast := 'å';
  112.       35328        : futast := 'Å';
  113.       35584        : futast := 'é';
  114.       35840        : futast := 'É';
  115.       34560, 41472 : futast := 'ä';
  116.       34816, 41728 : futast := 'Ä';
  117.     END;
  118.     n := Chr(a);
  119.   END;
  120.  
  121.   PROCEDURE R0(VAR n : CHAR);
  122.   BEGIN
  123.     RD(n);
  124.     n := UpCase(n);
  125.     IF n = ^M THEN futast := ^M;
  126.   END;
  127.  
  128.   PROCEDURE RW(VAR n : CHAR);
  129.   BEGIN
  130.     RD(n);
  131.     n := UpCase(n);
  132.     IF n = ^M THEN futast := ^M;
  133.     Write(n);
  134.   END;
  135.  
  136.   PROCEDURE BAT(Str : strng; a : INTEGER);
  137.   BEGIN
  138.     TextAttr := a;
  139.     Write(Str);
  140.     TextAttr := ws;
  141.   END;
  142.  
  143.   FUNCTION COL(b : strng; c : INTEGER) : strng;
  144.   BEGIN
  145.     Write;
  146.     BAT(b, c);
  147.     COL := '';
  148.   END;
  149.  
  150.   PROCEDURE WO;
  151.   BEGIN
  152.     s := WhereX;
  153.     z := WhereY;
  154.   END;
  155.  
  156.   PROCEDURE INP(VAR cl : strng);
  157.   VAR
  158.     a1        : CHAR;
  159.     i1, x, te : BYTE;
  160.   BEGIN
  161.     futast := ' ';
  162.     cl := '';
  163.     i1 := 0;
  164.     WO;
  165.     te := s;
  166.     REPEAT
  167.       WO;
  168.       i1 := Length(cl);
  169.       RD(a1);
  170.       CASE futast OF
  171.         Chr(27),
  172.         ';', '<', '=', '>',
  173.         '?', '@', 'A', 'B',
  174.         'C', 'D', 'R', 'á',
  175.         'í', '^'            : Exit;
  176.         'K'                 : BEGIN
  177.                                 IF s > te THEN
  178.                                   Write(Chr(8));   { links }
  179.                               END;
  180.         'S'                 : BEGIN
  181.                                 WO;
  182.                                 x := WhereX;
  183.                                 Delete(cl, s-te+1, 1);
  184.                                 GotoXY(te, z);  { löschen? }
  185.                                 Write(cl, farbe);
  186.                                 GotoXY(x, z);
  187.                               END;
  188.         's', 'G'            : GotoXY(te, z);
  189.                           {ganz links - PC-D und Komaptible}
  190.         't', 'O'            : GotoXY(te+i1, z);
  191.                          {ganz rechts - PC-D und Kompatible}
  192.         'M'                 : BEGIN
  193.                                 GotoXY(s+1, z);
  194.                                 WO;
  195.                                 IF s > i1 THEN
  196.                                   cl := cl + ' ';
  197.                               END;
  198.       END;
  199.       IF futast = ' ' THEN
  200.         IF a1 <> Chr(8) THEN
  201.           IF a1 <> ^M THEN BEGIN
  202.             WO;
  203.             IF s >= i1+te THEN BEGIN
  204.               cl := cl+a1;
  205.               Write(a1);
  206.             END ELSE BEGIN  { anhängen }
  207.               WO;
  208.               IF a1 <> Chr(0) THEN BEGIN        { einfügen }
  209.                 x := WhereX;
  210.                 Insert(a1, cl, s-te+1);
  211.                 GotoXY(te, z);
  212.                 Write(cl);
  213.                 GotoXY(x+1, z);
  214.               END;
  215.             END;
  216.           END;
  217.       IF a1 = '_' THEN BEGIN
  218.         x := WhereX;
  219.         Insert(' ./. ', cl, Pos('_', cl));
  220.         Delete(cl, Pos('_', cl), 1);
  221.         GotoXY(te, z);
  222.         Write(cl);
  223.         GotoXY(x+4, z);
  224.       END;
  225.  
  226.       IF a1 = #$08 THEN BEGIN
  227.         WO;
  228.         IF i1 > 0 THEN
  229.           IF s > te THEN BEGIN                 { backspace }
  230.             Write(Chr(8));
  231.             x := WhereX;
  232.             Delete(cl, s-te, 1);
  233.             GotoXY(te, z);
  234.             Write(cl, farbe);
  235.             GotoXY(x, z);
  236.           END;
  237.       END;
  238.     UNTIL a1 = ^M;
  239.     IF cl = ^M THEN futast := ^M;
  240.   END;
  241.  
  242. BEGIN
  243.   ws :=  2;
  244.                { für dunklen Monochrombildschirm,          }
  245.                { Siemens PC-D -->102, Siemens PCD-2 -->112 }
  246.   sw       :=  10;
  247.   inv      := 112;
  248.   bl       := 130;
  249.   TextAttr := ws;
  250.   farbe    := ' ';
  251.                { Schreiben auf schraffierten Feldern --> ▒ }
  252.   REPEAT
  253.     ClrScr;
  254.     GotoXY(20, 2);
  255.     WriteLn(COL('Demonstrationsprogramm  COL + INP', 9),
  256.             ^J^J^M,
  257.             'Geben Sie nun bitte irgendeine Buchstabenkom-',
  258.             'bination ein (max. 80 Zeichen).'^J^M,
  259.             'Sobald Sie ', COL('CTL+F1', bl),
  260.             ' drücken, wird die Wiederholungsschleife ',
  261.             'beendet.'^J^M, COL('ESC', inv),
  262.             ' beendet das Programm.'^J^J^M,
  263.             'Wenn Sie eine Funtionstaste drücken (',
  264.             COL('F1-F12', sw),') wird die Eingabe von INP ',
  265.             'abgebro-'^J^M,
  266.             'chen und die Variable futast erhält den ',
  267.             'jeweiligen Wert. Im vorliegenden Demo-'^J^M,
  268.             'Programm wird die Funktionstaste mit den ',
  269.             'Möglichkeiten der Funktion COL ange-'^J^M,
  270.             'zeigt. Ohne gedrückte Funktionstaste hat ',
  271.             'die Variable futast den Wert " ",'^J^M,
  272.             'sonst den Wert der Funktionstaste.'^J);
  273.     INP(al);
  274.     IF futast = ' ' THEN BEGIN
  275.       Delay(2000);
  276.       GOTO 1;
  277.     END;
  278.     Write(^J^M'Es wurde ');
  279.     CASE futast OF
  280.       ';'     : BAT('F1',248);
  281.       '<'     : BAT('F2',255);
  282.       '='     : BAT('F3',129);
  283.       '>'     : BAT('F4',130);
  284.       '?'     : BAT('F5',137);
  285.       '@'     : BAT('F6',10);
  286.       'A'     : BAT('F7',112);
  287.       'B'     : BAT('F8',1);
  288.       'C'     : BAT('F9',9);
  289.       'D'     : BAT('F10',2);
  290.       'á'     : Write('F11');
  291.       'í'     : Write('F12');
  292.       '^'     : Write('CTL+F1');
  293.       Chr(27) : Halt;
  294.     END;
  295.     WriteLn(' gedrückt!'^J);
  296.     IF futast <> '^' THEN Delay(2000);
  297.   1:
  298.   UNTIL futast = '^';
  299.   Write('Die Wiederholungsschleife ist beendet!'^J^M);
  300.   Delay(4000);
  301. END.
  302. (* ------------------------------------------------------ *)
  303. (*                Ende von VIERDEMO.PAS                   *)
  304.