home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / GPIFONT.BAS < prev    next >
BASIC Source File  |  1989-09-13  |  11KB  |  303 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: GpiFont.BAS
  4. '*
  5. '* Include File: GpiFont.BI
  6. '*
  7. '* Functions   :
  8. '*               GpiDeleteSetId
  9. '*               GpiQueryNumberSetIds
  10. '*               GpiQuerySetIds
  11. '*               GpiLoadFonts
  12. '*               GpiUnloadFonts
  13. '*               GpiCreateLogFont
  14. '*               GpiQueryFonts
  15. '*               GpiQueryFontMetrics
  16. '*               GpiQueryKerningPairs
  17. '*               GpiQueryWidthTable
  18. '*               GpiSetCp
  19. '*               GpiQueryCp
  20. '*               GpiQueryFontFileDescriptions
  21. '*               GpiSetCharSet
  22. '*               GpiQueryCharSet
  23. '*
  24. '* Description : This program demonstrates the Font functions.
  25. '*               These functions allow the programmer to change
  26. '*               font types and sizes, as well as to query the
  27. '*               font metrics other font related information.
  28. '***********************************************************
  29.  
  30. '*********         Initialization section        ***********
  31.  
  32. REM $INCLUDE: 'OS2Def.BI'
  33. REM $INCLUDE: 'PMBase.BI'
  34. REM $INCLUDE: 'WinMan1.BI'
  35. REM $INCLUDE: 'GpiFont.BI'
  36. REM $INCLUDE: 'GpiCont.BI'
  37. REM $INCLUDE: 'GpiLine.BI'
  38. REM $INCLUDE: 'GpiChar.BI'
  39.  
  40. DIM aqmsg AS QMSG
  41.  
  42. flFrameFlags& = FCFTITLEBAR      OR FCFSYSMENU OR _
  43.                 FCFSIZEBORDER    OR FCFMINMAX  OR _
  44.                 FCFSHELLPOSITION OR FCFTASKLIST
  45.  
  46. szClientClass$ = "ClassName" + CHR$(0)
  47.  
  48. hab& = WinInitialize    (0)
  49. hmq& = WinCreateMsgQueue(hab&, 0)
  50.  
  51. bool% = WinRegisterClass(_
  52.         hab&,_
  53.         MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  54.         RegBas,_
  55.         0,_
  56.         0)
  57.  
  58. hwndFrame& = WinCreateStdWindow (_
  59.              HWNDDESKTOP,_
  60.              WSVISIBLE,_
  61.              MakeLong (VARSEG(flFrameFlags&), VARPTR(flFrameFlags&)),_
  62.              MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  63.              0,_
  64.              0,_
  65.              0,_
  66.              0,_
  67.              MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  68.  
  69. '**************         Message loop         ***************
  70.  
  71. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  72.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  73. WEND
  74.  
  75. '***********         Finalize section        ***************
  76.  
  77. bool% = WinDestroyWindow  (hwndFrame&)
  78. bool% = WinDestroyMsgQueue(hmq&)
  79. bool% = WinTerminate      (hab&)
  80.  
  81. END
  82.  
  83. '***********         Window procedure        ***************
  84.  
  85. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  86.      DIM ClientRect AS RECTL
  87.      ClientWndProc& = 0
  88.      SELECT CASE msg%
  89.      CASE WMPAINT     'Paint the window with background color
  90.         bool% = WinInvalidateRect(hwnd&, 0, 0)
  91.         hps&  = WinBeginPaint(hwnd&, 0,_
  92.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  93.         bool% = WinFillRect(hps&,_
  94.         MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)),0)
  95.  
  96.         CALL GPIFontTST(hps&)
  97.  
  98.         bool% = WinEndPaint(hps&)
  99.      CASE ELSE         'Pass control to system for other messages
  100.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  101.      END SELECT
  102. END FUNCTION
  103.  
  104.  
  105. SUB GPIFontTST(hps AS LONG)
  106.  
  107.    SHARED hab&
  108.  
  109.    DIM ptl AS POINTL
  110.  
  111.    OPEN "GpiFont.OUT" FOR OUTPUT AS #1
  112.  
  113.    dim fat AS FATTRS
  114.    CodePage% = GpiQueryCp(hps)
  115.    PRINT #1, "GpiQueryCp: ", CodePage%
  116.  
  117.    bool% = GpiSetCp(hps, CodePage%)
  118.    PRINT #1, "GpiSetCp: ", CodePage%
  119.  
  120.    ptl.x = 0 : ptl.y = 100           ' Show default font for reference
  121.    DisplayString$ = "Programs start in System Font" + CHR$(0)
  122.    GpiReturn& = GpiCharStringAt(hps,_
  123.                 MakeLong(VARSEG(ptl), VARPTR(ptl)),_
  124.                 LEN(DisplayString$),_
  125.                 MakeLong(VARSEG(DisplayString$), SADD(DisplayString$)))
  126.  
  127.    fat.usRecordLength  = LEN(fat)
  128.    fat.usCodePage      = CodePage%
  129.    fat.lMaxBaseLineExt = 12
  130.    fat.lAveCharWidth   = 12
  131.    fat.fsType          = FATTRTYPEFIXED
  132.    fat.fsFontUse       = FATTRFONTUSENOMIX
  133.    fat.szFacename      = "Courier" + CHR$(0)
  134.    FontReturn& = GpiCreateLogFont(hps, 0, 1&,_
  135.                  MakeLong(VARSEG(fat), VARPTR(fat)))
  136.    PRINT #1, "GpiCreateLogFont: ",FontReturn&
  137.  
  138.    bool% = GpiSetCharSet(hps, 1&)
  139.    PRINT #1, "GpiSetCharSet: ", bool%
  140.  
  141.    ptl.x = 0 : ptl.y = 90            ' Show that we have changed the font
  142.    DisplayString$ = "Now in Courier..." + CHR$(0)
  143.    GpiReturn& = GpiCharStringAt(hps,_
  144.                 MakeLong(VARSEG(ptl), VARPTR(ptl)),_
  145.                 LEN(DisplayString$),_
  146.                 MakeLong(VARSEG(DisplayString$), SADD(DisplayString$)))
  147.  
  148.    DIM fm AS FONTMETRICS
  149.  
  150.    bool% = GpiQueryFontMetrics(hps, LEN(fm), MakeLong(VARSEG(fm), VARPTR(fm)))
  151.  
  152.    PRINT #1, "GpiQueryFontMetrics: ", bool%
  153.    PRINT #1, ""
  154.    PRINT #1, "Font Metrics"
  155.    PRINT #1, "--------------------------------------"
  156.  
  157.    PRINT #1, "szFamilyName:        "; fm.szFamilyName
  158.    PRINT #1, "szFacename:          "; fm.szFacename
  159.    PRINT #1, "idRegistry:          "; fm.idRegistry
  160.    PRINT #1, "usCodePage:          "; fm.usCodePage
  161.    PRINT #1, "lEmHeight:           "; fm.lEmHeight
  162.    PRINT #1, "lXHeight:            "; fm.lXHeight
  163.    PRINT #1, "lMaxAscender:        "; fm.lMaxAscender
  164.    PRINT #1, "lMaxDescender:       "; fm.lMaxDescender
  165.    PRINT #1, "lLowerCaseAscent:    "; fm.lLowerCaseAscent
  166.    PRINT #1, "lLowerCaseDescent:   "; fm.lLowerCaseDescent
  167.    PRINT #1, "lInternalLeading:    "; fm.lInternalLeading
  168.    PRINT #1, "lExternalLeading:    "; fm.lExternalLeading
  169.    PRINT #1, "lAveCharWidth:       "; fm.lAveCharWidth
  170.    PRINT #1, "lMaxCharInc:         "; fm.lMaxCharInc
  171.    PRINT #1, "lEmInc:              "; fm.lEmInc
  172.    PRINT #1, "lMaxBaselineExt:     "; fm.lMaxBaselineExt
  173.    PRINT #1, "sCharSlope:          "; fm.sCharSlope
  174.    PRINT #1, "sInlineDir:          "; fm.sInlineDir
  175.    PRINT #1, "sCharRot:            "; fm.sCharRot
  176.    PRINT #1, "usWeightClass:       "; fm.usWeightClass
  177.    PRINT #1, "usWidthClass:        "; fm.usWidthClass
  178.    PRINT #1, "sXDeviceRes:         "; fm.sXDeviceRes
  179.    PRINT #1, "sYDeviceRes:         "; fm.sYDeviceRes
  180.    PRINT #1, "sFirstChar:          "; fm.sFirstChar
  181.    PRINT #1, "sLastChar:           "; fm.sLastChar
  182.    PRINT #1, "sDefaultChar:        "; fm.sDefaultChar
  183.    PRINT #1, "sBreakChar:          "; fm.sBreakChar
  184.    PRINT #1, "sNominalPointSize:   "; fm.sNominalPointSize
  185.    PRINT #1, "sMinimumPointSize:   "; fm.sMinimumPointSize
  186.    PRINT #1, "sMaximumPointSize:   "; fm.sMaximumPointSize
  187.    PRINT #1, "fsType:              "; fm.fsType
  188.    PRINT #1, "fsDefn:              "; fm.fsDefn
  189.    PRINT #1, "fsSelection:         "; fm.fsSelection
  190.    PRINT #1, "fsCapabilities:      "; fm.fsCapabilities
  191.    PRINT #1, "lSubscriptXSize:     "; fm.lSubscriptXSize
  192.    PRINT #1, "lSubscriptYSize:     "; fm.lSubscriptYSize
  193.    PRINT #1, "lSubscriptXOffset:   "; fm.lSubscriptXOffset
  194.    PRINT #1, "lSubscriptYOffset:   "; fm.lSubscriptYOffset
  195.    PRINT #1, "lSuperscriptXSize:   "; fm.lSuperscriptXSize
  196.    PRINT #1, "lSuperscriptYSize:   "; fm.lSuperscriptYSize
  197.    PRINT #1, "lSuperscriptXOffset: "; fm.lSuperscriptXOffset
  198.    PRINT #1, "lSuperscriptYOffset: "; fm.lSuperscriptYOffset
  199.    PRINT #1, "lUnderscoreSize:     "; fm.lUnderscoreSize
  200.    PRINT #1, "lUnderscorePosition: "; fm.lUnderscorePosition
  201.    PRINT #1, "lStrikeoutSize:      "; fm.lStrikeoutSize
  202.    PRINT #1, "lStrikeoutPosition:  "; fm.lStrikeoutPosition
  203.    PRINT #1, "sKerningPairs:       "; fm.sKerningPairs
  204.    PRINT #1, "sReserved:           "; fm.sReserved
  205.    PRINT #1, "lMatch:              "; fm.lMatch
  206.    PRINT #1, ""
  207.  
  208.    NumberIds& = GpiQueryNumberSetIds(hps)
  209.    PRINT #1, "GpiQueryNumberSetIds: ", NumberIds&
  210.  
  211.    REDIM alTypes(NumberIds&) AS LONG
  212.    REDIM str8(NumberIds&) AS STRING * 9
  213.  
  214.    REDIM alcid(NumberIds&) AS LONG
  215.  
  216.    bool% = GpiQuerySetIds(hps, NumberIds&,_
  217.            MakeLong(VARSEG(alTypes(0)), VARPTR(alTypes(0))),_
  218.            MakeLong(VARSEG(str8(0)),    VARPTR(str8(0))),_
  219.            MakeLong(VARSEG(alcid(0)),   VARPTR(alcid(0))))
  220.    PRINT #1, "GpiQuerySetIds: ", bool%
  221.  
  222.    PRINT #1, ""
  223.    PRINT #1, "Type","Name","Local Identifier"
  224.    PRINT #1, "--------------------------------------------"
  225.  
  226.    FOR i% = 0 TO NumberIds& - 1
  227.       PRINT #1, alTypes(i%), str8(i%), alcid(i%)
  228.    NEXT
  229.  
  230.    PRINT #1, ""
  231.  
  232.    REDIM akrnpr(fm.SkerningPairs) AS KERNINGPAIRS
  233.    bool% = GpiQueryKerningPairs(hps, fm.sKerningPairs,_
  234.            MakeLong(VARSEG(akrnpr(0)), VARPTR(akrnpr(0))))
  235.    PRINT #1, "GpiQueryKerningPairs: ", bool%
  236.  
  237.    PRINT #1, ""
  238.    PRINT #1, "Kerning Pairs"
  239.    PRINT #1, "-------------"
  240.  
  241.    FOR i% = 0 TO fm.SkerningPairs - 1
  242.       PRINT #1, akrnpr(i%).sFirstChar, akrnpr(i%).sSecondChar,_
  243.                 akrnpr(i%).sKerningAmount
  244.    NEXT
  245.  
  246.    PRINT #1, ""
  247.  
  248.    REDIM alWidths(5) AS LONG
  249.    bool% = GpiQueryWidthTable(hps, 65, 5,_
  250.            MakeLong(VARSEG(alWidths(0)), VARPTR(alWidths(0))))
  251.    PRINT #1, "GpiQueryWidthTable: ", bool%
  252.  
  253.    PRINT #1, ""
  254.    PRINT #1, "Widths"
  255.    PRINT #1, "------"
  256.  
  257.    FOR i% = 0 TO 4
  258.       PRINT #1, alWidths(i%)   ' In Courier all widths are the same
  259.    NEXT
  260.  
  261.    PRINT #1, ""
  262.  
  263.    bool% = GpiSetCharSet(hps, 0&)          ' release the font before deleting
  264.    PRINT #1, "GpiSetCharSet: ", bool%
  265.  
  266.    bool% = GpiDeleteSetId(hps, 1&)         ' delete the logical font
  267.    PRINT #1, "GpiDeleteSetId: ", bool%
  268.  
  269.    FontReturn& = GpiQueryNumberSetIds(hps)
  270.    PRINT #1, "GpiQueryNumberSetIds: ", FontReturn&
  271.  
  272. ' Note:  The following are commented out because the file Helv.fon
  273. '        needs to be in the directory that this program is run from.
  274. '        To demonstate these routines copy Helv.fon over to the directory
  275. '        the program is to be run from, then un-comment the following lines
  276. '        and re-compile.
  277. '        The .FON file must be in the current path - even if it is in the
  278. '        current directory it will only look for it on the path.
  279.  
  280. '   ModuleName$ = "helv.fon" + CHR$(0)
  281. '   bool% = GpiLoadFonts(hab&,_
  282. '           MakeLong(VARSEG(ModuleName$), SADD(ModuleName$)))
  283. '   PRINT #1, "GpiLoadFonts: ", bool%
  284. '
  285. '   QueryFontNULL& = 0
  286. '   FontReturn& = GpiQueryFonts(hps, QFPRIVATE, 0,_
  287. '                 MakeLong(VARSEG(QueryFontNULL&), VARPTR(QueryFontNULL&)),_
  288. '                 0, 0)
  289. '   PRINT #1, "Number Fonts Loaded: ", FontReturn&
  290. '
  291. '   FontReturn& = GpiQueryFontFileDescriptions(hab&,_
  292. '                 MakeLong(VARSEG(ModuleName$), SADD(ModuleName$)),_
  293. '                 MakeLong(VARSEG(cFonts&), VARPTR(cFonts&)), 0)
  294. '   PRINT #1, "Number Fonts In File: ", FontReturn&
  295. '
  296. '   bool% = GpiUnloadFonts(hab&,_
  297. '           MakeLong(VARSEG(ModuleName$), SADD(ModuleName$)))
  298. '   PRINT #1, "GpiUnloadFonts: ", bool%
  299.  
  300.    CLOSE #1
  301.  
  302. END SUB
  303.