/*
 * Xailer source code:
 *
 * Font.prg
 * Clase TFont()
 *
 * Copyright 2003, 2007 Jose F. Gimenez
 * Copyright 2003, 2007 Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"


//--------------------------------------------------------------------------

CLASS XFont FROM TWinObject

PUBLIC:
   DATA oDevice
   DATA nCount    INIT 0

PUBLISHED:
   PROPERTY cName        INIT "MS Sans Serif" WRITE INLINE ::FcName := Value       , ::Recreate()
   PROPERTY nSize        INIT 8               WRITE INLINE ::SetSize( Value )      , ::Recreate()
   PROPERTY nWidth       INIT 0               WRITE INLINE ::FnWidth := Value      , ::Recreate()
   PROPERTY nHeight      INIT 0               WRITE INLINE ::FnHeight := Value     , ::Recreate()
   PROPERTY nStyle       INIT 0               WRITE INLINE ::FnStyle := Value      , ::Recreate() // 1=Italic, 2=Underline, 4=Strikeout
   PROPERTY nWeight      INIT 400             WRITE INLINE ::FnWeight := Value     , ::Recreate() // 100=Thin, 300=Ligth, 400=Normal, 700=Bold, 900=Heavy
   PROPERTY nOrientation INIT 0               WRITE INLINE ::FnOrientation := Value, ::Recreate()

   PROPERTY lBold        INIT .F.   WRITE INLINE ( ::FlBold := Value, ::nWeight  := IIf( Value, 700, 400 ) )
   PROPERTY lItalic      INIT .F.   WRITE INLINE ( ::FlItalic := Value, ::nStyle := IIf( Value, nOr( ::nStyle, 1 ), nExclude( ::nStyle, 1 ) ) )
   PROPERTY lUnderline   INIT .F.   WRITE INLINE ( ::FlUnderline := Value, ::nStyle := IIf( Value, nOr( ::nStyle, 2 ), nExclude( ::nStyle, 2 ) ) )
   PROPERTY lStrikeOut   INIT .F.   WRITE INLINE ( ::FlStrikeout := Value, ::nStyle := IIf( Value, nOr( ::nStyle, 4 ), nExclude( ::nStyle, 4 ) ) )

   PROPERTY nCharSet     INIT csDEFAULT   WRITE INLINE ( ::FnCharSet := Value, ::Recreate() )

PUBLIC:
   METHOD New( oDevice ) CONSTRUCTOR
   METHOD Create( cName, nSize, nStyle, nWeight, nOrientation, oDevice, nCharSet ) CONSTRUCTOR

   METHOD Destroy() // --> Nil
   METHOD Clone( oDevice ) // --> oFont

   METHOD Compare( oFont ) // --> lResult
   METHOD GetTextSize( cText, oCtl ) // --> aSize
   METHOD GetTextWidth( cText, oCtl )  INLINE ::GetTextSize( cText, oCtl )[ 1 ] // --> nWidth
   METHOD GetTextHeight( cText, oCtl ) INLINE ::GetTextSize( cText, oCtl )[ 2 ] // --> nHeight

   METHOD SaveToText() // --> cString
   METHOD RestoreFromText() // --> lSuccess

PROTECTED:
   METHOD Recreate() INLINE IIf( ! Empty( ::Handle ), ::Create(), )
   METHOD SizeToHeight( nSize )
   METHOD HeightToSize( nHeight )
   METHOD SetSize( nSize )

ENDCLASS

//--------------------------------------------------------------------------

METHOD New( oDevice ) CLASS XFont

   UPDATE ::oDevice TO oDevice

RETURN ::Super:New()

//--------------------------------------------------------------------------

METHOD Destroy() CLASS XFont

   IF !Empty( ::Handle )
      IF ( --::nCount ) <= 0
         DeleteObject( ::Handle )
         ::Handle := Nil
      ENDIF
   ENDIF

RETURN Nil

//--------------------------------------------------------------------------

METHOD Clone( oDevice ) CLASS XFont

   LOCAL oFont

   IF oDevice != Nil .OR. ::nWidth == 0
      oFont := TFont():Create( ::FcName, ::nSize, ::FnStyle, ::FnWeight, ::FnOrientation, oDevice, ::FnCharSet )
   ELSE
      oFont := TFont():Create( ::FcName, { ::nWidth, ::nHeight }, ::FnStyle, ::FnWeight, ::FnOrientation, , ::FnCharSet )
   ENDIF

RETURN oFont

//--------------------------------------------------------------------------

METHOD Compare( oFont ) CLASS XFont

   IF oFont != Nil
      RETURN oFont:cName        == ::cName .AND. ;
             oFont:nWidth       == ::nWidth .AND. ;
             oFont:nHeight      == ::nHeight .AND. ;
             oFont:nStyle       == ::nStyle .AND. ;
             oFont:nWeight      == ::nWeight .AND. ;
             oFont:nOrientation == ::nOrientation
   ENDIF

RETURN .F.

//--------------------------------------------------------------------------

METHOD GetTextSize( cText, oCtl ) CLASS XFont

   LOCAL aSize, hWnd

   DEFAULT cText TO ""

   IF oCtl == Nil
      hWnd := 0
   ELSEIF ValType( oCtl ) == "N"
      hWnd := oCtl
   ELSE
      hWnd := oCtl:Handle
   ENDIF

   aSize := GetTextSize( ::Handle, cText, hWnd )

RETURN aSize

//--------------------------------------------------------------------------

METHOD SizeToHeight( nSize ) CLASS XFont

   LOCAL hDC
   LOCAL nHeight
   LOCAL lDestroyDC

   IF ::oDevice != Nil .AND. !( ::oDevice == Screen )
      WITH OBJECT ::oDevice
         IF :lPreview
            hDC := :oPreviewDC:hPrinterDC
         ELSE
            hDC := :hDC
         ENDIF
         IF ( lDestroyDC := Empty( hDC ) )
            hDC := PrinterCreateDC()
         ENDIF
      END WITH
      nHeight := SizeToHeight( nSize, hDC )
      IF lDestroyDC
         PrinterEndDoc( hDC )
      ENDIF
   ELSE
      hDC     := GetDC( 0 )
      nHeight := SizeToHeight( nSize, hDC )
      ReleaseDC( 0, hDC )
   ENDIF

RETURN nHeight

//--------------------------------------------------------------------------

METHOD HeightToSize( nHeight ) CLASS XFont

   LOCAL hDC
   LOCAL nSize

   IF ::oDevice != Nil
      WITH OBJECT ::oDevice
         IF :lPreview
            hDC := :oPreviewDC:hPrinterDC
         ELSE
            hDC := :hDC
         ENDIF
      END WITH
      nSize := HeightToSize( nHeight, hDC )
   ELSE
      hDC   := GetDC( 0 )
      nSize := HeightToSize( nHeight, hDC )
      ReleaseDC( 0, hDC )
   ENDIF

RETURN nHeight

//--------------------------------------------------------------------------

METHOD SetSize( nSize ) CLASS XFont

   ::FnSize   := nSize
   ::FnWidth  := 0
   ::FnHeight := ::SizeToHeight( nSize )

RETURN Nil

//--------------------------------------------------------------------------

#pragma BEGINDUMP

#include <windows.h>
#include <xailer.h>

//--------------------------------------------------------------------------

#define FONT_ITALIC     1
#define FONT_UNDERLINE  2
#define FONT_STRIKEOUT  4

HDC CreatePrinterDC( void );

HB_FUNC_STATIC( XFONT_CREATE ) // TFont:Create( <cName>, <nSize>, <nStyle>, <nWeight>, <nOrientation>, <oDevice>, <nCharSet> ) --> Self
{
   PHB_ITEM Self = hb_stackSelfItem(), oDevice;
   LOGFONT lf;
   LPSTR cName;
   int nStyle, nSize;

   if( HB_ISCHAR( 1 ) )
      XA_ObjSendC( Self, "_FcName", cName = (LPSTR) hb_parc( 1 ) );
   else
      cName = XA_ObjGetC( Self, "FcName" );

   if( HB_ISNUM( 3 ) )
      {
      XA_ObjSendNL( Self, "_FnStyle", nStyle = hb_parnl( 3 ) );
      XA_ObjSendL( Self, "_FlItalic", ( nStyle & 1 ) );
      XA_ObjSendL( Self, "_FlUnderline", ( nStyle & 2 ) );
      XA_ObjSendL( Self, "_FlStrikeout", ( nStyle & 4 ) );
      }
   else
      nStyle = XA_ObjGetNL( Self, "FnStyle" );

   if( HB_ISNUM( 4 ) )
      XA_ObjSendNL( Self, "_FnWeight", lf.lfWeight = hb_parnl( 4 ) );
   else
      lf.lfWeight = XA_ObjGetNL( Self, "FnWeight" );
   XA_ObjSendL( Self, "_FlBold", ( lf.lfWeight >= 700 ) );

   if( HB_ISNUM( 5 ) )
      XA_ObjSendNL( Self, "_FnOrientation", lf.lfOrientation = hb_parnl( 5 ) );
   else
      lf.lfOrientation = XA_ObjGetNL( Self, "FnOrientation" );

	if( HB_ISOBJECT( 6 ) )
      XA_ObjSendItem( Self, "_oDevice", oDevice = hb_itemNew( hb_param( 6, HB_IT_OBJECT ) ) );
   else
      oDevice = XA_ObjGetItemCopy( Self, "oDevice" );

   if( HB_ISNUM( 7 ) )
      XA_ObjSendNL( Self, "_FnCharSet", lf.lfCharSet = hb_parnl( 7 ) );
   else
      lf.lfCharSet = XA_ObjGetNL( Self, "FnCharSet" );

   strncpy( lf.lfFaceName, cName, LF_FACESIZE );
   lf.lfEscapement = lf.lfOrientation;
   lf.lfItalic = ( nStyle & FONT_ITALIC );
   lf.lfUnderline = ( nStyle & FONT_UNDERLINE );
   lf.lfStrikeOut = ( nStyle & FONT_STRIKEOUT );
   lf.lfOutPrecision = OUT_DEFAULT_PRECIS;
   lf.lfClipPrecision = CLIP_DEFAULT_PRECIS;
   lf.lfQuality = DEFAULT_QUALITY;
   lf.lfPitchAndFamily = DEFAULT_PITCH;

   if( HB_ISARRAY( 2 ) )
      {
      XA_ObjSendNL( Self, "_FnWidth", lf.lfWidth = hb_parvnl( 2, 1 ) );
      XA_ObjSendNL( Self, "_FnHeight", lf.lfHeight = hb_parvnl( 2, 2 ) );
      XA_ObjSendNL( Self, "_FnSize", nSize = 0 );
      }
   else if( HB_ISNUM( 2 ) )
      XA_ObjSendNL( Self, "_FnSize", nSize = hb_parnl( 2 ) );
   else
      nSize = XA_ObjGetNL( Self, "FnSize" );

   if( nSize )
      {
      HDC hdc;

      if( oDevice && HB_IS_OBJECT( oDevice ) && !hb_clsIsParent( XA_ObjGetNL( oDevice, "ClassH" ), "XSCREEN" ) )
         {
         if( XA_ObjGetL( oDevice, "lPreview" ) )
            hdc = (HDC) XA_ObjGetNL( XA_ObjGetItem( oDevice, "oPreviewDC" ), "hPrinterDC" );
         else
            hdc = (HDC) XA_ObjGetNL( oDevice, "hDC" );
         if( hdc )
            XA_ObjSendNL( Self, "_FnHeight", lf.lfHeight = -MulDiv( nSize, GetDeviceCaps( hdc, LOGPIXELSY ), 72 ) );
         else
            {
            hdc = CreatePrinterDC();
            XA_ObjSendNL( Self, "_FnHeight", lf.lfHeight = -MulDiv( nSize, GetDeviceCaps( hdc, LOGPIXELSY ), 72 ) );
            EndDoc( hdc );
            DeleteDC( hdc );
            }
         }
      else
         {
         int nScale = XA_ObjGetNL( Application(), "nFontScale" );

         if( nScale == 0 )
            nScale = 100;
         if( nScale != 100 )
            lf.lfOutPrecision = OUT_TT_ONLY_PRECIS;
         hdc = GetDC( NULL );
         XA_ObjSendNL( Self, "_FnHeight", lf.lfHeight = -MulDiv( nSize, nScale * GetDeviceCaps( hdc, LOGPIXELSY ), 7200 ) );
         ReleaseDC( NULL, hdc );
         }
      XA_ObjSendNL( Self, "_FnWidth", lf.lfWidth = 0 );
      }
   else
      {
      lf.lfWidth = XA_ObjGetNL( Self, "nWidth" );
      lf.lfHeight = XA_ObjGetNL( Self, "nHeight" );
      }

   hb_itemRelease( oDevice );

   XA_ObjSend( Self, "Destroy" );
   XA_ObjSendNL( Self, "_Handle", (long) CreateFontIndirect( &lf ) );

   hb_itemReturnForward( Self );
}

//--------------------------------------------------------------------------

XA_FUNC( CREATEFONT ) // CreateFont( <nHeight>, <nWidth>, <nEscapement>, <nOrientation>, <nWeight>, <nStyle>, <cName>, <nCharSet> ) --> hFont
{
   DWORD Style = hb_parnl( 6 );

   hb_retnl( (long) CreateFont( hb_parnl( 1 ), hb_parnl( 2 ), hb_parnl( 3 ),
                                hb_parnl( 4 ), hb_parnl( 5 ),
                                ( Style & FONT_ITALIC ),
                                ( Style & FONT_UNDERLINE ),
                                ( Style & FONT_STRIKEOUT ),
                                hb_parnl( 8 ), OUT_DEFAULT_PRECIS,
                                CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
                                DEFAULT_PITCH, hb_parc( 7 ) ) );
}

//--------------------------------------------------------------------------

XA_FUNC( GETTEXTSIZE ) // GetTextSize( <hFont>, <cText>, <hWnd> ) --> aSize
{
   HFONT hFont = (HFONT) hb_parnl( 1 );
   HWND hWnd   = (HWND) hb_parnl( 3 );
   HFONT hOldFont;
   HDC hDC ;
   SIZE sz;

   if( !hWnd )
      hWnd = GetDesktopWindow();

   hDC = GetDC( hWnd );

   if( hFont )
      hOldFont = (HFONT) SelectObject( hDC, hFont );

   GetTextExtentPoint32( hDC, hb_parc( 2 ), hb_parclen( 2 ), &sz );

   if( hFont )
      SelectObject( hDC, hOldFont );

   ReleaseDC( hWnd, hDC );

   hb_reta( 2 );
   hb_storvni( sz.cx, -1, 1 );
   hb_storvni( sz.cy, -1, 2 );
}

//--------------------------------------------------------------------------

XA_FUNC( ADDFONTRESOURCE ) // AddFontResource( <cFilename> ) --> nFontsAdded
{
   hb_retni( AddFontResource( hb_parc( 1 ) ) );
}

//--------------------------------------------------------------------------

XA_FUNC( REMOVEFONTRESOURCE ) // RemoveFontResource( <cFilename> ) --> lSuccess
{
   hb_retl( RemoveFontResource( hb_parc( 1 ) ) );
}

//--------------------------------------------------------------------------

XA_FUNC( CREATESCALABLEFONTRESOURCE ) // CreateScalableFontResource( <nHidden>, <cResource>, <cFilename>, <cPath> ) --> lSuccess
{
   hb_retl( CreateScalableFontResource( hb_parnl( 1 ), hb_parc( 2 ),
                                        hb_parc( 3 ), hb_parc( 4 ) ) );
}

//--------------------------------------------------------------------------

XA_FUNC( GETFONTLANGUAGEINFO )   // GetFontLanguageInfo( <hDC> ) --> nLangInfo
{
   hb_retnl( GetFontLanguageInfo( (HDC) hb_parnl( 1 ) ) );
}

//--------------------------------------------------------------------------

XA_EXPORT int HeightToSize( int iHeight, HDC hDC ) // HeightToSize( <nHeight>, <hDC> ) --> int
{
   BOOL bDC = FALSE;
   int iSize;

   if( hDC )
      bDC = TRUE;
   else
      hDC = GetDC( 0 );

   if( iHeight < 0 )
      iHeight = - iHeight;

   iSize = MulDiv( iHeight, 72, GetDeviceCaps( hDC, LOGPIXELSY ) );

   if( ! bDC )
      ReleaseDC( 0, hDC );

   return iSize;
}

//--------------------------------------------------------------------------

XA_EXPORT int SizeToHeight( int iSize, HDC hDC )  // SizeToHeight( <nHeight>, <hDC> ) --> int
{
   BOOL bDC = FALSE;
   int iHeight;

   if( hDC )
      bDC = TRUE;
   else
      hDC = GetDC( 0 );

   iHeight = MulDiv( iSize, GetDeviceCaps( hDC, LOGPIXELSY ), 72 );

   if( ! bDC )
      ReleaseDC( 0, hDC );

   return - iHeight;
}

//--------------------------------------------------------------------------

XA_FUNC( HEIGHTTOSIZE )    // HeightToSize( <nHeight>, <hDC> ) --> nSize
{
   hb_retnl( HeightToSize( hb_parnl( 1 ), ( HDC ) hb_parnl( 2 ) ) );
}

//--------------------------------------------------------------------------

XA_FUNC( SIZETOHEIGHT )    // SizeToHeight( <nSize>, <hDC> ) --> nHeight
{
   hb_retnl( SizeToHeight( hb_parnl( 1 ), ( HDC ) hb_parnl( 2 ) ) );
}

//--------------------------------------------------------------------------

typedef struct {
   PHB_ITEM pFonts;
   DWORD dwFontType;
} FONTSCALLBACK;

static int CALLBACK EnumFontFamExProc( ENUMLOGFONTEX * lpelfe,
                                       NEWTEXTMETRICEX * lpntme,
                                       DWORD dwFontType, LPARAM lParam )
{
   FONTSCALLBACK *fcb = (FONTSCALLBACK *) lParam;

   XA_SYMBOL_UNUSED( lpntme );

   if( dwFontType & fcb->dwFontType )
      {
      PHB_ITEM pFont = hb_itemNew( NULL );
      if( hb_arrayScan( fcb->pFonts, hb_itemPutC( pFont, lpelfe->elfLogFont.lfFaceName ), NULL, NULL, TRUE ) == 0 )
         hb_arrayAdd( fcb->pFonts, pFont );
      hb_itemRelease( pFont );
      }

   return TRUE;
}

//--------------------------------------------------------------------------

XA_FUNC( GETFONTNAMES ) // GetFontNames( <nFontType>, <hDC>, <lSort> ) --> aFontNames
{
   BOOL bSort = HB_ISNIL( 3 ) ? TRUE : hb_parl( 3 );
   HDC  hDC   = ( HDC ) hb_parnl( 2 );
   BOOL bDC   = TRUE;
   PHB_ITEM pFonts = hb_itemArrayNew( 0 );
   HWND hWnd;
   LOGFONT lf;
   FONTSCALLBACK fcb;

   if( ! hDC )
   {
      hWnd = GetDesktopWindow();
      hDC  = GetDC( hWnd );
      bDC  = FALSE;
   }

   memset( &lf, 0, sizeof( LOGFONT ) );

   lf.lfFaceName[ 0 ] = '\0';
   lf.lfCharSet = HB_ISNUM( 3 ) ? hb_parnl( 3 ) : DEFAULT_CHARSET;

   fcb.pFonts = pFonts;
   fcb.dwFontType = hb_parnl( 1 );
   if( !fcb.dwFontType )
      fcb.dwFontType = DEVICE_FONTTYPE | RASTER_FONTTYPE | TRUETYPE_FONTTYPE;

   EnumFontFamiliesEx( hDC, ( LPLOGFONT ) &lf,
                       ( FONTENUMPROC ) EnumFontFamExProc, (LPARAM) &fcb, 0 );

   if( bSort )
      hb_arraySort( pFonts, NULL, NULL, NULL );

   if( ! bDC )
      ReleaseDC( hWnd, hDC );

   hb_itemReturnForward( pFonts );
   hb_itemRelease( pFonts );
}

#pragma ENDDUMP

//--------------------------------------------------------------------------

METHOD SaveToText() CLASS XFont
RETURN ::cName + "," + Ltrim( Str( ::nSize ) ) + "," + ;
         Ltrim( Str( ::nWidth ) ) + "," + Ltrim( Str( ::nHeight ) ) + "," + ;
         Ltrim( Str( ::nStyle ) ) + "," + Ltrim( Str( ::nWeight ) ) + "," + ;
         Ltrim( Str( ::nOrientation ) ) + "," + ToString( ::lBold ) + "," + ;
         ToString( ::lItalic ) + "," + ToString( ::lUnderline ) + "," + ;
         ToString( ::lStrikeOut ) + "," + Ltrim( Str( ::nCharSet ) )

//--------------------------------------------------------------------------

METHOD RestoreFromText( cString ) CLASS XFont

   LOCAL aFont := hb_aTokens( cString, "," )
   LOCAL lOk   := .F.

   IF Len( aFont ) == 12

      // Asignar estilos
      ::FnSize       := Val( aFont[ 2] )
      ::FnWidth      := Val( aFont[ 3] )
      ::FnHeight     := Val( aFont[ 4] )
      ::FnStyle      := Val( aFont[ 5] )
      ::FnWeight     := Val( aFont[ 6] )
      ::FnOrientation:= Val( aFont[ 7] )
      ::FlBold       := IIf( aFont[ 8] == ".T.", .T., .F. )
      ::FlItalic     := IIf( aFont[ 9] == ".T.", .T., .F. )
      ::FlUnderline  := IIf( aFont[10] == ".T.", .T., .F. )
      ::FlStrikeOut  := IIf( aFont[11] == ".T.", .T., .F. )
      ::FnCharSet    := Val( aFont[12] )

      // Recrear ahora para mayor velocidad
      ::cName        := aFont[ 1]
      lOk            := .T.
   ENDIF

RETURN lOk

//--------------------------------------------------------------------------