#FontSelWin       = 2001
#FontSelGadGet    = 2002
Global FontText$, ListPOS.l, ListhWnd.l
;{ *** FontList Procedures  ***
Procedure CreateListFontWindow()
  hWnd = OpenWindow(#FontSelWin,0,0,270,140,"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ListhWnd = hWnd ;hWnd is lost by exit the Procedure ?? this trick help !!
  ListViewGadget(#FontSelGadGet,10,10,250,120)
  AddKeyboardShortcut(#FontSelWin,#PB_Shortcut_Return,1)    ; Return Button
  AddKeyboardShortcut(#FontSelWin,#PB_Shortcut_Down,2)      ; Cursor Down Button
  AddKeyboardShortcut(#FontSelWin,#PB_Shortcut_Up,3)          ; Cursor Up Button
  SetActiveGadget(#FontSelGadGet)
EndProcedure
Procedure EnumFontFamProc(*lpelf.ENUMLOGFONT, *lpntm.NEWTEXTMETRIC, FontType, lParam) ; GetFonts and trans. to List
  ;Debug PeekS(@*lpelf\elfLogFont\lfFaceName[0])
  AddGadgetItem (#FontSelGadGet,-1,PeekS(@*lpelf\elfLogFont\lfFaceName[0]))
  ; more informations can be get from the LOGFONT structure, for example adding following code:
  ; +", Height: "+Str(PeekL(@*lpelf\elfLogFont\lfHeight))+", Width: "+Str(PeekL(@*lpelf\elfLogFont\lfWidth)))
  SetGadgetState(#FontSelGadGet,0)
  FontText$= GetGadgetText(#FontSelGadGet)
  SetWindowText_(hWnd, FontText$)
  ProcedureReturn 1
EndProcedure
Procedure SysInfo_Fonts()
  hWnd = GetDesktopWindow_()
  hDC = GetDC_(hWnd)
  EnumFontFamilies_(hDC, 0, @EnumFontFamProc(), 0)
  ReleaseDC_ (hWnd, hDC)
EndProcedure
Procedure FontListEvent()
  Repeat
    
    EventID.l = WaitWindowEvent()
    FontText$= GetGadgetText(#FontSelGadGet)
    SetWindowText_(ListhWnd, FontText$)
    Select EventID
      Case #PB_Event_Menu
        If EventMenu()=1 ;  Return Button
          FontText$= GetGadgetText(#FontSelGadGet)
          ListPOS=GetGadgetState(#FontSelGadGet)
          MessageRequester("FontInformation", FontText$, 0)
          SetGadgetState(#FontSelGadGet,ListPOS)
        EndIf
        If EventMenu()=2 ; Cursor Down Button
          FontText$= GetGadgetText(#FontSelGadGet)
          ListPOS=GetGadgetState(#FontSelGadGet)
          SetGadgetState(#FontSelGadGet,ListPOS+1)
        EndIf
        If EventMenu()=3 ; Cursor Up Button
          FontText$= GetGadgetText(#FontSelGadGet)
          ListPOS=GetGadgetState(#FontSelGadGet)
          SetGadgetState(#FontSelGadGet,ListPOS-1)
          If ListPOS =< 0
            SetGadgetState(#FontSelGadGet,0)
          EndIf
        EndIf
        
      Case #PB_Event_CloseWindow ; If the user has pressed on the close button
        Quit = 1
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #FontSelGadGet
            Select EventType()
              Case #PB_EventType_LeftDoubleClick
                FontText$= GetGadgetText(#FontSelGadGet)
                MessageRequester("FontInformation", FontText$, 0)
            EndSelect
        EndSelect
    EndSelect
  Until Quit = 1
  CloseWindow(#FontSelWin)
EndProcedure
;}

CreateListFontWindow()
SysInfo_Fonts()
FontListEvent()
MessageRequester("FontList", "Programm Exit", 0)