home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / symbol / symbolf.pas < prev   
Pascal/Delphi Source File  |  1993-05-19  |  5KB  |  106 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-,Y-}
  2. {$M $1000,0,$20000}
  3. (*===================================================================*)
  4. (*                           SYMBOLF.PAS                             *)
  5. (*-------------------------------------------------------------------*)
  6. (*            Demonstration für den UserFont »SYMB.CHR«              *)
  7. (*    Das Programm kann sowohl im Real als auch im Protected Mode    *)
  8. (*                        compiliert werden.                         *)
  9. (*===================================================================*)
  10.  
  11. PROGRAM DisplaySymbolFont;
  12.  
  13. USES
  14.   Crt, Dos, Graph;
  15.  
  16. VAR
  17.   result,
  18.   Symbol,
  19.   gd, gm: INTEGER;
  20.   i     : BYTE;
  21.   mult  : INTEGER;
  22.   cs    : STRING[3];
  23.   ch    : CHAR;
  24.   x, y  : INTEGER;
  25. BEGIN
  26.   DetectGraph(gd, gm);
  27.   IF gd = VGA THEN BEGIN                 (* wenn VGA ermittelt, SVGA *)
  28.     gm := 0;                             (* probieren. Allerdings    *)
  29.     gd := InstallUserDriver('SVGA', NIL);(* muß der Treiber für die  *)
  30.     InitGraph(gd, gm, GetEnv('BGIPATH'));(* Karte korrekt gepatcht   *)
  31.     IF GraphResult <> grOk THEN          (* sein. Falls der Treiber  *)
  32.     BEGIN                                (* nicht gefunden wurde,    *)
  33.       gd := VGA;                         (* wird die Installation    *)
  34.       gm := VGAHi;                       (* mit VGA erneut versucht  *)
  35.       InitGraph(gd, gm, GetEnv('BGIPATH'));
  36.     END;                                 (* Falls keine VGA, dann    *)
  37.   END ELSE InitGraph(gd, gm, GetEnv('BGIPATH')); (* normal initial.  *)
  38.   result := GraphResult;                 (* Fehlerüberprüfung        *)
  39.   IF result = grOk THEN                  (* alles war ok, los geht's *)
  40.   BEGIN
  41.     SetTextJustify(CenterText, TopText);        (* Headline mit der  *)
  42.     SetTextStyle(SmallFont, HorizDir, 5);       (* Fontinfo ausgeben *)
  43.     OutTextXY(Succ(GetMaxX) DIV 2, 5,               (* in SmallFont  *)
  44.               'BGI-Symbol-Zeichensatz »SYMB.CHR«'); (* Symbolschrift *)
  45.     Symbol := InstallUserFont('SYMB');              (* laden         *)
  46.     SetTextJustify(LeftText, BottomText);
  47.     Rectangle(4, 20, GetMaxX - 4, GetMaxY);         (* Rahmen ziehen *)
  48.     CASE Succ(GetMaxY) OF
  49.       600: mult := 4;                                    (* SVGA     *)
  50.       480: mult := 3;                                    (* VGA      *)
  51.       350: mult := 2;                                    (* EGA      *)
  52.       200: mult := 1;                                    (* CGA      *)
  53.       ELSE mult := 2;                                    (* Hercules *)
  54.     END;
  55.     MoveTo(15, Succ(GetMaxY) DIV 9);
  56.     SetTextStyle(Symbol, HorizDir, mult);
  57.     FOR i := 0 TO 255 DO                       (* Alle Zeichen auf   *)
  58.     BEGIN                                      (* dem Bildschirm     *)
  59.       IF GetX >= GetMaxX - TextWidth('W')      (* ausgeben, die      *)
  60.                - Round(2 * mult / 3) - 20 THEN (* zugehörige Nummer  *)
  61.         MoveTo(15, GetY + 10 * mult);
  62.       SetColor(White);
  63.       IF i <> 255 THEN OutText(Chr(i)) ELSE OutText(' ');
  64.       SetTextStyle(SmallFont, HorizDir, 4);    (* im SmallFont       *)
  65.       Str(i, cs);
  66.       SetColor(Yellow);
  67.       OutText(cs);
  68.       SetTextStyle(Symbol, HorizDir, mult);
  69.       OutText(#0);                             (* halber Space       *)
  70.     END;
  71.     ch := #0;
  72.     REPEAT
  73.       ch := ReadKey;   (* Und wenn fertig, auf eine Taste warten ... *)
  74.     UNTIL ch <> #0;
  75.     SetColor(LightRed);
  76.     ClearDevice;                           (* den Bildschirm löschen *)
  77.     SetTextStyle(TriplexFont, HorizDir, 2);
  78.     OutTextXY(10, 30, 'Bitte geben Sie beliebige Zeichen ein ' +
  79.                       '(Ende mit <ALT 255>:');
  80.     SetColor(White);
  81.     MoveTo(10, x);                         (* und den Benutzer den   *)
  82.     SetTextStyle(Symbol, HorizDir, 3);     (* Font testen lassen     *)
  83.     x := 10;
  84.     y := GetMaxY DIV 10;
  85.     MoveTo(x, y);
  86.     ch := #0;
  87.     REPEAT
  88.       Inc(x, TextWidth(ch) + 1);
  89.       ch := ReadKey;
  90.       IF ch = #13 THEN                   (* Zeilenumbruch *)
  91.       BEGIN
  92.         OutTextXY(x, y, ch);
  93.         Inc(y, TextHeight(Chr(189)) + 10);
  94.         x := 0;
  95.       END;
  96.       IF ch <> #13 THEN OutTextXY(x, y, ch);
  97.     UNTIL ch = #$FF;                     (* bis #255 gedrückt wird   *)
  98.     RestoreCrtMode;                      (* Textmodus und Ende       *)
  99.     WriteLn('Ende ....');
  100.   END
  101.   ELSE                     (* Fehler bei der Initialisierung melden: *)
  102.     WriteLn('Grafik-Initialisierungsfehler Nummer: ', Abs(result));
  103. END.
  104.  
  105. (*===================================================================*)
  106.