home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / qpdemo / fonts.pas < prev    next >
Pascal/Delphi Source File  |  1989-08-23  |  3KB  |  122 lines
  1.  
  2. PROGRAM fonts;
  3.  
  4. { FONTS.PAS demonstriert Schriftsatz-Funktionen einschl:
  5.  
  6.      _GetFontInfo       _RegisterFonts    _SetGTextVector
  7.      _GetGTextExtent    _SetFont          _UnregisterFonts
  8.      _OutGText
  9.  
  10.   Wir richten auch mit der Standardvariablen ExitProc eine
  11.   Abschlußprozedur ein.
  12. }
  13.  
  14. USES
  15.     MSGraph, Crt, Dos;
  16.  
  17. CONST
  18.     wrzv : CSTRING[2] = #$0d#$0a;
  19.  
  20. VAR
  21.     nfonts   : Integer;
  22.     liste    : STRING[20];
  23.     fonverz  : STRING[128];
  24.     vc       : _VideoConfig;
  25.     fi       : _FontInfo;
  26.     fontnum  : Byte;
  27.     x, y     : Word;
  28.     ch       : Char;
  29.     ergebnis : Integer;
  30.     enduspei : POINTER;
  31.  
  32. {============================= exit_fonts ==============================
  33.   Diese Abschlußprozedur wird automatisch bei jedem Programmabschluß
  34.   aufgerufen. Sie nimmt nach den Schriftsätzen Rücksetzung des
  35.   Videomodus vor und gibt den Schriftsatzspeicher wieder frei.
  36. }
  37. {$F+}
  38. PROCEDURE exit_fonts;
  39. {$F-}
  40. BEGIN
  41.     ExitProc := enduspei;
  42.     ergebnis := _SetVideoMode( _DefaultMode );
  43.     _UnRegisterFonts;
  44. END;
  45.  
  46. {=============================== int2str ===============================
  47.   Diese Funktion ergibt eine CSTRING, in der ihr Integerargument
  48.   enthalten ist.
  49. }
  50. FUNCTION int2str( x : Integer ) : CSTRING;
  51. VAR cs : CSTRING;
  52. BEGIN
  53.     Str( x, cs );
  54.     int2str := cs;
  55. END;
  56.  
  57. {========================= Programm-Hauptteil =========================}
  58.  
  59. BEGIN
  60.     enduspei := ExitProc;
  61.     ExitProc := @exit_fonts;
  62.  
  63.      { Kopfzeilen-Info aus allen verfügbaren .FON Dateien einlesen. }
  64.     fonverz :=  '*.FON';
  65.     nfonts := _RegisterFonts( fonverz );
  66.     IF (nfonts <= 0) THEN
  67.     BEGIN
  68.     _OutText( 'Vollständigen Pfadnamen der .FON-Dateien eingeben:');
  69.     Readln( fonverz );
  70.     IF fonverz[Length( fonverz )] <> '\' THEN fonverz := fonverz +
  71.                                   '\';
  72.     fonverz := fonverz + '*.FON';
  73.     nfonts := _RegisterFonts( fonverz );
  74.     IF (nfonts <= 0) THEN
  75.         BEGIN
  76.         _OutText( 'Fehler: kann Schriftsätze nicht registrtieren' );
  77.         Halt( 1 );    { Abort }
  78.         END;
  79.     END; { falls Schriftsätze nich zu finden sind }
  80.  
  81.      { Höchstmöglichen Grafikmodus einrichten und Konfiguration holen. }
  82.     IF (_SetVideoMode( _MaxResMode ) = 0) THEN Halt( 1 );
  83.     _GetVideoConfig( vc );
  84.  
  85.      { Alle Schriftsatznamen mittig am Bildschirm angeben. }
  86.     FOR fontnum := 1 TO nfonts DO
  87.     BEGIN
  88.     { Optionen-CString aufbauen. }
  89.     liste := 'n' + int2str( fontnum );
  90.     _ClearScreen( _GClearScreen );
  91.     _OutText( 'Font index  ' + int2str( _SetFont( liste ) ) + wrzv );
  92.     IF (_GetFontInfo( fi ) < 0) THEN
  93.         BEGIN
  94.         _OutText( 'Fehler: Schriftsatz-Info nicht verfügbar' );
  95.         ch := ReadKey;
  96.         END;
  97.  
  98.      { Zur Mittigstellung Textlänge und Schriftsatzhöhe verwenden. }
  99.     x := (vc.NumXPixels DIV 2) -
  100.          (_GetGTextExtent( fi.FaceName ) DIV 2);
  101.     y := (vc.NumYPixels DIV 2) - (fi.Ascent DIV 2);
  102.     _MoveTo( x, y );
  103.     IF (vc.NumColors > 2) THEN _SetColor( fontnum + 1 );
  104.     _SetGTextVector( 1, 0 );
  105.     _OutGText( fi.FaceName );
  106.  
  107.      { Gedrehten Text demonstrieren }
  108.     IF (vc.NumColors > 2) THEN _SetColor( fontnum + 1 );
  109.     _MoveTo( x - (2 * fi.Ascent), y );
  110.     _SetGTextVector( 0, 1 );
  111.     _OutGText( fi.FaceName );
  112.     _MoveTo( x + _GetGTextExtent( fi.FaceName ) +
  113.          (2 * fi.Ascent), y );
  114.     _SetGTextVector( 0, -1);
  115.     _OutGText( fi.FaceName );
  116.     ch := ReadKey;
  117.  
  118.      END; { FOR-Schleife }
  119.  
  120. END.
  121.  
  122.