home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9302 / svga / testcol.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-17  |  2.9 KB  |  92 lines
  1. (*========================================================*)
  2. (*                  TESTCOL.PAS v. 1.01                   *)
  3. (*             (C) 1993 J. Braun & DMV-Verlag             *)
  4. (*            Demoprogramm für die Unit XGRAPH            *)
  5. (* ====================================================== *)
  6. (* Benötigt werden:                                       *)
  7. (*  Turbo Pascal ab Version 5.0, SVGA.BGI, TRIP.CHR,      *)
  8. (*  die Units XGRAPH.PAS und DRIVERS.PAS sowie die        *)
  9. (*  Standard-BGI-Treiber (CGA, EGAVGA ....).              *)
  10. (*  Treiber und Fonts müssen mit BINOBJ umgewandelt sein. *)
  11. (* Compileren mit: MAKE -fTESTCOL.MAK                     *)
  12. (*========================================================*)
  13. {$I xgraph.h} {$M 16384,0,524288}
  14.  
  15. PROGRAM TestColors;
  16.  
  17. USES
  18.   Dos, Crt, Drivers, XGraph;
  19.  
  20. VAR
  21.   MaxCol, x, y, i   : WORD;
  22.   xp, m,  gd, gm, d : INTEGER;
  23.   s                 : STRING;
  24.   ch                : CHAR;
  25.  
  26. PROCEDURE TSCRFontProc;    EXTERNAL; {$L tscr.obj}
  27. PROCEDURE TriplexFontProc; EXTERNAL; {$L trip.obj}
  28.  
  29. PROCEDURE Bar(x1, y1, x2, y2: WORD);
  30. VAR
  31.  i: WORD;
  32. BEGIN
  33.   IF gd = IBM8514 THEN
  34.     FOR i := y1 TO y2 DO Line(x1, i, x2, i)
  35.   ELSE
  36.     XGraph.Bar(x1, y1, x2, y2);
  37. END;
  38.  
  39. BEGIN
  40.   d := RegisterBGIFont(@TSCRFontProc);
  41.   d := RegisterBGIFont(@TriplexFontProc);
  42.   DetectGraph(gd, gm);
  43.   Initgraph(gd, gm, '');
  44.   CASE Succ(GetMaxX) OF
  45.      320: m := 20;
  46.      640: m := 38;
  47.      720: m := 30;
  48.      800: m := 50;
  49.     1024: m := 60;
  50.   END;
  51.   MaxCol := Succ(GetMaxColor);
  52.   CASE MaxCol OF
  53.     2 : x := GetMaxX DIV 2 - m;
  54.     4 : x := GetMaxX DIV 2 - 2 * m;
  55.     16: x := Succ(GetMaxX DIV MaxCol - m);
  56.    ELSE x := 1;
  57.   END;
  58.   y := GetMaxY DIV 2 + 10;
  59.   SetUserCharSize(3, 2, 2, 2);
  60.   FontAttr := Outline;
  61.   SetTextStyle(TSCRFont, HorizDir, UserCharSize);
  62.   SetTextJustify(CenterText, CenterText);
  63.   xp := TextHeight('Pp');
  64.   OutTextXY(GetMaxX DIV 2, xp, 'Farbtabelle');
  65.   SetTextStyle(TriplexFont, HorizDir, 2);
  66.   FontAttr := Normal;
  67.   OutTextXY(GetMaxX DIV 2, 2 * xp, '( Standard Palette )');
  68.   OutTextXY(GetMaxX DIV 2, 3 * xp, GetModeName(gm));
  69.   SetUserCharSize(2, 5, 1, 2);
  70.   SetTextStyle(TriplexFont, HorizDir, UserCharSize);
  71.   SetTextJustify(CenterText, TopText);
  72.   FOR i := 0 TO Pred(MaxCol) DO BEGIN
  73.     SetFillStyle(SolidFill, i);
  74.     SetColor(i);     Bar(x, y, x + m, y + m);
  75.     SetColor(White); Rectangle(x, y, x + m, y + m);
  76.     Inc(x, m);       SetColor(White);
  77.     Str(i: 2, s);    OutTextXY(x - m DIV 2, y + m, s);
  78.   END;
  79.   SetUserCharSize(2, 5, 2, 5);
  80.   SetTextStyle(TriplexFont, HorizDir, UserCharsize);
  81.   SetTextJustify(CenterText, BottomText);
  82.   OutTextXY(GetMaxX DIV 2, GetMaxY - Succ(TextHeight('Pp')),
  83.             'Ende mit beliebiger Taste');
  84.   REPEAT UNTIL KeyPressed;
  85.   ch := ReadKey;
  86.   IF ch = #0 THEN ch := ReadKey;
  87.   CloseGraph;
  88. END.
  89.  
  90. (*========================================================*)
  91. (*                 Ende von TESTCOL.PAS                   *)
  92.