' I had to do this experimentation for a project I'm working on.
' I thought I'd share the end results.
Code:
'-------------------------------------------------------------------------------
'
'  Font Investigation Program
'  by Ian Cairns - February 15/2000
'-------------------------------------------------------------------------------

$DIM ALL
$COMPILE EXE
$DEBUG ERROR ON
$OPTION VERSION4

#INCLUDE "WIN32API.INC"
#INCLUDE "COMDLG32.INC"

' Define Menu ID codes:
%IDM_SELECTFONT       = 1
%IDM_CHANGEBACKGROUND = 2
%IDM_EXIT             = 3

'------------------------------------------------------------------------------
GLOBAL szAppName AS ASCIIZ*21
'------------------------------------------------------------------------------

FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  lpCmdLine           AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG

  LOCAL Msg         AS tagMsg
  LOCAL wClass      AS WndClassEx
  LOCAL hWndMain    AS DWORD

' Initialize
'~~~~~~~~~~~
  szAppName              = "Font Display Program"

' Fill window class structure
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  wClass.cbSize        = SIZEOF(wClass)
  wClass.style         = %CS_HREDRAW OR %CS_VREDRAW
  wClass.lpfnWndProc   = CODEPTR(MainWndProc)
  wClass.cbClsExtra    = 0
  wClass.cbWndExtra    = 0
  wClass.hInstance     = hInstance
  wClass.hIcon         = LoadIcon  (%NULL, BYVAL %IDI_APPLICATION)
  wClass.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
  wClass.hbrBackground = GetStockObject(%WHITE_BRUSH)
  wClass.lpszMenuName  = VARPTR(szAppName)
  wClass.lpszClassName = VARPTR(szAppName)
  wClass.hIConSm       = LoadIcon  (%NULL, BYVAL %IDI_APPLICATION)


' Register the window-class
' ~~~~~~~~~~~~~~~~~~~~~~~~~
  RegisterClassEx wClass

' Create a window using the registered class
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  hWndMain = CreateWindow(szAppName, _               ' window class name
                          "Font Selection and Display", _ ' window caption
                          %WS_OVERLAPPEDWINDOW OR _
                          %WS_VSCROLL OR %WS_HSCROLL,_  ' window style
                          %CW_USEDEFAULT, _            ' initial x position
                          %CW_USEDEFAULT, _            ' initial y position
                          %CW_USEDEFAULT, _            ' initial x size
                          %CW_USEDEFAULT, _            ' initial y size
                          %HWND_DESKTOP, _             ' parent window handle
                          %NULL, _                     ' window menu handle
                          hInstance, _                 ' program instance handle
                          BYVAL %NULL)                 ' creation parameters

' Show Window
'~~~~~~~~~~~~
  ShowWindow hWndMain, iCmdShow
  UpdateWindow hWndMain

  WHILE GetMessage(Msg, %NULL, 0, 0)

    TranslateMessage Msg
    DispatchMessage Msg
  WEND

  FUNCTION = msg.wParam

END FUNCTION  ' WinMain

'------------------------------------------------------------------------------

FUNCTION MainWndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS LONG, _
                  BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG

  STATIC cxCaps      AS LONG,_
         cxChar      AS LONG,_
         cyChar      AS LONG,_
         cxClient    AS LONG,_
         cyClient    AS LONG,_
         iMaxWidth   AS LONG,_
         iVscrollPos AS LONG,_
         iVscrollMax AS LONG,_
         iHscrollPos AS LONG,_
         iHscrollMax AS LONG,_
         sz_Max      AS LONG,_
         hMenu       AS LONG, _
         hMenuPopup  AS LONG,_
         tm          AS TEXTMETRIC,_
         cf          AS CHOOSEFONTAPI, _
         lfFont      AS LOGFONT, _
         lfFontRGB   AS LONG,_
         hFont       AS LONG,_
         BackgroundKolor  AS CHOOSECOLORAPI

  DIM    FontInfo(1 : 15)      AS STATIC STRING, _
         tmpCustColors(0 : 15) AS STATIC DWORD

  LOCAL  hdc         AS LONG,_
         ps          AS PAINTSTRUCT,_
         si          AS SCROLLINFO,_
         x           AS LONG,_
         y           AS LONG,_
         i           AS LONG,_
         iPaintBeg   AS LONG,_
         iPaintEnd   AS LONG,_
         iVscrollInc AS LONG,_
         iHscrollInc AS LONG,_
         pointSize   AS LONG

  SELECT CASE wMsg
' ~~~~~~~~~~~~~~~~
    CASE %WM_CREATE
'   ~~~~~~~~~~~~~~~
      cf.lStructSize    = SIZEOF(cf)
      cf.hWndOwner      = hWnd
      cf.hDC            = %NULL
      cf.lpLogFont      = VARPTR(lfFont)
      cf.iPointSize     = 0
      cf.Flags          = %CF_INITTOLOGFONTSTRUCT OR %CF_EFFECTS OR %CF_BOTH' _
'                          OR %CF_TTONLY OR %CF_SCRIPTSONLY
      cf.rgbColors      = lfFontRGB
      cf.lCustData      = 0
      cf.lpfnHook       = %NULL
      cf.lpTemplateName = %NULL
      cf.hInstance      = %NULL
      cf.lpszStyle      = %NULL
      cf.nFontType      = 0
      cf.nSizeMin       = 0
      cf.nSizeMax       = 0

      CALL GetObject(GetStockObject(%SYSTEM_FONT), SIZEOF(lfFont), lfFont)
      hFont = CreateFontIndirect (lfFont)
      CALL SendMessage (hWnd, %WM_SETFONT, hFont, 0)

      BackgroundKolor.lStructSize    = SIZEOF(BackgroundKolor)
      BackgroundKolor.hwndOwner      = %NULL
      BackgroundKolor.hInstance      = %NULL
      BackgroundKolor.rgbResult      = RGB(&HFF, &HFF, &HFF)
      BackgroundKolor.lpCustColors   =  VARPTR(tmpCustColors())
      BackgroundKolor.Flags          = %CC_RGBINIT  OR %CC_FULLOPEN
      BackgroundKolor.lCustData      = 0
      BackgroundKolor.lpfnHook       = %NULL
      BackgroundKolor.lpTemplateName = %NULL

' Get Text Metrics
      hdc = GetDC (hWnd)
      CALL GetTextMetrics (hdc, tm)        'Get font parameters
      cxChar = tm.tmAveCharWidth           'Average character width
      IF (tm.tmPitchAndFamily AND 1) THEN  'Average uppercase width
        cxCaps = cxChar * 3 \ 2            '(same as cxChar for fixed
      ELSE                                 ' pitch, 150% for variable)
        cxCaps = cxChar
      END IF
      cyChar = tm.tmHeight + tm.tmExternalLeading  'Line spacing
      CALL ReleaseDC (hWnd, hdc)
      iMaxWidth = 30 * cxChar + cxCaps
      sz_Max = 15

' Create Menu
      hMenu = CreateMenu ()
      hMenuPopup = CreateMenu ()
      CALL AppendMenu (hMenuPopup, %MF_STRING,    %IDM_SELECTFONT,        "&Select Font ...")
      CALL AppendMenu (hMenuPopup, %MF_STRING,    %IDM_CHANGEBACKGROUND, "&Change Background Color ...")
      CALL AppendMenu (hMenuPopup, %MF_STRING,    %IDM_EXIT,               "E&xit")
      CALL AppendMenu (hMenu, %MF_POPUP, hMenuPopup, "&Menu")
      CALL SetMenu (hWnd, hMenu)

' Resize resets Scrollbars
    CASE %WM_SIZE
'   ~~~~~~~~~~~~~
      cxClient    = LOWRD(lParam)
      cyClient    = HIWRD(lParam)

' Set Vertical Scroll bar Range and page Size
      si.cbSize = LEN(si)
      si.fMask  = %SIF_RANGE OR %SIF_PAGE
      si.nMin = 0
      si.nMax = MAX%(1, sz_Max)
      si.nPage = cyClient / cyChar
      CALL SetScrollInfo(hWnd, %SB_VERT, si, %TRUE)

' Set Horizontal Scroll bar Range and page Size
      si.cbSize = LEN(si)
      si.fMask  = %SIF_RANGE OR %SIF_PAGE
      si.nMin = 0
      si.nMax = MAX%(1, 1 + iMaxWidth / cxChar)
      si.nPage = cxClient / cxChar
      CALL SetScrollInfo(hWnd, %SB_HORZ, si, %TRUE)

      FUNCTION = 0

    CASE %WM_VSCROLL
'   ~~~~~~~~~~~~~~~~
      si.cbSize = LEN(si)
      si.fMask  = %SIF_ALL
      CALL GetScrollInfo(hWnd, %SB_VERT, si)

      iVscrollPos = si.nPos
      SELECT CASE LOWRD(wParam)
        CASE %SB_TOP
          si.nPos = si.nMin
        CASE %SB_BOTTOM
          si.nPos = si.nMax
        CASE %SB_LINEUP
          DECR si.nPos
        CASE %SB_LINEDOWN
          INCR si.nPos
        CASE %SB_PAGEUP
          si.nPos = si.nPos - si.nPage
        CASE %SB_PAGEDOWN
          si.nPos = si.nPos + si.nPage
        CASE %SB_THUMBTRACK
          si.nPos = si.nTrackPos
      END SELECT
      si.fMask = %SIF_POS
      CALL SetScrollInfo(hWnd, %SB_VERT, si, %TRUE)
      CALL GetScrollInfo(hWnd, %SB_VERT, si)
      IF si.nPos <> iVscrollPos THEN
        CALL ScrollWindow(hWnd, 0, cyChar * (iVscrollPos - si.nPos), BYVAL %NULL, BYVAL %NULL)
        CALL UpdateWindow(hWnd)
      END IF
      FUNCTION = 0

    CASE %WM_HSCROLL
'   ~~~~~~~~~~~~~~~~
      si.cbSize = LEN(si)
      si.fMask  = %SIF_ALL
      CALL GetScrollInfo(hWnd, %SB_HORZ, si)

      iHscrollPos = si.nPos
      SELECT CASE LOWRD(wParam)
        CASE %SB_LEFT
          si.nPos = si.nMin
        CASE %SB_RIGHT
          si.nPos = si.nMax
        CASE %SB_LINELEFT
          DECR si.nPos
        CASE %SB_LINERIGHT
          INCR si.nPos
        CASE %SB_PAGELEFT
          si.nPos = si.nPos - si.nPage
        CASE %SB_PAGERIGHT
          si.nPos = si.nPos + si.nPage
        CASE %SB_THUMBTRACK
          si.nPos = si.nTrackPos
      END SELECT
      si.fMask = %SIF_POS
      CALL SetScrollInfo(hWnd, %SB_HORZ, si, %TRUE)
      CALL GetScrollInfo(hWnd, %SB_HORZ, si)
      IF si.nPos <> iHscrollPos THEN
        CALL ScrollWindow(hWnd, cxChar * (iHscrollPos - si.nPos), 0,BYVAL %NULL, BYVAL %NULL)
        CALL UpdateWindow(hWnd)
      END IF
      FUNCTION = 0

' Translate Key messages into Scroll Messages
    CASE %WM_KEYDOWN
'   ~~~~~~~~~~~~~~~~
      SELECT CASE (wParam)
        CASE %VK_HOME
          CALL SendMessage (hWnd, %WM_VSCROLL, %SB_TOP,      0)
        CASE %VK_END
          CALL SendMessage (hWnd, %WM_VSCROLL, %SB_BOTTOM,   0)
        CASE %VK_PRIOR     'PgUp
          CALL SendMessage (hWnd, %WM_VSCROLL, %SB_PAGEUP,   0)
        CASE %VK_NEXT      'PgDn
          CALL SendMessage (hWnd, %WM_VSCROLL, %SB_PAGEDOWN, 0)
        CASE %VK_UP
          CALL SendMessage (hWnd, %WM_VSCROLL, %SB_LINEUP,   0)
        CASE %VK_DOWN
          CALL SendMessage (hWnd, %WM_VSCROLL, %SB_LINEDOWN, 0)
        CASE %VK_LEFT
          CALL SendMessage (hWnd, %WM_HSCROLL, %SB_LINEUP,   0)
        CASE %VK_RIGHT
          CALL SendMessage (hWnd, %WM_HSCROLL, %SB_LINEDOWN, 0)
      END SELECT

    CASE %WM_PAINT
'   ~~~~~~~~~~~~~~
      ps.fErase = 0
      hdc = BeginPaint(hWnd, ps)   'initiates window painting
      CALL SelectObject (hdc, CreateFontIndirect(lfFont))

      CALL SetBkColor (hdc,  BackgroundKolor.rgbResult)
      CALL FillRect(hdc,ps.rcPaint, CreateSolidBrush (BackgroundKolor.rgbResult) )

      CALL SetBkMode (hdc, %TRANSPARENT)
      CALL SetTextColor (hdc, lfFontRGB)

' Get Vertical ScrollBar position
      si.cbSize = LEN(si)
      si.fMask  = %SIF_ALL
      CALL GetScrollInfo(hWnd, %SB_VERT, si)
      iVscrollPos = si.nPos

' Get Horizontal ScrollBar position
      si.cbSize = LEN(si)
      si.fMask  = %SIF_ALL
      CALL GetScrollInfo(hWnd, %SB_HORZ, si)
      iHscrollPos = si.nPos

' Set area for painting
      iPaintBeg = MAX%(0, iVscrollPos + ps.rcPaint.nTop / cyChar)
      iPaintEnd = MIN (sz_Max, iVscrollPos + ps.rcPaint.nBottom /cyChar +1)
      x = cxChar * (1 - iHscrollPos) - cxChar
      y = cyChar * (i - iVscrollPos) - cyChar

      FOR i = iPaintBeg TO iPaintEnd
        y = cyChar * (i - iVscrollPos) - cyChar
        CALL TextOut (hdc, x, y, BYCOPY FontInfo(i), LEN(FontInfo(i)))
      NEXT i
      CALL EndPaint(hWnd, ps)  'ends window painting
      FUNCTION = 0

' Actions based on Menu Choices:
    CASE %WM_COMMAND
'   ~~~~~~~~~~~~~~~~
      hMenu = GetMenu (hWnd)

      SELECT CASE LOWRD(wParam)
        CASE %IDM_SELECTFONT
'       ~~~~~~~~~~~~~~~~~~~~
          IF ChooseFont (cf) THEN
            lfFontRGB = cf.rgbColors
            CALL DeleteObject (hFont)
            hFont = CreateFontIndirect (lfFont)

            hdc = GetDC (hWnd)
            CALL SelectObject (hdc, hFont)
' Get Text Metrics
            CALL GetTextMetrics (hdc, tm)        'Get font parameters
' Alternate method of getting point size without going through ChooseFont:
'  pointSize =  (tm.tmHeight - tm.tmInternalLeading) * (72 / GetDeviceCaps(hdc, %LOGPIXELSY) )
            CALL ReleaseDC (hWnd, hdc)

            cxChar = tm.tmAveCharWidth           'Average character width
            IF (tm.tmPitchAndFamily AND 1) THEN  'Average uppercase width
              cxCaps = cxChar * 3 \ 2            '(same as cxChar for fixed
            ELSE                                 ' pitch, 150% for variable)
              cxCaps = cxChar
            END IF
            cyChar = tm.tmHeight + tm.tmExternalLeading  'Line spacing

            FontInfo(1)  = "FaceName: "       + lfFont.lfFacename
            FontInfo(2)  = "Point Size: "     + STR$(       cf.iPointSize/10)
            FontInfo(3)  = "PitchAndFamily: " + LTRIM$(STR$(lfFont.lfPitchAndFamily))
            FontInfo(4)  = "Height: "         + LTRIM$(STR$(lfFont.lfHeight))
            FontInfo(5)  = "Width: "          + LTRIM$(STR$(lfFont.lfWidth))
            FontInfo(6)  = "Escapement: "     + LTRIM$(STR$(lfFont.lfEscapement))
            FontInfo(7)  = "Orientation: "    + LTRIM$(STR$(lfFont.lfOrientation))
            FontInfo(8)  = "Weight: "         + LTRIM$(STR$(lfFont.lfWeight))
            FontInfo(9)  = "Italic: "         + LTRIM$(STR$(lfFont.lfItalic))
            FontInfo(10) = "Underline: "      + LTRIM$(STR$(lfFont.lfUnderline))
            FontInfo(11) = "Strikeout: "      + LTRIM$(STR$(lfFont.lfStrikeout))
            FontInfo(12) = "CharSet: "        + LTRIM$(STR$(lfFont.lfCharSet))
            FontInfo(13) = "OutPrecision: "   + LTRIM$(STR$(lfFont.lfOutPrecision))
            FontInfo(14) = "ClipPrecision: "  + LTRIM$(STR$(lfFont.lfClipPrecision))
            FontInfo(15) = "Quality: "        + LTRIM$(STR$(lfFont.lfQuality))
            iMaxWidth = 1
            FOR i = 1 TO 15
              iMaxWidth = MAX(iMaxWidth,LEN(FontInfo(i)) )
            NEXT i
            iMaxWidth = (iMaxWidth+1) * cxChar + cxCaps
            CALL InvalidateRect(hWnd, BYVAL %NULL, 1)            ' Paint Entire Client Window
            CALL SendMessage(hWnd, %WM_SIZE, cxClient, cyClient) ' Reset Scroll Bars
          END IF
          FUNCTION = 0

        CASE %IDM_CHANGEBACKGROUND
'       ~~~~~~~~~~~~~~~~~~~~~~~~~~
' Select Colored Brush into Device Context
          IF ChooseColor ( BackgroundKolor )  > 0 THEN
            CALL InvalidateRect(hWnd, BYVAL %NULL, 1) 'Paint Entire Client Window
          END IF
          FUNCTION = 0

        CASE %IDM_EXIT
'       ~~~~~~~~~~~~~~
          CALL DeleteObject(hFont)
          PostQuitMessage 0
          FUNCTION = 0

      END SELECT
    CASE %WM_DESTROY
'   ~~~~~~~~~~~~~~~~
      CALL DeleteObject(hFont)
      PostQuitMessage 0
      FUNCTION = 0
      EXIT FUNCTION

  END SELECT

  FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
'-----------------------------------------------------------------------------