/*
 ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
 º  Program..: _DCFONT.PRG                                  º
 º  Author...: Roger J. Donnay                              º
 º  Notice...: (c) DONNAY Software Designs 1987-1998        º
 º  Date.....: Apr  7, 1998                                 º
 º  Notes....: dCLIP Font Functions                         º
 º                                                          º
 º  Functions:  dc_fontnames(), dc_fontsizes()              º
 ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
*/

#INCLUDE "xbp.CH"
#include "dcdialog.ch"

FUNCTION DC_FontNames()

LOCAL aFonts := { ;
  'Arial',;
  'Symbol',;
  'Lucida Console',;
  'MS Sans Serif',;
  'MS Serif',;
  'Small Fonts',;
  'System',;
  'Terminal' }

RETURN aFonts

/* ------------------- */

FUNCTION DC_FontSizes()

RETURN { 6,7,8,10,12,14,16,18,20,22,24,26,28,30,32,36,48 }

*---------------------

FUNCTION DC_PopFont( cFont, oFont, cTitle )

LOCAL oXbp := SetAppFocus(), cFamilyName := '', oPS, oPrinter, ;
      bErrorBlock, oFontDlg, cFontName, oDialog, nPointSize

DEFAULT cFont := '8.Arial', ;
        cTitle := 'Choose a Font'

cFont := StrTran(cFont,' UNDERSCORE','')
cFont := StrTran(cFont,' Underscore','')
cFont := StrTran(cFont,' UnderScore','')
cFont := StrTran(cFont,' underscore','')

cFont := StrTran(cFont,' BOLD','')
cFont := StrTran(cFont,' Bold','')
cFont := StrTran(cFont,' bold','')

cFont := StrTran(cFont,' ITALIC','')
cFont := StrTran(cFont,' Italic','')
cFont := StrTran(cFont,' italic','')

cFont := Alltrim(cFont)
cFamilyName := Substr(cFont,At('.',cFont)+1)
oDialog := XbpDialog():New()
oDialog:create()
oPS := oDialog:drawingArea:LockPs()
oFontDlg := XbpFontDialog():New(AppDeskTop(),,,oPS)
oFontDlg:nominalPointSize := Val(cFont)
oFontDlg:familyname := cFamilyName
oFontDlg:title := cTitle

oFontDlg:create()

bErrorBlock := ErrorBlock({||_FontError()})
BEGIN SEQUENCE
oFont := oFontDlg:display( XBP_DISP_APPMODAL )

cFontName := ''
IF Valtype(oFont) = 'O'
  cFontName := Alltrim(Str(oFont:nominalPointSize))+'.'+ ;
               oFont:compoundName
ENDIF
oPS:destroy()
oDialog:destroy()
oFontDlg:destroy()
DC_ClearEvents()

END SEQUENCE
ErrorBlock(bErrorBlock)
SetAppFocus( oXbp )

RETURN cFontName

* --------------------

STATIC PROCEDURE _FontError()
BREAK
RETURN

/*
FUNCTION DC_GetFont( cCompoundName, nPointSize, nCodePage )

LOCAL aFontList := XbpFont():new():list(), i, oFont

DEFAULT nCodePage := 0, ;
        cCompoundName := '', ;
        nPointSize := 0
*/

* ---------------------

FUNCTION DC_FontConfigure( oFont, cFont, nCodePage, oPS, aScaleFactor )

LOCAL cCompoundName, cFamilyName, nPointSize, oError , nSeconds := seconds(), ;
      lError, bError := ErrorBlock({||Break()})

Static nLastTime

if valtype(nLastTime) # 'N'
    nLastTime := 0
endif
if nLastTime+60 < nSeconds .or. nSeconds < nLastTime
    sleep(5)
endif
nLastTime := seconds()

  cCompoundName := Alltrim(cFont)
  IF 'UNDERSCORE' $ Upper(cCompoundName)
    cCompoundName := StrTran(cCompoundName,' UNDERSCORE','')
    cCompoundName := StrTran(cCompoundName,' Underscore','')
    cCompoundName := StrTran(cCompoundName,' UnderScore','')
    cCompoundName := StrTran(cCompoundName,' underscore','')
  ENDIF
  IF 'BOLD' $ Upper(cCompoundName)
    cCompoundName := StrTran(cCompoundName,' BOLD','')
    cCompoundName := StrTran(cCompoundName,' Bold','')
    cCompoundName := StrTran(cCompoundName,' bold','')
  ENDIF
  IF 'ITALIC' $ Upper(cCompoundName)
    cCompoundName := StrTran(cCompoundName,' ITALIC','')
    cCompoundName := StrTran(cCompoundName,' Italic','')
    cCompoundName := StrTran(cCompoundName,' italic','')
  ENDIF
  IF 'SERIF' $ Upper(cCompoundName)
    cCompoundName := StrTran(cCompoundName,'MS Sans Serif','Arial')
    cCompoundName := StrTran(cCompoundName,'MS Serif','Arial')
  ENDIF

  cFamilyName := Alltrim(StrTran(DC_Token(cCompoundName,'.',2),'.',' '))
  cFamilyName := StrTran(cFamilyName,'  ',' ')

  nPointSize := Val(DC_Token(cCompoundName,'.',1))

  IF Valtype(aScaleFactor) == 'A' .AND. aScaleFactor[5]
    nPointSize *= aScaleFactor[3]
    cCompoundName := Alltrim(Str(Int(nPointSize))) + '.' + cFamilyName
  ENDIF

  lError := .f.
  IF Valtype(oFont) # 'O'
    BEGIN SEQUENCE
    lError := .t.
    oFont := XbpFont():new( oPS )
    oFont:create(cCompoundName)
    lError := .f.
    END SEQUENCE
  ENDIF

  ErrorBlock(bError)

  IF lError
    DCMSGBOX 'OOPS. Something went wrong. Please try again.' ;
       FONT '10.Arial Bold' TIMEOUT 10
    BREAK
  ENDIF

  IF oFont:status() <= 0
    RETURN oFont
  ENDIF

  oFont:nominalPointSize := Int(nPointSize)
  oFont:generic := .t.

  IF Upper(cFamilyName) == 'TERMINAL' .AND. !Empty(oPS)
    oFont := XbpFont():new( oPS )
    oFont:nominalPointSize := nPointSize
    oFont:generic := .t.
    oFont:fixed := .t.
    oFont:familyName := cFamilyName
    oFont:create(cCompoundName)
  ELSE
    oFont:configure(cCompoundName)
  ENDIF

  IF Valtype(nCodePage) = 'N'
    oFont:codePage := nCodePage
  ENDIF

  IF '.UNDERSCORE' $ Upper(cFont) .OR. ' UNDERSCORE' $ Upper(cFont)
    oFont:UnderScore := .t.
  ENDIF

  IF '.BOLD' $ Upper(cFont) .OR. ' BOLD' $ Upper(cFont)
    oFont:bold := .t.
  ENDIF

  IF '.ITALIC' $ Upper(cFont) .OR. ' ITALIC' $ Upper(cFont)
    oFont:italic := .t.
  ENDIF

  oFont:configure()



RETURN oFont

* --------------

FUNCTION DC_FontCompoundName( oFont )

LOCAL cFont

cFont := Alltrim(Str(oFont:nominalPointSize)) + '.' + ;
         oFont:familyName + ;
         IIF(oFont:bold,' Bold','') + ;
         IIF(oFont:italic, ' Italic','') + ;
         IIF(oFont:underScore,' Underscore','')

RETURN cFont

* -------------

STATIC FUNCTION TrapError( oError, oFont,cFont,nCodePage,oPS,aScaleFactor )

wtl oFont, cFont, nCodePage, oPS, aScaleFactor

BREAK

RETURN nil