home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / qpdemo / beispiel / sampler.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-24  |  1.5 KB  |  80 lines
  1.  
  2. PROGRAM Sampler;
  3.  
  4. USES
  5.     Crt, MSGraph;
  6.  
  7. CONST
  8.     CRLF   = #13+#10;
  9.     NFonts = 6;
  10.  
  11.     Textarten : ARRAY [1..2, 1..NFonts] OF CSTRING [8] =
  12.     (
  13.     ('roman', 'courier', 'helv', 'tms rmn', 'modern', 'script'),
  14.     ('ROMAN', 'COURIER', 'HELV', 'TMS RMN', 'MODERN', 'SCRIPT')
  15.     );
  16.  
  17.     Schriften : ARRAY [1..NFonts] OF CSTRING [12] =
  18.         (
  19.         ' t''roman''',
  20.         ' t''cour''',
  21.         ' t''helv''',
  22.         ' t''tms rmn''',
  23.         ' t''modern''',
  24.         ' t''script'''
  25.         );
  26.     FontPfad : CSTRING = '*.FON';
  27.  
  28. VAR
  29.     Liste   : CSTRING;
  30.     Vc              : _VideoConfig;
  31.     i, a            : Integer;
  32.     Stra            : STRING[3];
  33.     ch              : Char;
  34.  
  35.  
  36. BEGIN
  37.     {
  38.         Lesen der Header-Informationen aus allen .FON-Dateien
  39.         im aktuellen Verzeichnis
  40.     }
  41.  
  42.     a := _RegisterFonts (FontPfad);
  43.     IF a < 0 THEN
  44.         BEGIN
  45.         _OutText(' Fehler: Kein Eintragen der Fonts möglich ' +
  46.                 CRLF);
  47.         Halt(0);
  48.         END;
  49.  
  50.     a := _SetVideoMode(_MaxResMode);
  51.     Str (a,Stra);
  52.     _OutText (' MaxResMode = '+ Stra);
  53.  
  54.     _GetVideoConfig (Vc);
  55.  
  56.     FOR i:=1 TO NFonts DO
  57.         BEGIN
  58.         Liste :=Schriften[i] + 'bh30w24';
  59.         a := _SetFont (Liste);
  60.         IF (a <> -1) THEN
  61.             BEGIN
  62.             _SetColor (i+1);
  63.             _MoveTo (0, i*30);
  64.             _OutGText (Textarten[2,i]);
  65.             _MoveTo (Vc.NumXPixels DIV 2, i*30);
  66.             _OutGText (Textarten[1,i] + CRLF);
  67.             END
  68.         ELSE
  69.             BEGIN
  70.             a := _SetVideoMode (_DefaultMode);
  71.             _OutText (' Fehler: Kann Font nicht setzen');
  72.             Halt(1);
  73.             END;
  74.         END;
  75.     ch := ReadKey;
  76.     a := _SetVideoMode (_DefaultMode);
  77.     _UnRegisterFonts;
  78. END.
  79.  
  80.