home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 03 / bonus / box.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-06  |  26.8 KB  |  780 lines
  1. (* ------------------------------------------------------ *)
  2. (*                        BOX.PAS                         *)
  3. (*       Screen-Generator für Turbo Pascal ab 5.x         *)
  4. (*         (c) 1991 Achim Bergmeister & TOOLBOX           *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM Box;
  7.  
  8. USES Crt,BoxErg;
  9.  
  10. CONST lo1 = #218; ro1 = #191; lu1 = #192; ru1 = #217;
  11.       wa1 = #196; se1 = #179; om1 = #194; um1 = #193;
  12.       lm1 = #195; rm1 = #180; mi1 = #197; nx  = ' ';
  13.  
  14.       lo2 = #201; ro2 = #187; lu2 = #200; ru2 = #188;
  15.       wa2 = #205; se2 = #186; om2 = #203; um2 = #202;
  16.       lm2 = #204; rm2 = #185; mi2 = #206;
  17.  
  18. TYPE Richtung = (keine,rauf,runter,links,rechts);
  19.      Striche  = (einfach,doppelt,definiert);
  20.  
  21. VAR  aktiv,Ende,Wahl,Anzeige,Nochmal : BOOLEAN;
  22.      x, y, i, j, Code : BYTE;
  23.      ch, c, Key       : CHAR;
  24.      SaveLine         : ARRAY [1..3] OF s80;
  25.      Dir   : Richtung;
  26.      Sorte : Striche;
  27.      Datei : TEXT;
  28.      Name  : s80;
  29.      Taste : INTEGER;
  30.  
  31. PROCEDURE StatusZeile_An;
  32. BEGIN
  33.   FOR j :=1 TO 3 DO
  34.   FOR i := 1 TO 80 DO SaveLine[j,i] := Screen[22+j,i].ch;
  35.   Normal; Rahmen (1,23,80,25,2);
  36.   WrtXY (3,24,'F1-Hilfe   Alt+F1-Anzeige ein/aus      '+
  37.                'Zeile:     Spalte:     Zeichnen:');
  38.   Invers;
  39. END;
  40.  
  41. PROCEDURE StatusZeile_Aus;
  42. BEGIN
  43.   FOR j := 1 TO 3 DO
  44.    FOR i := 1 TO 80 DO WrtXY (i,22+j,SaveLine[j,i]);
  45. END;
  46.  
  47. PROCEDURE Speichern;
  48. LABEL Schluss;
  49. VAR Spalte,Zeile,Max: BYTE; ch: CHAR;
  50. BEGIN
  51.   SMem := Screen; Normal; Rahmen (10,5,70,9,2);
  52.   WrtXY (12,7,'Dateiname:'); GotoXY (23,7);
  53.   ReadLn (Name); Invers;  Screen := SMem;
  54.   IF Name <> '' THEN BEGIN
  55.     IF Pos ('.',Name) = 0 THEN Name := Name + '.box';
  56.     Assign (Datei,Name); {$I-} Reset (Datei); {$I+}
  57.     IF IOResult = 0 THEN BEGIN
  58.       SMem := Screen; Normal; Rahmen (10,5,70,9,2);
  59.       WrtXY (12,7,'Datei existiert schon, überschreiben (J/N) ?');
  60.       REPEAT ch := UpCase (ReadKey); UNTIL ch IN ['J','N'];
  61.       Screen := SMem; Invers;
  62.       IF ch = 'N' THEN GOTO Schluss;
  63.     END;
  64.     {$I-} ReWrite (Datei); {$I+}
  65.     IF IOResult <> 0 THEN BEGIN
  66.       SMem := Screen; Normal; Rahmen (10,5,70,9,2);
  67.       WrtXY (15,7,'Fehler beim Speichern, bitte <ESC>..');
  68.       REPEAT ch := UpCase (ReadKey); UNTIL ch = #27;
  69.       Screen := SMem; Invers;
  70.     END
  71.     ELSE BEGIN
  72.       IF Anzeige THEN StatusZeile_Aus;
  73.       FOR Zeile := 1 TO 25 DO BEGIN
  74.         Spalte := 81;
  75.         REPEAT Dec(Spalte);
  76.         UNTIL (Screen[Zeile,Spalte].ch <> nx) OR
  77.               (Spalte = 0);
  78.         Max := Spalte;
  79.         IF Max > 0 THEN
  80.           FOR Spalte := 1 TO Max DO
  81.             Write (Datei,Screen[Zeile,Spalte].ch);
  82.         WriteLn (Datei);
  83.       END;
  84.       Close (Datei); IF Anzeige THEN StatusZeile_An;
  85.     END;
  86.   END;  Schluss:
  87. END;
  88.  
  89. PROCEDURE Laden;
  90. VAR Zeile: s80; i,z: BYTE; WahlDat: s12;
  91. BEGIN
  92.   WahlDat := ''; Normal;
  93.   HoleDatei (5,3,15,WahlDat); Invers;
  94.   IF WahlDat <> '' THEN BEGIN
  95.     Assign (Datei,WahlDat); {$I-} Reset (Datei); {$I+}
  96.     IF IOResult <> 0 THEN BEGIN
  97.       SMem := Screen; Normal; Rahmen (20,5,60,9,2);
  98.       WrtXY (24,7,'Dateilesefehler !  Bitte <ESC> ...');
  99.       REPEAT ch := UpCase (ReadKey); UNTIL ch = #27;
  100.       Screen := SMem; Invers;
  101.     END
  102.     ELSE BEGIN
  103.       IF Anzeige THEN StatusZeile_Aus;  z := 1;
  104.       WHILE NOT EoF(Datei) DO BEGIN
  105.         ReadLn (Datei,Zeile);
  106.         FOR i := 1 TO Length(Zeile) DO
  107.           Screen[z,i].ch := Zeile[i];
  108.         Inc(z);
  109.       END;
  110.       Close (Datei); IF Anzeige THEN StatusZeile_An;
  111.     END;
  112.   END;
  113.   IF NOT aktiv THEN CursorDick;
  114. END;
  115.  
  116. PROCEDURE BildschirmLoeschen;
  117. VAR i: BYTE; ch: CHAR;
  118. BEGIN
  119.   SMem := Screen; Normal; Rahmen (20,3,60,5,2);
  120.   WrtXY (25,4,'Erfasstes Bild löschen (J/N) ?');
  121.   REPEAT ch := UpCase(ReadKey); UNTIL ch IN ['J','N'];
  122.   Screen := SMem; Invers;
  123.   IF ch = 'J' THEN BEGIN
  124.     IF Anzeige THEN StatusZeile_Aus;  ClrScr;
  125.     x:=1; y:=1; aktiv := FALSE; CursorDick;
  126.     IF Anzeige THEN StatusZeile_An;
  127.   END;
  128. END;
  129.  
  130. PROCEDURE ZeileLoeschen (z: BYTE; An: BOOLEAN);
  131. VAR Zeile,Spalte: BYTE;
  132. BEGIN
  133.   IF An THEN StatusZeile_Aus;
  134.   FOR Zeile := z TO 24 DO
  135.    FOR Spalte := 1 TO 80 DO
  136.     Screen[Zeile,Spalte].ch := Screen[Zeile+1,Spalte].ch;
  137.   FOR Spalte := 1 TO 80 DO Screen[25,Spalte].ch := nx;
  138.   IF An THEN StatusZeile_An;
  139. END;
  140.  
  141. PROCEDURE SpalteLoeschen (s: BYTE; An: BOOLEAN);
  142. VAR Zeile,Spalte: BYTE;
  143. BEGIN
  144.   IF An THEN StatusZeile_Aus;
  145.   FOR Zeile := 1 TO 25 DO
  146.    FOR Spalte := s TO 79 DO
  147.     Screen[Zeile,Spalte].ch := Screen[Zeile,Spalte+1].ch;
  148.   FOR Zeile := 1 TO 25 DO Screen[Zeile,80].ch := nx;
  149.   IF An THEN StatusZeile_An;
  150. END;
  151.  
  152. PROCEDURE ZeileEinfuegen (z: BYTE; An: BOOLEAN);
  153. VAR Zeile,Spalte: BYTE;
  154. BEGIN
  155.   IF An THEN StatusZeile_Aus;
  156.   FOR Zeile := 25 DOWNTO z+1 DO
  157.    FOR Spalte := 1 TO 80 DO
  158.     Screen[Zeile,Spalte].ch := Screen[Zeile-1,Spalte].ch;
  159.   FOR Spalte := 1 TO 80 DO Screen[z,Spalte].ch := nx;
  160.   IF An THEN StatusZeile_An;
  161. END;
  162.  
  163. PROCEDURE SpalteEinfuegen (s: BYTE; An: BOOLEAN);
  164. VAR Zeile,Spalte: BYTE;
  165. BEGIN
  166.   IF An THEN StatusZeile_Aus;
  167.   FOR Zeile := 1 TO 25 DO
  168.    FOR Spalte := 80 DOWNTO s+1 DO
  169.     Screen[Zeile,Spalte].ch := Screen[Zeile,Spalte-1].ch;
  170.   FOR Zeile := 1 TO 25 DO Screen[Zeile,s].ch := nx;
  171.   IF An THEN StatusZeile_An;
  172. END;
  173.  
  174. PROCEDURE Hilfe;
  175. VAR
  176.   f : TEXT;  s : s80;
  177. BEGIN
  178.   SMem := Screen;
  179.   Assign(f, 'HILFE.BOX');
  180.   Reset(f);
  181.   GotoXY(1,1);
  182.   WHILE NOT EoF(f) DO BEGIN
  183.     ReadLn(f, s);  WriteLn(s);
  184.   END;
  185.   REPEAT ch := ReadKey UNTIL ch = #27;
  186.   Screen := SMem;
  187. END;
  188.  
  189. PROCEDURE PfeilTasten (Pfeil: BYTE; Art: Striche);
  190. BEGIN
  191.  WITH Screen[y,x] DO
  192.  BEGIN
  193.   IF Art = einfach THEN
  194.   BEGIN
  195.    CASE Pfeil OF
  196.     8 : BEGIN
  197.          CASE Dir OF
  198.           keine : ch := se1;
  199.           runter: BEGIN
  200.                    CASE ch OF
  201.                     lo1,lm1        : ch := lm1;
  202.                     lo2,lm2        : ch := '╞';
  203.                     ro1,rm1        : ch := rm1;
  204.                     ro2,rm2        : ch := '╡';
  205.                     lu1,lu2        : ch := lu1;
  206.                     ru2            : ch := '╛';
  207.                     ru1            : ch := ru1;
  208.                     wa2,um2        : ch := '╧';
  209.                     um1,wa1        : ch := um1;
  210.                     om1,mi1,om2,mi2: ch := mi1;
  211.                     ELSE ch := se1;
  212.                    END;
  213.                   END;
  214.           rauf  : BEGIN
  215.                    CASE ch OF
  216.                     lo1,lu1,lm1     : ch := lm1;
  217.                     lo2,lu2,lm2     : ch := '╞';
  218.                     ro1,ru1,rm1     : ch := rm1;
  219.                     ro2,ru2,rm2     : ch := '╡';
  220.                     wa1,om1,um1,mi1 : ch := mi1;
  221.                     wa2,om2,um2,mi2 : ch := '╪';
  222.                     ELSE ch := se1;
  223.                    END;
  224.                   END;
  225.           links : BEGIN
  226.                    CASE ch OF
  227.                     lo1,se1,lm1            : ch := lm1;
  228.                     lo2,se2,lm2            : ch := lm1;
  229.                     ro1,om1,rm1,mi1        : ch := mi1;
  230.                     ro2,om2,rm2,mi2        : ch := mi1;
  231.                     ru2,ru1,wa2,wa1,um1,um2: ch := um1;
  232.                     ELSE ch := lu1;
  233.                    END;
  234.                   END;
  235.           rechts: BEGIN
  236.                    CASE ch OF
  237.                     lo1,lo2,om2,om1        : ch := mi1;
  238.                     lm2,lm1,mi2,mi1        : ch := mi1;
  239.                     ro2,ro1,se2,se1,rm2,rm1: ch := rm1;
  240.                     lu2,lu1,wa2,wa1,um1,um2: ch := um1;
  241.                     ELSE ch := ru1;
  242.                    END;
  243.                   END;
  244.          END;
  245.          Dec(y); Dir := rauf;
  246.         END;
  247.     2 : BEGIN
  248.          CASE Dir OF
  249.           keine : ch := se1;
  250.           runter: BEGIN
  251.                    CASE ch OF
  252.                     lo1,lu1,lm1     : ch := lm1;
  253.                     lo2,lu2,lm2     : ch := '╞';
  254.                     ro1,ru1,rm1     : ch := rm1;
  255.                     ro2,ru2,rm2     : ch := '╡';
  256.                     wa1,om1,um1,mi1 : ch := mi1;
  257.                     wa2,om2,um2,mi2 : ch := '╪';
  258.                     ELSE ch := se1;
  259.                    END;
  260.                   END;
  261.           rauf  : BEGIN
  262.                    CASE ch OF
  263.                     lo1            : ch := lo1;
  264.                     lo2            : ch := '╒';
  265.                     ro1            : ch := ro1;
  266.                     ro2            : ch := '╕';
  267.                     lu1,lm1        : ch := lm1;
  268.                     lu2,lm2        : ch := '╞';
  269.                     ru1,rm1        : ch := rm1;
  270.                     ru2,rm2        : ch := '╡';
  271.                     wa1,om1        : ch := om1;
  272.                     wa2,om2        : ch := '╤';
  273.                     um1,um2,mi2,mi1: ch := mi1;
  274.                     ELSE ch := se1;
  275.                    END;
  276.                   END;
  277.           links : BEGIN
  278.                    CASE ch OF
  279.                     ro2,ro1,wa2,wa1,om2,om1 : ch := om1;
  280.                     lu2,lu1,se2,se1,lm2,lm1 : ch := lm1;
  281.                     ru2,ru1,rm2,rm1         : ch := rm1;
  282.                     um1,um2,mi2,mi1         : ch := mi1;
  283.                     ELSE ch := lo1;
  284.                    END;
  285.                   END;
  286.           rechts: BEGIN
  287.                    CASE ch OF
  288.                     lo1,lo2                : ch := lo1;
  289.                     lu2,lu1                : ch := lm1;
  290.                     ru2,ru1,se2,se1,rm2,rm1: ch := rm1;
  291.                     wa2,wa1,om2,om1        : ch := om1;
  292.                     um1,um2,mi2,mi1,lm2,lm1: ch := mi1;
  293.                     ELSE ch := ro1;
  294.                    END;
  295.                   END;
  296.          END;
  297.          Inc(y); Dir := runter;
  298.         END;
  299.     4 : BEGIN
  300.          CASE Dir OF
  301.           keine : ch := wa1;
  302.           runter: BEGIN
  303.                    CASE ch OF
  304.                     lo1,lo2,om2,om1,lm2,lm1: ch := mi1;
  305.                     mi2,mi1                : ch := mi1;
  306.                     ro2,ro1,se2,se1,rm2,rm1: ch := rm1;
  307.                     lu2,lu1,wa2,wa1,um1,um2: ch := um1;
  308.                     ELSE ch := ru1;
  309.                    END;
  310.                   END;
  311.           rauf  : BEGIN
  312.                    CASE ch OF
  313.                     lo1,lo2,wa2,wa1,om2,om1: ch := om1;
  314.                     lu2,lu1,um1,um2,mi2,mi1: ch := mi1;
  315.                     lm2,lm1                : ch := mi1;
  316.                     ru2,ru1,se2,se1,rm2,rm1: ch := rm1;
  317.                     ELSE ch := ro1;
  318.                    END;
  319.                   END;
  320.           links : BEGIN
  321.                    CASE ch OF
  322.                     lo1,ro1,om1     : ch := om1;
  323.                     lo2,ro2,om2     : ch := '╥';
  324.                     lu1,ru1,um1     : ch := um1;
  325.                     lu2,ru2,um2     : ch := '╨';
  326.                     se1,lm1,rm1,mi1 : ch := mi1;
  327.                     se2,lm2,rm2,mi2 : ch := '╫';
  328.                     ELSE ch := wa1;
  329.                    END;
  330.                   END;
  331.           rechts: BEGIN
  332.                    CASE ch OF
  333.                     lo1,lo2,om2,om1        : ch := om1;
  334.                     ro2,ro1                : ch := ro1;
  335.                     ru2,ru1,um1,um2,lu2,lu1: ch := um1;
  336.                     se1,rm1                : ch := rm1;
  337.                     se2,rm2                : ch := '╢';
  338.                     lm1,mi1                : ch := mi1;
  339.                     lm2,mi2                : ch := '╫';
  340.                     ELSE ch := wa1;
  341.                    END;
  342.                   END;
  343.          END;
  344.          Dec(x); Dir := links;
  345.         END;
  346.     6 : BEGIN
  347.          CASE Dir OF
  348.           keine : ch := wa1;
  349.           runter: BEGIN
  350.                    CASE ch OF
  351.                     lo1,se1,lm1,lo2,se2,lm2: ch := lm1;
  352.                     ro2,ro1,om2,om1,rm2,rm1: ch := mi1;
  353.                     mi2,mi1                : ch := mi1;
  354.                     ru2,ru1,wa2,wa1,um1,um2: ch := um1;
  355.                     ELSE ch := lu1;
  356.                    END;
  357.                   END;
  358.           rauf  : BEGIN
  359.                    CASE ch OF
  360.                     ro2,ro1,wa2,wa1,om2,om1: ch := om1;
  361.                     lu2,lu1,se2,se1,lm2,lm1: ch := lm1;
  362.                     ru2,ru1,um1,um2,rm2,rm1: ch := mi1;
  363.                     mi2,mi1                : ch := mi1;
  364.                     ELSE ch := lo1;
  365.                    END;
  366.                   END;
  367.           links : BEGIN
  368.                    CASE ch OF
  369.                     lo1         : ch := lo1;
  370.                     lo2         : ch := '╓';
  371.                     ro1,om1     : ch := om1;
  372.                     ro2,om2     : ch := '╥';
  373.                     lu1         : ch := lu1;
  374.                     ru1,um1     : ch := um1;
  375.                     lu2         : ch := '╙';
  376.                     ru2,um2     : ch := '╨';
  377.                     se1         : ch := lm1;
  378.                     se2         : ch := '╟';
  379.                     lm1,rm1,mi1 : ch := mi1;
  380.                     lm2,rm2,mi2 : ch := '╪';
  381.                     ELSE ch := wa1;
  382.                    END;
  383.                   END;
  384.           rechts: BEGIN
  385.                    CASE ch OF
  386.                     lo1,ro1,om1    : ch := om1;
  387.                     lo2,ro2,om2    : ch := '╥';
  388.                     lu1,ru1,um1    : ch := um1;
  389.                     lu2,ru2,um2    : ch := '╨';
  390.                     se1,lm1,rm1,mi1: ch := mi1;
  391.                     se2,lm2,rm2,mi2: ch := '╫';
  392.                     ELSE ch := wa1;
  393.                    END;
  394.                   END;
  395.          END;
  396.          Inc(x); Dir := rechts;
  397.         END;
  398.    END;
  399.   END;
  400.   IF Art = doppelt THEN
  401.   BEGIN
  402.    CASE Pfeil OF
  403.     8 : BEGIN
  404.          CASE Dir OF
  405.           keine : ch := se2;
  406.           runter: BEGIN
  407.                    CASE ch OF
  408.                     lo1,lo2,lm2,lm1 : ch := lm2;
  409.                     ro2,ro1,rm2,rm1 : ch := rm2;
  410.                     lu1,lu2         : ch := lu2;
  411.                     ru1,ru2         : ch := ru2;
  412.                     wa1,um1         : ch := '╨';
  413.                     wa2,um2         : ch := um2;
  414.                     om1,mi1         : ch := '╫';
  415.                     om2,mi2         : ch := mi2;
  416.                     ELSE ch := se2;
  417.                    END;
  418.                   END;
  419.           rauf  : BEGIN
  420.                    CASE ch OF
  421.                     lo1,lu1,lm1     : ch := '╟';
  422.                     lo2,lu2,lm2     : ch := lm2;
  423.                     ro1,ru1,rm1     : ch := '╢';
  424.                     ro2,ru2,rm2     : ch := rm2;
  425.                     wa1,om1,um1,mi1 : ch := '╫';
  426.                     wa2,om2,um2,mi2 : ch := mi2;
  427.                     ELSE ch := se2;
  428.                    END;
  429.                   END;
  430.           links : BEGIN
  431.                    CASE ch OF
  432.                     lo1,lo2,se2,se1,lm2,lm1 : ch := lm2;
  433.                     ro2,ro1,om2,om1,rm2,rm1 : ch := mi2;
  434.                     mi2,mi1                 : ch := mi2;
  435.                     ru2,ru1,wa2,wa1,um1,um2 : ch := um2;
  436.                     ELSE ch := lu2;
  437.                    END;
  438.                   END;
  439.           rechts: BEGIN
  440.                    CASE ch OF
  441.                     lo1,lo2,om2,om1,lm2,lm1 : ch := mi2;
  442.                     mi2,mi1                 : ch := mi2;
  443.                     ro2,ro1,se2,se1,rm2,rm1 : ch := rm2;
  444.                     lu2,lu1,wa2,wa1,um1,um2 : ch := um2;
  445.                     ELSE ch := ru2;
  446.                    END;
  447.                   END;
  448.          END;
  449.          Dec(y); Dir := rauf;
  450.         END;
  451.     2 : BEGIN
  452.          CASE Dir OF
  453.           keine : ch := se2;
  454.           runter: BEGIN
  455.                    CASE ch OF
  456.                     lo2,lu2,lm2     : ch := lm2;
  457.                     lo1,lu1,lm1     : ch := '╟';
  458.                     ro2,ru2,rm2     : ch := rm2;
  459.                     ro1,ru1,rm1     : ch := '╢';
  460.                     wa2,om2,um2,mi2 : ch := mi2;
  461.                     wa1,om1,um1,mi1 : ch := '╫';
  462.                     ELSE ch := se2;
  463.                    END;
  464.                   END;
  465.           rauf  : BEGIN
  466.                    CASE ch OF
  467.                     lo2       : ch := lo2;
  468.                     lo1       : ch := '╓';
  469.                     ro2       : ch := ro2;
  470.                     ro1       : ch := '╖';
  471.                     lu2,lm2   : ch := lm2;
  472.                     lu1,lm1   : ch := '╟';
  473.                     ru2,rm2   : ch := rm2;
  474.                     ru1,rm1   : ch := '╢';
  475.                     wa2,om2   : ch := om2;
  476.                     wa1,om1   : ch := '╥';
  477.                     um2,mi2   : ch := mi2;
  478.                     um1,mi1   : ch := '╫';
  479.                     ELSE ch := se2;
  480.                    END;
  481.                   END;
  482.           links : BEGIN
  483.                    CASE ch OF
  484.                     ro2,ro1,wa2,wa1,om2,om1 : ch := om2;
  485.                     lu2,lu1,se2,se1,lm2,lm1 : ch := lm2;
  486.                     ru2,ru1,rm2,rm1         : ch := mi2;
  487.                     um1,um2,mi2,mi1         : ch := mi2;
  488.                     ELSE ch := lo2;
  489.                    END;
  490.                   END;
  491.           rechts: BEGIN
  492.                    CASE ch OF
  493.                     lo1,lo2                 : ch := om2;
  494.                     lu2,lu1                 : ch := mi2;
  495.                     ru2,ru1,se2,se1,rm2,rm1 : ch := rm2;
  496.                     wa2,wa1,om2,om1         : ch := om2;
  497.                     um1,um2,mi2,mi1,lm2,lm1 : ch := mi2;
  498.                     ELSE ch := ro2;
  499.                    END;
  500.                   END;
  501.          END;
  502.          Inc(y); Dir := runter;
  503.         END;
  504.     4 : BEGIN
  505.          CASE Dir OF
  506.           keine : ch := wa2;
  507.           runter: BEGIN
  508.                    CASE ch OF
  509.                     lo1,lo2,om2,om1,lm2,lm1 : ch := mi2;
  510.                     mi2,mi1                 : ch := mi2;
  511.                     ro2,ro1,se2,se1,rm2,rm1 : ch := rm2;
  512.                     lu2,lu1,wa2,wa1,um1,um2 : ch := um2;
  513.                     ELSE ch := ru2;
  514.                    END;
  515.                   END;
  516.           rauf  : BEGIN
  517.                    CASE ch OF
  518.                     lo1,lo2,wa2,wa1,om2,om1 : ch := om2;
  519.                     lu2,lu1,um1,um2,mi2,mi1 : ch := mi2;
  520.                     lm2,lm1                 : ch := mi2;
  521.                     ru2,ru1,se2,se1,rm2,rm1 : ch := rm2;
  522.                     ELSE ch := ro2;
  523.                    END;
  524.                   END;
  525.           links : BEGIN
  526.                    CASE ch OF
  527.                     lo2,ro2,om2     : ch := om2;
  528.                     lo1,ro1,om1     : ch := '╤';
  529.                     lu2,ru2,um2     : ch := um2;
  530.                     lu1,ru1,um1     : ch := '╧';
  531.                     se2,lm2,rm2,mi2 : ch := mi2;
  532.                     se1,lm1,rm1,mi1 : ch := '╪';
  533.                     ELSE ch := wa2;
  534.                    END;
  535.                   END;
  536.           rechts: BEGIN
  537.                    CASE ch OF
  538.                     lo1,lo2,om2,om1: ch := om2;
  539.                     ro2            : ch := ro2;
  540.                     ro1            : ch := '╕';
  541.                     lu2,um2        : ch := um2;
  542.                     lu1,um1        : ch := '╧';
  543.                     ru2            : ch := ru2;
  544.                     ru1            : ch := '╛';
  545.                     se1,rm1        : ch := '╡';
  546.                     se2,rm2        : ch := rm2;
  547.                     lm2,mi2        : ch := mi2;
  548.                     lm1,mi1        : ch := '╪';
  549.                     ELSE ch := wa2;
  550.                    END;
  551.                   END;
  552.          END;
  553.          Dec(x); Dir := links;
  554.         END;
  555.     6 : BEGIN
  556.          CASE Dir OF
  557.           keine : ch := wa2;
  558.           runter: BEGIN
  559.                    CASE ch OF
  560.                     lo1,lo2,se2,se1,lm2,lm1 : ch := lm2;
  561.                     ro2,ro1,om2,om1,rm2,rm1 : ch := mi2;
  562.                     mi2,mi1                 : ch := mi2;
  563.                     ru2,ru1,wa2,wa1,um1,um2 : ch := um2;
  564.                     ELSE ch := lu2;
  565.                    END;
  566.                   END;
  567.           rauf  : BEGIN
  568.                    CASE ch OF
  569.                     ro2,ro1,wa2,wa1,om2,om1 : ch := om2;
  570.                     lu2,lu1,se2,se1,lm2,lm1 : ch := lm2;
  571.                     ru2,ru1,um1,um2,rm2,rm1 : ch := mi2;
  572.                     mi2,mi1                 : ch := mi2;
  573.                     ELSE ch := lo2;
  574.                    END;
  575.                   END;
  576.           links : BEGIN
  577.                    CASE ch OF
  578.                     lo2       : ch := lo2;
  579.                     lo1       : ch := '╒';
  580.                     ro2,om2   : ch := om2;
  581.                     ro1,om1   : ch := '╤';
  582.                     ru2,um2   : ch := um2;
  583.                     lu2       : ch := lu2;
  584.                     ru1,um1   : ch := '╧';
  585.                     lu1       : ch := '╘';
  586.                     se1,lm1   : ch := '╞';
  587.                     se2,lm2   : ch := lm2;
  588.                     rm1,mi1   : ch := '╪';
  589.                     rm2,mi2   : ch := mi2;
  590.                     ELSE ch := wa2;
  591.                    END;
  592.                   END;
  593.           rechts: BEGIN
  594.                    CASE ch OF
  595.                     lo2,ro2,om2    : ch := om2;
  596.                     lo1,ro1,om1    : ch := '╤';
  597.                     lu2,ru2,um2    : ch := um2;
  598.                     lu1,ru1,um1    : ch := '╧';
  599.                     se2,lm2,rm2,mi2: ch := mi2;
  600.                     se1,lm1,rm1,mi1: ch := '╪';
  601.                     ELSE ch := wa2;
  602.                    END;
  603.                   END;
  604.          END;
  605.          Inc(x); Dir := rechts;
  606.         END;
  607.    END;
  608.   END;
  609.   IF Art = definiert THEN
  610.   BEGIN
  611.    CASE Pfeil OF
  612.     8 : BEGIN ch := Key; Dec(y); END;
  613.     6 : BEGIN ch := Key; Inc(x); END;
  614.     2 : BEGIN ch := Key; Inc(y); END;
  615.     4 : BEGIN ch := Key; Dec(x); END;
  616.    END;
  617.   END;
  618.  END;
  619. END;
  620.  
  621. PROCEDURE ASCIITabelle (VAR Code: BYTE;
  622.              VAR Wahl: BOOLEAN; VAR Wdh: BOOLEAN);
  623. VAR i,Zeile,Spalte,Save: BYTE; Ende: BOOLEAN;
  624. BEGIN
  625.   SMem:=Screen; Wahl:=FALSE; Ende:=FALSE; Wdh:=FALSE;
  626.   Rahmen (40,2,76,21,3);
  627.   WrtXY (45,20,'Auswählen mit (Ctrl-)RETURN');
  628.   FOR Zeile := 3 TO 18 DO
  629.     FOR Spalte := 41 TO 75 DO Screen[Zeile,Spalte].ch := nx;
  630.   FOR Zeile := 0 TO 15 DO
  631.    FOR Spalte := 0 TO 15 DO
  632.     Screen[Zeile+3,40+(Spalte*2+3)].ch:=Chr(Zeile*16+Spalte);
  633.   REPEAT
  634.     Spalte := 41 + (Code MOD 16 + 1)*2;
  635.     Zeile  := (Code SHR 4 + 3);
  636.     Screen[Zeile,Spalte].ch := Chr(Code);
  637.     Screen[Zeile,Spalte].Attr := 130;
  638.     Save := Code;  GetCode (Taste);
  639.     CASE Taste OF
  640.       27   : Ende := TRUE;
  641.       13   : BEGIN Ende:=TRUE; Wahl:=TRUE; END;
  642.       10   : BEGIN Ende:=TRUE; Wahl:=TRUE; Wdh:=TRUE; END;
  643.       1075 : Dec(Code);
  644.       1077 : Inc(Code);
  645.       1072 : Dec(Code,16);
  646.       1080 : Inc(Code,16);
  647.       1079 : Code := (Code SHR 4) SHL 4 + 15;
  648.       1071 : Code := (Code SHR 4) SHL 4;
  649.       1073 : Code := Code MOD 16;
  650.       1081 : Code := Code MOD 16 + 240;
  651.     END;
  652.     Screen[Zeile,Spalte].ch := Chr(Save);
  653.     Screen[Zeile,Spalte].Attr := 112;
  654.   UNTIL Ende;
  655.   Screen := SMem;
  656. END;
  657.  
  658. PROCEDURE Position (x,y: BYTE; Art: Striche; aktiv: BOOLEAN);
  659. BEGIN
  660.   Normal; GotoXY (49,24); Write(y:2);
  661.   GotoXY (61,24); Write (x:2);
  662.   IF aktiv THEN BEGIN
  663.     CASE Art OF
  664.       einfach  : WrtXY (75,24,wa1+mi1+wa1);
  665.       doppelt  : WrtXY (75,24,wa2+mi2+wa2);
  666.       definiert: WrtXY (75,24,Key+Key+Key);
  667.     END;
  668.   END ELSE WrtXY (75,24,'Aus');
  669.   Invers;
  670. END;
  671.  
  672. BEGIN
  673.   x := 1;  y := 1;  aktiv := FALSE;  Name := '';
  674.   Key := ' ';  Code := 176;  Dir := keine;
  675.   Ende := FALSE;  Sorte := einfach;  Nochmal := FALSE;
  676.   Invers;   ClrScr;  CursorDick;  StatusZeile_An;
  677.   Anzeige := TRUE;  Position (x,y,Sorte,aktiv);
  678.   GotoXY (x,y);
  679.   REPEAT
  680.     IF KeyPressed THEN BEGIN
  681.       GetCode (Taste);
  682.       CASE Taste OF
  683.         27 : BEGIN
  684.                SMem:=Screen; Normal; Rahmen (25,12,55,14,2);
  685.                WrtXY(27,13,'Wirklich aufhören (J/N) ?');
  686.                ch := UpCase(ReadKey);
  687.                IF ch = 'J' THEN Ende := TRUE
  688.                ELSE BEGIN Screen := SMem; Invers; END;
  689.              END;
  690.         8  : IF x > 1 THEN
  691.              BEGIN Dec(x); Screen[y,x].ch := nx; END;
  692.         13 : BEGIN x := 1; IF y < 25 THEN Inc(y); END;
  693.         32..255 : BEGIN
  694.                     Screen[y,x].ch := Chr(Taste);
  695.                     IF x < 80 THEN Inc(x)
  696.                     ELSE IF y < 25 THEN
  697.                     BEGIN x := 1; Inc(y); END;
  698.                   END;
  699.         1061: IF Sorte = einfach THEN Sorte := doppelt
  700.               ELSE Sorte := einfach;
  701.         1063 : Speichern;
  702.         1064 : Laden;
  703.         1060 : BildschirmLoeschen;
  704.         1059 : Hilfe;
  705.         1065 : ZeileLoeschen (y,Anzeige);
  706.         1066 : SpalteLoeschen (x,Anzeige);
  707.         1067 : ZeileEinfuegen (y,Anzeige);
  708.         1068 : SpalteEinfuegen (x,Anzeige);
  709.         1071 : x := 1;
  710.         1079 : x := 80;
  711.         1073 : y := 1;
  712.         1081 : IF Anzeige THEN y := 22 ELSE y := 25;
  713.         1062 : IF aktiv = TRUE THEN
  714.                BEGIN aktiv := FALSE; CursorDick; END
  715.                ELSE BEGIN
  716.                  aktiv := TRUE; Dir := keine; CursorNormal;
  717.                END;
  718.         1072 : IF y > 1 THEN BEGIN
  719.                  IF aktiv THEN PfeilTasten(8,Sorte)
  720.                  ELSE Dec(y);
  721.                END;
  722.         1075 : IF x > 1 THEN BEGIN
  723.                  IF aktiv THEN PfeilTasten(4,Sorte)
  724.                  ELSE Dec(x);
  725.                END;
  726.         1077 : IF x < 80 THEN BEGIN
  727.                  IF aktiv THEN PfeilTasten(6,Sorte)
  728.                  ELSE Inc(x);
  729.                END;
  730.         1080 : IF ((Anzeige) AND (y < 22)) OR
  731.                   ((NOT Anzeige) AND (y < 25)) THEN BEGIN
  732.                  IF aktiv THEN PfeilTasten(2,Sorte)
  733.                  ELSE Inc(y);
  734.                END;
  735.         1082 : BEGIN
  736.                  FOR i := 80 DOWNTO x+1 DO
  737.                    Screen[y,i] := Screen[y,i-1];
  738.                  Screen[y,x].ch := nx;
  739.                END;
  740.         1083 : BEGIN
  741.                  FOR i := x TO 79 DO
  742.                    Screen[y,i] := Screen[y,i+1];
  743.                  Screen[y,80].ch := nx;
  744.                END;
  745.         1104: IF Anzeige THEN
  746.               BEGIN Invers; StatusZeile_Aus; Anzeige:=FALSE; END
  747.               ELSE BEGIN StatusZeile_An; Anzeige:=TRUE; END;
  748.         1108: BEGIN
  749.                 Wahl := FALSE;
  750.                 ASCIITabelle(Code,Wahl,Nochmal);
  751.                 IF Wahl THEN BEGIN
  752.                   Sorte := definiert; Key := Chr(Code);
  753.                 END;
  754.               END;
  755.         1109: BEGIN
  756.                 REPEAT
  757.                   Wahl := FALSE;
  758.                   ASCIITabelle (Code,Wahl,Nochmal);
  759.                   IF Wahl THEN BEGIN
  760.                     Screen[y,x].ch := Chr(Code);
  761.                     IF x < 80 THEN Inc(x);
  762.                   END;
  763.                 UNTIL NOT Nochmal;
  764.               END;
  765.         1106: BEGIN
  766.                 i := Ord(Screen[y,x].ch);
  767.                 FOR j := 1 TO 80 DO
  768.                 Screen[y,j].ch := Chr(i);
  769.               END;
  770.       END;
  771.       IF Anzeige THEN Position (x,y,Sorte,aktiv);
  772.       GotoXY (x,y);
  773.     END;
  774.   UNTIL Ende;
  775.   CursorNormal; Normal; ClrScr;
  776. END.
  777. (* ------------------------------------------------------ *)
  778. (*                  Ende von BOX.PAS                      *)
  779.  
  780.