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.
