home *** CD-ROM | disk | FTP | other *** search
/ BUG 4 / BUGCD1997_05.BIN / aplic / clip4win / clip4win.exe / C4W30E.HUF / SOURCE / FONTENUM.PRG < prev    next >
Text File  |  1995-07-04  |  1KB  |  50 lines
  1. #include "windows.ch"
  2. #include "font.ch"
  3. #define    NO_C4WCLASS
  4. #include "commands.ch"
  5.  
  6.  
  7. function main()
  8. local    oApp, oWnd
  9.  
  10. CREATE APPLICATION oApp  WINDOW oWnd                    ;
  11.     TITLE "Clip-4-Win Font Enumeration Sample"            ;
  12.     ON WM_PAINT DoFonts(oWnd)
  13.  
  14. return nil
  15.  
  16.  
  17. static function DoFonts(hWnd)
  18. local    aFonts := GetFonts(), cNames := "", hDC := GetDC(hWnd), c
  19.  
  20. aeval(aFonts, {|a| c := a[LF_FaceName],                    ;
  21.                    cNames += chr(13) + left(c, at(chr(0), c) - 1)})
  22. DrawText(hDC, cNames)
  23. ReleaseDC(hWnd, hDC)
  24. return nil
  25.  
  26.  
  27. static function GetFonts()
  28. local    nFonts := 0, aFonts := {}
  29. local    hDC := GetDC(0)
  30.  
  31. EnumFontFamilies(hDC, , {|nFontPtr, nTMPtr, nFontType|            ;
  32.                          aadd(aFonts, GetFontInfo(nFontPtr, nFontType)) })
  33. ReleaseDC(0, hDC)
  34. return aFonts
  35.  
  36.  
  37. static function GetFontInfo(nFontPtr, nFontType)
  38. local    cLFont, a
  39. if C4W_And(nFontType, 4) != 0    // TrueType
  40.     cLFont = C4W_Peek(nFontPtr, NLF_BYTELEN)
  41.     a = Bin2A(cLFont, NLF_Bin2A)
  42. else
  43.     cLFont = C4W_Peek(nFontPtr, LF_BYTELEN)
  44.     a = Bin2A(cLFont, LF_Bin2A)
  45. endif
  46. // change some from BYTE to Clipper LOGIC
  47. aeval({LF_Italic, LF_Underline, LF_StrikeOut}, {|i| a[i] := (a[i] != 0)})
  48. //? left(a[LF_FaceName], at(chr(0), a[LF_FaceName]) - 1)
  49. return a
  50.