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