***********************************************************************
* Program....: CALCFONT.PRG
* Author.....: Andy Kramek and Marcia G. Akins
* Date.......: 28 August 2001
* Notice.....: Copyright (c) 2001 Tightline Computers Inc, All Rights Reserved.
* Compiler...: Visual FoxPro 07.00.0000.9262 for Windows 
* Purpose....: Return the exact length of a string (in Pixels) in the specified font
* Prototype..: lnLen = CalcFont( "This String", "Arial", 9, "BI" )
***********************************************************************
LPARAMETERS tuInStr, tcFName, tnFSize, tcFStyle
LOCAL lcInStr, lnLen, lnParams, lnRetVal
lnParams = PCOUNT()
**********************************************************************
*** Set Default Values if nothing passed
*** Default style is "Arial", 9
**********************************************************************
IF lnParams < 4
  tcFStyle = ""
  IF lnParams < 3
    tnFSize = 9
    IF lnParams < 2
      tcFName = "Arial"
      IF lnParams < 1
        tuInStr = "1"
      ENDIF
    ENDIF
  ENDIF
ENDIF
**********************************************************************
*** Convert the input string to character equivalent
**********************************************************************
lcInStr = TRANSFORM( tuInStr )
lnLen = LEN( lcInStr )
**********************************************************************
*** Get the exact length in Pixels
**********************************************************************
lnRetVal = INT( TXTWIDTH( lcInStr, tcFName, tnFSize, tcFStyle) * ;
                FONTMETRIC(6, tcFName, tnFSize, tcFStyle))

**********************************************************************
*** Display full details in a simple form
**********************************************************************
loParams = CREATEOBJECT( 'line' )
WITH loParams
    .AddProperty( 'cString', lcInStr )
    .AddProperty( 'nChars', lnLen )
    .AddProperty( 'cFont', tcFName  )
    .AddProperty( 'cStyle', tcFStyle )
    .AddProperty( 'nSize', tnFSize )
    .AddProperty( 'nMax', lnLen * FONTMETRIC( 7, tcFName, tnFSize, tcFStyle ) )
    .AddProperty( 'nAvg', lnLen * FONTMETRIC( 6, tcFName, tnFSize, tcFStyle ) )
    .AddProperty( 'nExact', IIF(ISBLANK(lcInStr), "N/A", TRANSFORM( lnRetVal )) )
ENDWITH

**********************************************************************
*** This is a design time form, so we can use a Read Events to keep the
*** display modeless: Just comment this out if you don't want the form!!!
**********************************************************************
loDisp = CREATEOBJECT( 'DispFont', loParams )
READ EVENTS

**********************************************************************
*** And return the length
**********************************************************************
RETURN lnRetVal


**********************************************************************
*** Create a form to show the results here
**********************************************************************
DEFINE CLASS dispfont AS form

    Caption = "String Size Details"
    Name = "dispfont"
    Height = 92
    Width = 375
    Left = SYSMETRIC(1) - 400

    ADD OBJECT lblInString AS label WITH ;
        Caption = "Test String", ;
        Height = 17,Left = 13,Top = 8, Width = 61, ;
        TabIndex = 1, Name = "lblInString"

    ADD OBJECT txtinstring AS textbox WITH ;
        Height = 23,Left = 77, ReadOnly = .T., ;
        TabIndex = 2, Top = 5, Width = 293, ;
        DisabledBackColor = RGB(192,192,192), ;
        DisabledForeColor = RGB(0,0,1), ;
        Name = "txtInString"

    ADD OBJECT lblFont AS label WITH ;
        Caption = "Font Detail", ;
        Height = 17, Left = 13, Top = 36, Width = 61, ;
        TabIndex = 3, Name = "lblFont"

    ADD OBJECT txtfontname AS textbox WITH ;
        Height = 23, Left = 77, ReadOnly = .T., ;
        TabIndex = 4, Top = 33, Width = 145, ;
        DisabledBackColor = RGB(192,192,192), ;
        DisabledForeColor = RGB(0,0,1), ;
        Name = "txtFontName"

    ADD OBJECT txtfontsize AS textbox WITH ;
        Alignment = 3, Value = 0, Height = 23, Left = 230, ;
        ReadOnly = .T., TabIndex = 5, Top = 33, Width = 53, ;
        DisabledBackColor = RGB(192,192,192), ;
        DisabledForeColor = RGB(0,0,1), ;
        Name = "txtFontSize"

    ADD OBJECT txtfontstyl AS textbox WITH ;
        Height = 23, Left = 294, ReadOnly = .T., ;
        TabIndex = 6, Top = 33, Width = 75, ;
        DisabledBackColor = RGB(192,192,192), ;
        DisabledForeColor = RGB(0,0,1), ;
        Name = "txtFontStyl"

    ADD OBJECT lblChars AS label WITH ;
        Caption = "Characters", ;
        Height = 17, Left = 11,  Top = 64, Width = 63, ;
        TabIndex = 7, Name = "lblChars"

    ADD OBJECT txtnumchars AS textbox WITH ;
        Alignment = 3, Value = 0, Height = 23, Left = 77, ;
        ReadOnly = .T., TabIndex = 8, Top = 61, Width = 39, ;
        DisabledBackColor = RGB(192,192,192), ;
        DisabledForeColor = RGB(0,0,1), ;
        Name = "txtNumChars"

    ADD OBJECT lblPixels AS label WITH ;
        Caption = "Pixels: Max", Height = 17, Left = 119, ;
        Top = 64, Width = 62, TabIndex = 9, Name = "lblPixels"

    ADD OBJECT txtmaxlen AS textbox WITH ;
        Alignment = 3, Value = 0, Height = 23, Left = 183, ;
        ReadOnly = .T., TabIndex = 10, Top = 61, Width = 39, ;
        DisabledBackColor = RGB(192,192,192), ;
        DisabledForeColor = RGB(0,0,1), ;
        Name = "txtMaxLen"

    ADD OBJECT lblAvg AS label WITH ;
        Caption = "Avg", Height = 17, Left = 226, Top = 64, ;
        Width = 21, TabIndex = 11, Name = "lblAvg"

    ADD OBJECT txtAvgLen AS textbox WITH ;
        Alignment = 3, Value = 0, Height = 23, Left = 249, ;
        ReadOnly = .T., TabIndex = 12, Top = 61, Width = 39, ;
        DisabledBackColor = RGB(192,192,192), ;
        DisabledForeColor = RGB(0,0,1), ;
        Name = "txtAvgLen"

    ADD OBJECT lblAct AS label WITH ;
        Caption = "Exact", Height = 17, Left = 294, Top = 64, ;
        Width = 31, TabIndex = 13, Name = "lblAct"

    ADD OBJECT txtActLen AS textbox WITH ;
        Alignment = 3, Value = 0, Height = 23, Left = 330, ;
        ReadOnly = .T., TabIndex = 14, Top = 61, Width = 39, ;
        DisabledBackColor = RGB(192,192,192), ;
        DisabledForeColor = RGB(0,0,1), ;
        Name = "txtActLen"

    FUNCTION INIT( toParams )
        WITH toParams
           This.txtInString.Value = .cString
           This.txtNumChars.Value = .nChars
           This.txtFontName.Value = .cFont
           This.txtFontSize.Value = .nSize
           This.txtFontStyl.Value = .cStyle
           This.txtMaxLen.Value = .nMax
           This.txtAvgLen.Value = .nAvg
           This.txtActLen.Value = .nExact
           This.Show()
        ENDWITH
    ENDFUNC

    FUNCTION Unload
        CLEAR EVENTS
    ENDFUNC

ENDDEFINE