home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l391_1 / 2.ddi / FONTDRAW.BA$ / FONTDRAW.bin
Encoding:
Text File  |  1992-08-19  |  4.2 KB  |  125 lines
  1. ' ------------------------------------------------------------------------
  2. ' Visual Basic for MS-DOS Font ToolKit Demo Program Support Module
  3. '
  4. ' Provides font display routine for specified font,
  5. ' screen mode, and text.
  6. '
  7. ' Font display support comes from the Font tooklit.
  8. ' To run this program you must use the supplied
  9. ' library (FONT.LIB, FONTA.LIB) and Quick Library
  10. ' (FONT.QLB).
  11. '
  12. ' Copyright (C) 1982-1992 Microsoft Corporation
  13. '
  14. ' You have a royalty-free right to use, modify, reproduce
  15. ' and distribute the sample applications and toolkits provided with
  16. ' Visual Basic for MS-DOS (and/or any modified version)
  17. ' in any way you find useful, provided that you agree that
  18. ' Microsoft has no warranty, obligations or liability for
  19. ' any of the sample applications or toolkits.
  20. ' ------------------------------------------------------------------------
  21.  
  22. ' Include file containing Font Toolkit procedure
  23. ' declarations and variable definitions.
  24. '$INCLUDE: 'font.bi'
  25.  
  26. ' Variable to hold font information.
  27. DIM SHARED FI AS FontInfo
  28.  
  29. ' Font display routine.
  30. ' Display supplied text in indicated font and screen mode.
  31. '
  32. SUB DisplayFont (Font$, ScreenMode%, Text$)
  33.     ' Set the maximum number of fonts that can be loaded
  34.     ' Note, one font file can contain multiple fonts.
  35.     SetMaxFonts 10, 10
  36.  
  37.     ' Register selected font file.
  38.     Reg% = RegisterFonts(Font$)
  39.  
  40.     ' If an error has occurred, display error and exit.
  41.     ' Note, if font file is currently locked (sharing violation),
  42.     ' a font file not found error will be generated.
  43.     IF FontErr THEN
  44.         MSGBOX "Font cannot be displayed (FontErr = " + STR$(FontErr) + ").", 0, "Font Toolkit Demo"
  45.         EXIT SUB
  46.     ELSEIF Reg% = 0 THEN
  47.         MSGBOX "Only vector fonts can be displayed.", 0, "Font Toolkit Demo"
  48.         EXIT SUB
  49.     END IF
  50.  
  51.     ' Load all fonts contained in font file.
  52.     StrLen% = Reg% * 3 - 1
  53.     IF Reg% > 9 THEN StrLen% = StrLen% + Reg% - 9
  54.     LoadStr$ = LEFT$("N1/N2/N3/N4/N5/N6/N7/N8/N9/N10", StrLen%)
  55.     TotalLoad% = LoadFont(LoadStr$)
  56.  
  57.     ' If an error has occurred, display error and exit.
  58.     IF FontErr THEN
  59.         MSGBOX "Font cannot be displayed (FontErr = " + STR$(FontErr) + ").", 0, "Font Toolkit Demo"
  60.         EXIT SUB
  61.     END IF
  62.  
  63.     ' Hide form.
  64.     SCREEN.HIDE
  65.     ' Switch to given graphics mode to display font.
  66.     SCREEN ScreenMode%
  67.  
  68.     ' Determine proper characteristics for screen mode.
  69.     SELECT CASE ScreenMode%
  70.         CASE 1: XS% = 160: YS% = 100
  71.         CASE 2: XS% = 320: YS% = 100
  72.         CASE 3: XS% = 360: YS% = 174
  73.         CASE 4: XS% = 320: YS% = 200
  74.         CASE 7: XS% = 160: YS% = 100
  75.         CASE 8: XS% = 320: YS% = 100
  76.         CASE 9: XS% = 320: YS% = 175
  77.         CASE 10: XS% = 320: YS% = 175
  78.         CASE 11: XS% = 320: YS% = 240
  79.         CASE 12: XS% = 320: YS% = 240
  80.         CASE 13: XS% = 160: YS% = 100
  81.     END SELECT
  82.  
  83.     ' Display each font contained in the file.
  84.     FOR i% = 1 TO TotalLoad%
  85.         CLS
  86.  
  87.         ' Get the font information.
  88.         SelectFont i%
  89.         GetFontInfo FI
  90.         SetGTextDir 0
  91.         SetGTextColor 14
  92.  
  93.         ' Display font name and size.
  94.         Length% = OutGText(1, 1, RTRIM$(FI.FaceName))
  95.         Length% = OutGText(1, 1 + FI.PixHeight, LTRIM$(STR$(FI.Points) + " Point"))
  96.  
  97.         ' Display given text in current font.
  98.         FOR Dir% = 0 TO 3
  99.             SetGTextDir Dir%
  100.             SetGTextColor 15 - Dir%
  101.             SELECT CASE Dir%
  102.                 CASE 0: X% = XS%: Y% = YS% - FI.PixHeight
  103.                 CASE 1: X% = XS% - FI.PixHeight: Y% = YS%
  104.                 CASE 2: X% = XS%: Y% = YS% + FI.PixHeight
  105.                 CASE 3: X% = XS% + FI.PixHeight: Y% = YS%
  106.             END SELECT
  107.             Length% = OutGText(CSNG(X%), CSNG(Y%), Text$)
  108.         NEXT Dir%
  109.  
  110.         ' Display prompt to continue to next font.
  111.         SetGTextDir 0
  112.         SetGTextColor 14
  113.         prompt$ = "Press any key to continue"
  114.         Length% = GetGTextLen(prompt$)
  115.         Length% = OutGText(2 * XS% - Length% - 10, 2 * YS% - FI.PixHeight - 1, prompt$)
  116.         DO UNTIL INKEY$ <> "": LOOP
  117.     NEXT i%
  118.  
  119.     ' Reset screen mode and redisplay the form.
  120.     SCREEN 0
  121.     WIDTH 80, 25
  122.     SCREEN.SHOW
  123. END SUB
  124.  
  125.