home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 12 / grdlagen / attrdemo.pas next >
Encoding:
Pascal/Delphi Source File  |  1989-08-09  |  4.3 KB  |  135 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     ATTRDEMO.PAS                       *)
  3. (*            Demo-Programm für die Möglichkeiten         *)
  4. (*                   von ATTRIBUT.PAS                     *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM AttributDemo;
  7.  
  8. USES Crt, Dos, Attribut;
  9.  
  10. VAR
  11.   x, y, v, h, at       : BYTE;
  12.   ca, Result, i        : INTEGER;
  13.   Vs, hs               : STRING;
  14.   ch1, ch              : CHAR;
  15.   GrauSchwarz, GelbRot : BYTE;
  16.  
  17. CONST
  18.   Rand : ARRAY[1..8] OF CHAR
  19.                         = ('┌','─','┐','│','│','└','─','┘');
  20.   Schatten : BOOLEAN = FALSE;
  21.  
  22.  
  23.   PROCEDURE Rahmen(x1, y1, x2, y2 : BYTE);
  24.   BEGIN
  25.     Window(x1, y1, x2, y2); ClrScr;
  26.     Window(1, 1, 80, 25);
  27.     WrtChr(x1, y1, Rand[1]); WrtChr(x2, y1, Rand[ 3]);
  28.     FillChr(Succ(x1), y1, Pred(x2), y1, Rand[2]);
  29.     FillChr(Succ(x1), y2, Pred(x2), y2, Rand[7]);
  30.     FillChr(x1, Succ(y1), x1, Pred(y2), Rand[4]);
  31.     FillChr(x2, Succ(y1), x2, Pred(y2), Rand[5]);
  32.     WrtChr(x1, y2, Rand[6]);  WrtChr(x2, y2, Rand[8])
  33.   END;
  34.  
  35.   PROCEDURE Fahne;
  36.   BEGIN
  37.     FillAttr(1, 3, 24, 4, MakeAttr(Black, Black));
  38.     FillAttr(1, 5, 24, 6, MakeAttr(LightRed, Black));
  39.     FillAttr(1, 7, 24, 8, MakeAttr(Yellow, Black));
  40.   END;
  41.  
  42.   PROCEDURE BildschirmAufbau;
  43.   BEGIN
  44.     Desktop(178, MakeAttr(White, Black));
  45.     WrtStr(28, 1, ' Attribute  Demonstration ');
  46.     Window(25, 3, 75, 22);
  47.     FOR i := 1 TO 40 DO Write('Text-Hintergrund Toolbox ');
  48.     Write('Text-Hintergrund To');
  49.     WrtChr(75, 22, 'l');
  50.     FillAttr(25, 3, 75, 22, MakeAttr(White, LightGray));
  51.     Rahmen(1, 15, 24, 22);
  52.     Window(2, 16, 23, 21);
  53.     FOR i := 1 TO 26 DO Write('Test ');
  54.     Rahmen(31, 8, 70, 20);
  55.     WrtStr(37, 10, '<1> Schatten An/Aus');
  56.     WrtStr(37, 12, '<2> Blinken  An/Aus');
  57.     WrtStr(37, 14, '<3> Attribut-Auswahl');
  58.     WrtStr(60, 18, 'ESC: Ende');
  59.     WrtStr(32, 18, 'Wahl: ');
  60.     FillAttr(31, 8, 70, 20, MakeAttr(LightGray, Blue));
  61.     Fahne; ca := 1;
  62.     WrtStr(53, 25, '(c) 89 L.Holländer & TOOLBOX');
  63.     WrtStr(1, 25, 'Vordergrund:     Hintergrund: ' +
  64.                   '      Attribut:   ');
  65.   END;
  66.  
  67.   PROCEDURE TestColor;
  68.   VAR
  69.     Regs : Registers;
  70.   BEGIN
  71.     Regs.ah := 15;
  72.     Intr($10, Regs);
  73.     IF (Regs.al = 7) THEN BEGIN
  74.       Write('Keine Color-Grafik-Karte');
  75.       Halt(0);
  76.     END;
  77.   END;
  78.  
  79. BEGIN
  80.   TestColor;
  81.   TextAttr := 15;  ClrScr;
  82.   GelbRot := MakeAttr(Yellow, Red);
  83.   GrauSchwarz := MakeAttr(LightGray, Black);
  84.   BildschirmAufbau;
  85.   REPEAT
  86.     GotoXY(38,18);  ch := ReadKey;
  87.     IF ch = #0 THEN ch := ReadKey;
  88.     Write(ch);
  89.     FillAttr(37, 8+ca*2, 56, 8+ca*2,
  90.              MakeAttr(LightGray, Blue));
  91.     CASE ch OF
  92.       '1': BEGIN
  93.              Schatten := NOT(Schatten);
  94.              FillAttr(37, 10, 56, 10, GelbRot);
  95.              IF Schatten THEN BEGIN
  96.                FillAttr(71, 9, 71, 21, GrauSchwarz);
  97.                FillAttr(32, 21, 70, 21, GrauSchwarz);
  98.              END ELSE BEGIN
  99.                FillAttr(71, 9, 71, 21,
  100.                         MakeAttr(White, LightGray));
  101.                FillAttr(32, 21, 70, 21,
  102.                         MakeAttr(White, LightGray));
  103.              END;
  104.            END;
  105.       '2': BEGIN
  106.              FillAttr(60, 18, 69, 18,
  107.                       PickAttr(60, 18) + Blink);
  108.              FillAttr(37, 12, 56, 12, GelbRot);
  109.            END;
  110.       '3': BEGIN
  111.              FillAttr(37, 14, 56, 14, GelbRot);
  112.              GotoXY(13, 25);  ch1 := UpCase(ReadKey);
  113.              Vs := '$' + ch1;
  114.              Val(Vs, v, Result);
  115.              IF Result > 0 THEN Write(^G'$0')
  116.                            ELSE Write(Vs);
  117.              GotoXY(31, 25);  ch1 :=  ReadKey;
  118.              hs := '$' + ch1;
  119.              Val(hs, h, Result);
  120.              IF Result > 0 THEN h := 0;
  121.              Write('$', h MOD 8);
  122.              FillAttr(2, 16, 23, 21, MakeAttr(v, h));
  123.              GotoXY(46, 25);  Write(MakeAttr(v, h) : 3);
  124.            END;
  125.       ELSE
  126.            IF ch <> #27 THEN Write(^G);
  127.     END;
  128.     Val(ch, ca, Result);
  129.     IF ca > 3 THEN ca := 3;  IF ca < 1 THEN ca := 1;
  130.   UNTIL ch = #27;
  131.   ClrScr;
  132. END.
  133. (* ------------------------------------------------------ *)
  134. (*               Ende von ATTRDEMO.PAS                    *)
  135.