2 de octubre de 2021

Mejoras en el control Grid de Visual FoxPro

Artículo original: Visual FoxPro Grid Enhancements
https://www.sweetpotatosoftware.com/blog/index.php/2008/11/25/visual-foxpro-grid-enhancements
Autor: Craig Boyd
Traductor: Luis María Guayán

El control grid de Visual FoxPro

A menudo me han escuchado decir que el Grid de Visual FoxPro es uno de los mejores controles jamás ideados. Sigo sintiéndome así, pero ¿no sería bueno si algunas de las funciones que nuestros clientes quieren implementar en el control Grid ya estuvieran disponibles? Ya sabes, características como: ordenado, filtrado, búsqueda incremental, guardar las preferencias del usuario y exportar a Excel. Sería aún mejor si este tipo de funcionalidades pudiera implementarse en cualquier control Grid de Visual FoxPro (independientemente del origen de los registros) simplemente colocando una clase en un formulario, estableciendo una sola propiedad y escribiendo una sola línea de código. Bueno, eso es lo que me he propuesto crear con la clase que presento en esta publicación.

Pueden ver la funcionalidad básica proporcionada por GridExtras en las imágenes que aparecen al final de la publicación.

Cómo usar la clase

Les proporciono la aplicación Sample.exe en la descarga para que puedan probarla y ver cómo se implementa. Sin embargo, los pasos básicos son:

  • Coloque una instancia de GridExtras en su formulario o contenedor (un GridExtras para cada control Grid que desee mejorar).
  • Establezca la propiedad GridExpression de GridExtras en una cadena que se evaluará en tiempo de ejecución al control Grid que está mejorando: "Thisform.Grid1" es el valor predeterminado para esta propiedad.
  • Llame al método Setup() de GridExtras cuando su control Grid esté listo para funcionar. No tengo forma de saber si está configurando el origen de registros en tiempo de ejecución, o si está agregando columnas en el código, por lo que este método se proporciona como una forma de controlar cuándo GridExtras comenzará a interactuar con el control Grid
  • .

Eso es todo lo que hay que hacer para poner GridExtras en funcionamiento para un control Grid en su aplicación. Como digo, he incluido un ejemplo en la descarga, así que si tiene alguna pregunta sobre cómo se hace esto, simplemente revise el ejemplo.

Otras propiedades de la clase

Hay algunas otras propiedades de GridExtras de las que es posible que desee tomar nota y utilizar, como:

  • CompanyName y ProductName: estas propiedades se utilizan para determinar dónde guardar el archivo de preferencias del control Grid del usuario que está separado por perfil (Ej: "C:\Users\Craig\AppData\Roaming\MyCompany\MyProduct\gridprefs.tmp").
  • AllowGridExport, AllowGridFilter, AllowGridPreferences, AllowGridSort: estas propiedades le permiten activar o desactivar ciertas características de la clase según sus necesidades.
  • TemplateTable: esta propiedad determina dónde GridExtras busca gridextras.dbf que se usa para guardar las plantillas de Grid que crea el usuario (el usuario puede guardar sus filtros y ordenaciones para poder recrearlos fácilmente en un momento posterior). Es posible que deba establecer esta propiedad si planea mantener la tabla gridextras en una ruta de red, como con la carpeta de base de datos compartida para su aplicación.

Que sigue

Simplemente juegue con GridExtras y vea si es útil para usted y sus aplicaciones. En un mundo perfecto, encontraría alguna forma de mejorarlo (agregar formatos de exportación adicionales, proporcionar una función de bloqueo de columna, etc.). Si mejora GridExtras, le agradecería que se ponga en contacto conmigo y comparta las mejoras que ha implementado. Gracias de antemano a aquellos de ustedes que decidan hacerlo.

Hasta la próxima!

Descargar GridExtras y ejemplos (aproximadamente 223 KB)


Figura 1: GridExtras proporciona capacidades de ordenamiento, búsqueda incremental y filtrado a cualquier control Grid de Visual FoxPro.


Figura 2: GridExtras tiene características adicionales como la capacidad de volverse semitransparente y la capacidad de guardar las preferencias del usuario (orden de columna y ancho).


Figura 3: Además de las funciones proporcionadas por GridExtras a través de los encabezados de columna de un coltrol Grid, también hay un icono agregado en la parte inferior derecha de la clase que permite al usuario acceder a la pantalla "Plantillas de cuadrícula y exportación" que se ve en la Figura 4.


Figura 4: Las plantillas de Grids ayudan al usuario a guardar las vistas del Grid para poder recrearlas rápidamente en el futuro. La función de exportación de GridExtras puede crear formatos de Excel XLS, XLSX, XLB y XLM. Los títulos de encabezado del control Grid se utilizan para nombrar las columnas de Excel cuando se exportan los datos.

19 de septiembre de 2021

Regenerar todos los índices compuestos de una base de datos

Cuando se dañan los archivos índices de una tabla, ejecutar el comando REINDEX a veces no es suficiente. Hay casos en que hay que generar nuevamente cada uno de los índices con el comando INDEX ON y/o ALTER TABLE.

El siguiente código lo utilizo como una herramienta para regenerar rápidamente todos los índices de todas las tablas de una base de datos, y aparte me genera un archivo PRG con nombre "REG_CDX_????????.PRG" (donde "????????" es el nombre de la base de datos) que lo puedo ejecutar posteriormente

Si la base de datos contiene relaciones persistentes e integridad referencial NO ejecuten el código publicado, ni el archivo .PRG generado ya que éstos eliminan todas las etiquetas de índices de la tabla (DELETE TAG ALL) y esta acción también elimina el archivo .CDX y quita las relaciones persistentes entre las tablas y la integridad referencial existentes en la base de datos. Si éste es su caso, puede utilizar la herramienta GenDBC.PRG que está en la carpeta \Tools\Gendbc\ en la carpeta raíz de instalación de Visual FoxPro, que si respalda y restaura las relaciones y la IR.

Usen este código bajo sus propios riesgos. Hagan una copia de seguridad de la base de datos antes de probarlo.

* -----
* Configurando la variable llRegenera en:
*   .T. = si desea que se regeneren todos los índices al momento de ejecutar el código
*   .F. = solo genera un archivo PRG con el código para generarlos posteriormente 
*-----
LOCAL laDBF[1], laTag[1], llRegenera,  lnI, lnJ, lnTAG
LOCAL lcCmd, lcDBC, lcPRG, lcTabla, lnDBF, loExc

CLOSE TABLES ALL
CLOSE DATABASES ALL
CLEAR ALL
SET MEMOWIDTH TO 128
SET SAFETY OFF

#DEFINE CR_LF CHR(13)+CHR(10)

*-- Selecciono DBC
m.lcDBC = GETFILE([DBC])
*-- Solo genera PRG o genera PRG y regenera índices
m.llRegenera = .F.
*-- Nombre del PRG generado
m.lcPRG = [REG_CDX_] + FORCEEXT(JUSTFNAME(m.lcDBC), [PRG])

IF EMPTY(m.lcDBC) OR NOT FILE(m.lcDBC)
  MESSAGEBOX([Debe seleccionar un archivo DBC], 16)
  RETURN
ENDIF

CLEAR
STRTOFILE([*--- Regenera los índices compuestos de las tablas de la base de datos ] + ;
    JUSTFNAME(m.lcDBC) + CR_LF, m.lcPRG, 0)
STRTOFILE([*--- ] + CHRTRAN(TTOC(DATETIME(), 3), [T], [ ]) + CR_LF + CR_LF, m.lcPRG, 1)

OPEN DATABASE (m.lcDBC) && EXCLUSIVE VALIDATE
SET DATABASE TO (JUSTSTEM(m.lcDBC))

STRTOFILE([OPEN DATABASE ("] + m.lcDBC + [") EXCLUSIVE VALIDATE] + CR_LF, m.lcPRG, 1)
STRTOFILE([SET DATABASE TO ] + JUSTSTEM(m.lcDBC) + CR_LF + CR_LF, m.lcPRG, 1)

m.lnDBF = ADBOBJECTS(laDBF, "TABLE")
ASORT(m.laDBF)

FOR m.lnI = 1 TO m.lnDBF
  *-- Recorro todas las tablas de la DBC
  m.lcTabla = ADDBS(JUSTPATH(DBC())) + m.laDBF(m.lnI)

  TRY
    IF m.llRegenera && Necesito abrir en modo EXCLUSIVE
      USE (m.lcTabla) EXCLUSIVE IN SELECT(m.laDBF(m.lnI))
    ELSE
      USE (m.lcTabla) SHARED IN SELECT(m.laDBF(m.lnI))
    ENDIF

    STRTOFILE([USE ("] + m.lcTabla + [") EXCLUSIVE ] + CR_LF, m.lcPRG, 1)

    m.lnTAG = ATAGINFO(laTag)
    m.lcCmd = ""
    FOR m.lnJ = 1 TO m.lnTAG
      *-- Recorro todas las etiquetas de índices
      IF m.laTag(m.lnJ, 2) = [PRIMARY]
        m.lcCmd = m.lcCmd + ;
          [ALTER TABLE ] + m.laDBF(m.lnI) + [ ADD PRIMARY KEY ] + m.laTag(m.lnJ, 3) + ;
          [ TAG ] + m.laTag(m.lnJ, 1) + ;
          [ COLLATE "] + m.laTag(m.lnJ, 6) + ["]  + CR_LF
      ELSE
        m.lcCmd = m.lcCmd + ;
          [INDEX ON ] + m.laTag(m.lnJ, 3) + [ ] + ;
          [TAG ] + m.laTag(m.lnJ, 1) + [ ] + ;
          IIF(m.laTag(m.lnJ, 2) = "BINARY", m.laTag(m.lnJ, 2) + [ ], m.laTag(m.lnJ, 5) + [ ]) + ;
          IIF(EMPTY(m.laTag(m.lnJ, 4)), [], [FOR ] + m.laTag(m.lnJ, 4) + [ ]) + ;
          IIF(m.laTag(m.lnJ, 2) = "CANDIDATE", m.laTag(m.lnJ, 2) + [ ], []) + ;
          [COLLATE "] + m.laTag(m.lnJ, 6) + ["] + CR_LF
      ENDIF
    ENDFOR

    IF m.llRegenera
      DELETE TAG ALL
      PACK
      EXECSCRIPT(m.lcCmd)
    ENDIF

    STRTOFILE([DELETE TAG ALL] + CR_LF, m.lcPRG, 1)
    STRTOFILE([PACK] + CR_LF + CR_LF, m.lcPRG, 1)
    STRTOFILE(m.lcCmd + CR_LF, m.lcPRG, 1)

  CATCH TO m.loExc
    STRTOFILE([* ERROR:] + CR_LF, m.lcPRG, 1)
    STRTOFILE([* ] + m.loExc.MESSAGE + CR_LF, m.lcPRG, 1)

  FINALLY
    USE IN SELECT(m.laDBF(m.lnI))
    STRTOFILE([USE IN SELECT("] + m.laDBF(m.lnI) + [")] + CR_LF + CR_LF, m.lcPRG, 1)
  ENDTRY

ENDFOR

MODIFY FILE (m.lcPRG)

4 de septiembre de 2021

Configurando una aplicación usando JSON

Título original: Application Configuration using JSON
https://doughennig.blogspot.com/2020/10/application-configuration-using-json.html
Autor: Doug Hennig
Traducido por Luis María Guayán


Después de ver una la presentación de Andrew MacNeill sobre JSON, me inspiré para ver nfJSON, un proyecto VFPx de Marco Plaza. Este gran proyecto agrega soporte JSON a las aplicaciones VFP. Lo que modificó mi interés fue la capacidad de convertir una cadena JSON en un objeto VFP y viceversa con una sola línea de código.

Mi primer pensamiento fue usar esto para los parámetros de configuración. Casi todas las aplicaciones necesitan parámetros de configuración: es mejor leer los parámetros como la información de conexión de la base de datos, ubicaciones de archivos, configuración de correo electrónico, etc. desde una fuente de configuración en lugar de "hardcodearlos" en la aplicación. He usado el Registro de Windows, archivos DBF, INI y XML en varias ocasiones, pero todos requieren codificar manualmente la lectura y escritura entre la fuente y los objetos VFP que contienen la configuración. Con nfJSON, es solo una línea de código.

He creado una clase contenedora llamada SFConfiguration. Solo tiene tres métodos:

  • Load devuelve un objeto con propiedades que coinciden con los pares de nombre/valor en el JSON contenido en el archivo de configuración especificado. Si el archivo no existe o está vacío (como la primera vez que se ejecuta la aplicación), llama a GetDefaultSettings (que se describe a continuación) para obtener la configuración predeterminada.
  • Save guarda las propiedades del objeto de configuración especificado en el archivo especificado en el nombre de archivo pasado o en la propiedad cSettingsFile si no se pasa un nombre de archivo.
  • GetDefaultSettings devuelve JSON para la configuración predeterminada. Puede usar esto de dos maneras: subclase SFConfiguration y anular GetDefaultSettings para devolver el JSON deseado, o establecer la propiedad oSettings en un objeto de configuración que contenga la configuración predeterminada.

A continuación, se muestra un ejemplo del uso de esta clase para obtener la configuración del correo electrónico:

loConfig = createobject('SFConfiguration')
loConfig.cSettingsFile = 'email.json'
loConfig.oSettings     = createobject('EmailSettings')
loSettings = loConfig.Load()
* loSettings contiene la configuración de correo electrónico del usuario;
* si email.json no existe, la configuración de la clase 
* EmailSettings se utiliza como predeterminada.
* Después de que el usuario ingrese la configuración deseada en algún 
* cuadro de diálogo, guárdelos usando:
loConfig.Save(loSettings)

define class EmailSettings as Custom
    Email      = 'dhennig@stonefield.com'
    MailServer = 'mail.stonefield.com'
    Port       = 25
    UseSSL     = .F.
    UserName   = 'dhennig'
    Password   = 'mypw'
enddefine

Así es como se ve el objeto de configuración:

Así es como se ve el JSON guardado:

Aquí hay otro ejemplo, esta vez usando una subclase de SFConfiguration para lo mismo:

loConfig = createobject('SFEmailConfiguration')
loConfig.cSettingsFile = 'email.json'
loSettings = loConfig.Load()
* loSettings contiene la configuración de correo electrónico del usuario; 
* si email.json no existe, la configuración de la clase 
* SFEmailConfiguration a continuación se usa como predeterminada.

define class SFEmailConfiguration as SFConfiguration
    function GetDefaultSettings
        text to lcSettings noshow
            {
                "email":"dhennig@stonefield.com",
                "mailserver":"mailserver.stonefield.com",
                "password":"mypw",
                "port":25,
                "username":"dhennig",
                "usessl":false
            }
            endtext
            return lcSettings
    endfunc
enddefine

Aquí está el código para SFConfiguration. Requiere nfJSONRead.prg y nfJSONCreate.prg, que puede obtener del repositorio nfJSON de GitHub:

define class SFConfiguration as Custom
    cSettingsFile = ''
        && the name and path for the settings file
    cErrorMessage = ''
        && the text of any error that occurs
    oSettings     = ''
        && a settings object

* Cargue la configuración del archivo especificado en el parámetro 
* o en This.cSettingsFile y devuelva un objeto de configuración. 
* Si el archivo no existe (como la primera vez que nos llaman), 
* se retorna un objeto de configuración que contiene 
* la configuración predeterminada.

    function Load(tcSettingsFile)
        local lcSettingsFile, ;
            lcSettings, ;
            loSettings, ;
            loException as Exception
        try
            lcSettingsFile = evl(tcSettingsFile, This.cSettingsFile)
            if not empty(lcSettingsFile) and file(lcSettingsFile)
                lcSettings = filetostr(lcSettingsFile)
            endif not empty(lcSettingsFile) ...
            if empty(lcSettings)
                lcSettings = This.GetDefaultSettings()
            endif empty(lcSettings)
            loSettings = nfJSONRead(lcSettings)
            This.cErrorMessage = ''
        catch to loException
            This.cErrorMessage = loException.Message
            loSettings = NULL
        endtry
        This.oSettings = loSettings
        return loSettings
    endfunc

* Guarde la configuración en el objeto especificado en el 
* archivo especificado en el parámetro o This.cSettingsFile.

    function Save(toSettings, tcSettingsFile)
        local lcSettingsFile, ;
            lcSettings, ;
            loException as Exception
        lcSettingsFile = evl(tcSettingsFile, This.cSettingsFile)
        if not empty(lcSettingsFile)
            try
                lcSettings = nfJSONCreate(toSettings, .T.)
                strtofile(lcSettings, lcSettingsFile)
                This.cErrorMessage = ''
            catch to loException
                This.cErrorMessage = loException.Message
            endtry
        else
            This.cErrorMessage = 'Settings file not specified.'
        endif not empty(lcSettingsFile)
        return empty(This.cErrorMessage)
    endfunc

* Obtiene el conjunto de configuraciones predeterminado como una 
* cadena JSON; anule esto en una subclase si es necesario.

    function GetDefaultSettings
        local lcSettings
        if vartype(This.oSettings) = 'O'
            lcSettings = nfJSONCreate(This.oSettings, .T.)
        else
            lcSettings = '{"text":"some text"}'
        endif vartype(This.oSettings) = 'O'
        return lcSettings
    endfunc
enddefine

28 de agosto de 2021

Olvídese de TXTWIDTH - use GdipMeasureString

Articulo original: Forget TXTWIDTH - use GdipMeasureString
https://doughennig.blogspot.com/2006/04/forget-txtwidth-use-gdipmeasurestring.html
Autor: Doug Hennig
Traducido por: Luis María Guayán


Durante años, hemos utilizado código como el siguiente para determinar el ancho de una cadena:

lnWidth = txtwidth(lcText, lcFontName, lnFontSize, ;
  lcFontStyle)
lnWidth = lnWidth * fontmetric(6, lcFontName, ;
  lnFontSize, lcFontStyle)

Este código funciona bien en muchas situaciones, pero no en una en particular: cuando se define el ancho de un objeto en un informe.

El valor calculado anteriormente está en píxeles, por lo que debe convertir el valor a FRU (las unidades utilizadas en los informes, que son 1/10000 de pulgada); debe multiplicar por 104,166 (10000 FRU por pulgada / 96 píxeles por pulgada). En lugar de hacer todo ese trabajo, puede utilizar el método GetFRUTextWidth del objeto auxiliar FFC _FRXCursor:

loFRXCursor = newobject('FRXCursor', ;
  home() + 'FFC\_FRXCursor.vcx')
lnWidth = loFRXCursor.GetFRUTextWidth(lcText, ;
  lcFontName, lnFontSize, lcFontStyle)

El problema es que esto en realidad no le da el valor correcto. El motivo es que los informes usan GDI + para la representación y GDI + representa los objetos un poco más grandes de lo esperado.

Para ver este problema, haga lo siguiente:

use home() + 'samples\data\customer'
loFRXCursor = newobject('FRXCursor', ;
  home() + 'FFC\_FRXCursor.vcx')
select max(loFRXCursor.GetFRUTextWidth(trim(company), ;
  'Arial', 10)) from customer into array laWidth
wait window laWidth[1]

Obtengo 22500. Ahora cree un informe, agregue un campo, ingrese "empresa" como expresión y hágalo 2.25 pulgadas de ancho (22500 FRU / 10000 FRU por pulgada). Obtenga una vista previa del informe. La elipsis reveladora al final de algunos valores indica que el tamaño del campo no era lo suficientemente amplio.

Esto me volvió loco durante años. Descubrí un factor empírico "fudge" para agregar al ancho calculado; 19 píxeles (1979.154 FRU) parecían funcionar la mayor parte del tiempo, pero ocasionalmente encontraba que no era suficiente para algunos valores.

Afortunadamente, dado que los informes usan GDI +, podemos usar una función GDI + para calcular con precisión el ancho. GdipMeasureString determina varias cosas sobre la cadena especificada, incluido el ancho. Aún mejor, VFP 9 viene con un objeto contenedor de GDI + para que no tenga que comprender la API de GDI + para llamar a GdipMeasureString.

Para mostrar un ejemplo del uso de las clases contenedoras de GDI +, eche un vistazo a esta función:

function GetWidth(tcText, tcFontName, tnFontSize)
local loGDI, ;
  loFont, ;
  lnChars, ;
  lnLines, ;
  loSize
loGDI = newobject('GPGraphics', ;
  home() + 'FFC\_GDIPlus.vcx')
loFont = newobject('GPFont', ;
  home() + 'FFC\_GDIPlus.vcx', '', tcFontName, ;
  tnFontSize, 0, 3)
loGDI.CreateFromHWnd(_screen.HWnd)
lnChars = 0
lnLines = 0
loSize  = loGDI.MeasureStringA(tcText, loFont, , , ;
  @lnChars, @lnLines)
lnWidth = loSize.W
release loGDI, loFont, loSize
return lnWidth

Ahora intente lo siguiente:

select max(GetWidth(trim(company), ;
  'Arial', 10)) from customer into array laWidth
wait window ceiling(laWidth[1] * 104.166)

Esto da 23838. Cambie el ancho del campo en el informe a 2,384 pulgadas y vuelva a obtener una vista previa. Esta vez los valores encajan correctamente.

El único problema ahora es que este código puede tardar mucho en ejecutarse si hay muchos registros porque para cada llamada, se crean un par de objetos contenedores de GDI + y se realiza alguna configuración de GDI +. Creé una clase contenedora para GdipMeasureString llamada SFGDIMeasureString que funciona de manera mucho más eficiente.

Veamos esta clase en secciones. Aquí está el comienzo: define algunas constantes, la clase y sus propiedades:

* Estos #DEFINEs se toman de
* home() + 'ffc\gdiplus.h'

#define GDIPLUS_FontStyle_Regular     0
#define GDIPLUS_FontStyle_Bold        1
#define GDIPLUS_FontStyle_Italic      2
#define GDIPLUS_FontStyle_BoldItalic  3
#define GDIPLUS_FontStyle_Underline   4
#define GDIPLUS_FontStyle_Strikeout   8
#define GDIPLUS_STATUS_OK       0
#define GDIPLUS_Unit_Point            3

define class SFGDIMeasureString as Custom
  oGDI    = .NULL.
    && a reference to a GPGraphics object
  oFormat = .NULL.
    && a reference to a GPStringFormat object
  oFont   = .NULL.
    && a reference to a GPFont object
  oSize   = .NULL.
    && a reference to a GPSize object
  nChars  = 0
   && the number of characters fitted in the
    && bounding box
  nLines  = 0
    && the number of lines in the bounding box
  nWidth  = 0
    && the width of the bounding box
  nHeight = 0
    && the height of the bounding box
  nStatus = 0
    && the status code from GDI+ functions

El método Init crea una instancia de algunos objetos auxiliares y declara la función GdipMeasureString. Destruye los objetos miembros con armas nucleares:

function Init
  This.oGDI    = newobject('GPGraphics', ;
    home() + 'ffc\_gdiplus.vcx')
  This.oFormat = newobject('GPStringFormat', ;
    home() + 'ffc\_gdiplus.vcx')
  This.oFont   = newobject('GPFont', ;
    home() + 'ffc\_gdiplus.vcx')
  This.oSize   = newobject('GPSize', ;
    home() + 'ffc\_gdiplus.vcx')
  declare integer GdipMeasureString ;
    in gdiplus.dll ;
    integer nGraphics, string cUnicode, ;
    integer nLength, integer nFont, ;
    string cLayoutRect, integer nStringFormat, ;
    string @cRectOut, integer @nChars, ;
    integer @nLines
endfunc

function Destroy
  store .NULL. to This.oGDI, This.oFormat, ;
    This.oFont, This.oSize
endfunc

MeasureString determina las dimensiones del cuadro delimitador para la cadena especificada:

function MeasureString(tcString, tcFontName, ;
  tnFontSize, tcStyle)
  local lcStyle, ;
    lnStyle, ;
    lnChars, ;
    lnLines, ;
    lcBoundingBox, ;
    lnGDIHandle, ;
    lnFontHandle, ;
    lnFormatHandle, ;
    lcRectF, ;
    lnStatus, ;
    llReturn
  with This

* Asegúrese de que los parámetros se pasen correctamente.

    do case
      case vartype(tcString) <> 'C' or ;
        empty(tcString)
        error 11
        return .F.
      case pcount() > 1 and ;
        (vartype(tcFontName) <> 'C' or ;
        empty(tcFontName) or ;
        vartype(tnFontSize) <> 'N' or ;
        not between(tnFontSize, 1, 128))
        error 11
        return .F.
      case pcount() = 4 and ;
       (vartype(tcStyle) <> 'C' or ;
        empty(tcStyle))
        error 11
        return .F.
    endcase

* Configure el objeto Font si se especificaron la fuente y el tamaño.

    if pcount() > 1
      lcStyle = iif(vartype(tcStyle) = 'C', ;
        tcStyle, '')
      .SetFont(tcFontName, tnFontSize, lcStyle)
    endif pcount() > 1

* Inicializar las variables de salida utilizadas en GdipMeasureString.

    lnChars       = 0
    lnLines       = 0
    lcBoundingBox = replicate(chr(0), 16)

* Obtenga los identificadores de GDI + que necesitamos.

    lnGDIHandle = .oGDI.GetHandle()
    if lnGDIHandle = 0
      .oGDI.CreateFromHWnd(_screen.HWnd)
      lnGDIHandle = .oGDI.GetHandle()
    endif lnGDIHandle = 0
    lnFontHandle   = .oFont.GetHandle()
    lnFormatHandle = .oFormat.GetHandle()

* Obtenga el tamaño del cuadro de diseño.

    lcRectF = replicate(chr(0), 8) + ;
      .oSize.GdipSizeF

* Llame a la función GdipMeasureString para obtener las dimensiones
* del cuadro delimitador para la cadena especificada.

    .nStatus = GdipMeasureString(lnGDIHandle, ;
      strconv(tcString, 5), len(tcString), ;
      lnFontHandle, lcRectF, lnFormatHandle, ;
      @lcBoundingBox, @lnChars, @lnLines)
    if .nStatus = GDIPLUS_STATUS_OK
      .nChars  = lnChars
      .nLines  = lnLines
      .nWidth  = ctobin(substr(lcBoundingBox, ;
         9, 4), 'N')
      .nHeight = ctobin(substr(lcBoundingBox, ;
        13, 4), 'N')
      llReturn = .T.
    else
      llReturn = .F.
    endif .nStatus = GDIPLUS_STATUS_OK
  endwith
  return llReturn
endfunc

GetWidth es un método de utilidad que devuelve el ancho de la cadena especificada:

function GetWidth(tcString, tcFontName, ;
  tnFontSize, tcStyle)
  local llReturn, ;
    lnReturn
  with This
    do case
      case pcount() < 2
        llReturn = .MeasureString(tcString)
      case pcount() < 4
        llReturn = .MeasureString(tcString, ;
          tcFontName, tnFontSize)
      otherwise
        llReturn = .MeasureString(tcString, ;
          tcFontName, tnFontSize, tcStyle)
    endcase
    if llReturn
      lnReturn = .nWidth
    endif llReturn
  endwith
  return lnReturn
endfunc

SetSize establece las dimensiones del cuadro de diseño para la cadena:

function SetSize(tnWidth, tnHeight)
  if vartype(tnWidth) = 'N' and ;
    tnWidth >= 0 and ;
    vartype(tnHeight) = 'N' and tnHeight >=0
    This.oSize.Create(tnWidth, tnHeight)
  else
    error 11
  endif vartype(tnWidth) = 'N' ...
endfunc

SetFont establece el nombre, el tamaño y el estilo de la fuente que se utilizará:

function SetFont(tcFontName, tnFontSize, tcStyle)
  local lcStyle
  do case
    case pcount() <= 2 and ;
      (vartype(tcFontName) <> 'C' or ;
      empty(tcFontName) or ;
      vartype(tnFontSize) <> 'N' or ;
      not between(tnFontSize, 1, 128))
      error 11
      return .F.
    case pcount() = 3 and ;
      vartype(tcStyle) <> 'C'
      error 11
      return .F.
  endcase
  lcStyle = iif(vartype(tcStyle) = 'C', tcStyle, '')
  lnStyle = iif('B' $ lcStyle, ;
      GDIPLUS_FontStyle_Bold, 0) + ;
    iif('I' $ lcStyle, ;
      GDIPLUS_FontStyle_Italic, 0) + ;
    iif('U' $ lcStyle, ;
      GDIPLUS_FontStyle_Underline, 0) + ;
    iif('-' $ lcStyle, ;
      GDIPLUS_FontStyle_Strikeout, 0)
  This.oFont.Create(tcFontName, tnFontSize, ;
    lnStyle, GDIPLUS_Unit_Point)
endfunc

Probemos el ejemplo anterior usando esta clase:

loGDI = newobject('SFGDIMeasureString', ;
  'SFGDIMeasureString.prg')
select max(loGDI.GetWidth(trim(company), 'Arial', 10)) ;
  from customer into array laWidth
wait window laWidth[1] * 10000/96

Esto es mucho más rápido que la función GetWidth presentada anteriormente. Lo siguiente se ejecutaría aún más rápido porque el objeto de fuente no tiene que inicializarse en cada llamada:

loGDI = newobject('SFGDIMeasureString', ;
  'SFGDIMeasureString.prg')
loGDI.SetFont('Arial', 10)
select max(loGDI.GetWidth(trim(company))) ;
  from customer into array laWidth
wait window laWidth[1] * 10000/96

Lo bueno de esta clase es que puede hacer mucho más que calcular el ancho de una cuerda. Es cy también determina la altura o el número de líneas que tomará una cadena en un cierto ancho (piense en establecer MEMOWIDTH en un cierto ancho y luego usar MEMLINES (), pero más rápido, más preciso y fuentes de apoyo).

Por ejemplo, tengo una clase de diálogo de mensaje genérico que utilizo para mostrar advertencias, errores y otros tipos de mensajes al usuario. No uso MESSAGEBOX () para esto porque mi clase admite varios botones con subtítulos personalizados. El problema es que los botones aparecen debajo de un cuadro de edición utilizado para mostrar el mensaje. Entonces, ¿cuánto espacio tengo que asignar para la altura del cuadro de edición? Si no especifico lo suficiente, el usuario debe desplazarse para ver el mensaje. Si especifico demasiado, los mensajes cortos se ven ridículos porque hay mucho espacio en blanco antes de los botones. Ahora, puedo hacer que el cuadro de edición tenga un tamaño arbitrario y usar SFGDIMeasureString para determinar la altura necesaria para el cuadro de edición para un mensaje dado, ajustando las posiciones de los botones dinámicamente. Para hacerlo, llamo al método SetSize para decirle a SFGDIMeasureString el ancho del cuadro de edición (paso un valor muy grande, como 10000, para la altura, por lo que no es un factor), luego llamo a MeasureString y uso el valor de la propiedad nHeight para la altura del cuadro de edición.

Estoy encontrando muchos más usos para esta clase. Espero que también te resulte útil.