HMGforum.com

Code: Select all

/*
   Test for accuracy of GetTextWidth() function.
   
   2014-08-18
   
*/


#include <hmg.ch>

Function Main
   
   DEFINE WINDOW frmGTWTest ;
      AT     0,0 ;
      WIDTH  250 ;
      HEIGHT 200 ;
      MAIN       ;
      TITLE  "GTW Accuracy"  ;
      ON INIT { || MsgDebug( GetTextWidth( NIL, "size10", _HMG_SYSDATA [ 36 ][2] ), GetTextWidth( NIL, "size20", _HMG_SYSDATA [ 36 ][3] ) ) }
      
      ON KEY ESCAPE ACTION ThisWindow.Release
      
      @  50, 50 LABEL lblSize10 HEIGHT 20 VALUE "Size10" FONT "Verdana" SIZE 10
      @ 100, 50 LABEL lblSize20 HEIGHT 30 VALUE "Size20" FONT "Verdana" SIZE 20
      
   END WINDOW

   frmGTWTest.Center()
   msgdebug(_HMG_SYSDATA [ 36 ] )
   frmGTWTest.Activate()
  
Return Nil

Code: Select all

/*
   Test for accuracy of GetTextWidth() function and Height
   
   2014-08-19
   
*/

#include <hmg.ch>

Function Main(cFont,cBold)
Local nFnt, cFontName
Private aFonts:={"Verdana","Arial","Courier New"}, lBold

If cFont=NIL
   cFont:="2"
Endif
nFnt := Val(cFont)
If nFnt>0 .and. nFnt<4
   cFontName := aFonts[nFnt]
Else
   MsgStop("Upto 3 fonts declared")
   Quit
Endif
If cBold=NIL
   lBold := .F.
Else
   lBold := .T.
Endif

DEFINE WINDOW frmGTWTest ;
    AT     0,0 ;
    WIDTH  380 ;
    HEIGHT 280 ;
    MAIN       ;
    TITLE  "Accuracy in pixels" ;
	ON INIT Test()
   
    ON KEY ESCAPE ACTION ThisWindow.Release
    
	DEFINE LABEL lblSize10
	    ROW    50
	    COL    20
	    HEIGHT 20
	    VALUE "Size10"
	    FONTNAME cFontName
	    FONTSIZE 10
	    FONTBOLD lBold
	    BACKCOLOR GREEN
	    FONTCOLOR RED
	END LABEL
	
	DEFINE LABEL lblSize20
	    ROW    100
	    COL    20
	    HEIGHT 30
	    VALUE "Size20"
	    FONTNAME cFontName
	    FONTSIZE 20
	    FONTBOLD lBold
	    BACKCOLOR GREEN
	    FONTCOLOR RED
	END LABEL
	
	@ 50,180 LABEL lblText HEIGHT 80 WIDTH 124 VALUE "" SIZE 11

	DEFINE COMBOBOX Combo_1
	    ROW    180
	    COL    20
	    WIDTH  120
	    HEIGHT 100
	    ITEMS  {aFonts[1],aFonts[2],aFonts[3]}
	    VALUE nFnt
	    FONTNAME "Arial"
	    FONTSIZE 9
	    ONCHANGE ChngFntLbls(This.Value)
	END COMBOBOX
	
	DEFINE CHECKBOX Check_1
	    ROW    180
	    COL    160
	    WIDTH  60
	    HEIGHT 28
	    CAPTION " Bold"
	    VALUE lBold
	    FONTNAME "Arial"
	    FONTSIZE 9
	    ONCHANGE ChngBoldFntLbl(This.Value)
	END CHECKBOX
	
	DEFINE BUTTON Button_1
        ROW    180
        COL    220
        WIDTH  120
        HEIGHT 28
        ACTION Test()
        CAPTION "Get Labels sizes"
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
    END BUTTON

END WINDOW
frmGTWTest.Center()
frmGTWTest.Activate()
Return Nil

Function ChngBoldFntLbl(lValue)
lBold:=!lBold
SetProperty("frmGTWTest","lblSize10","FONTBOLD",lBold)
SetProperty("frmGTWTest","lblSize20","FONTBOLD",lBold)
Test()
Return Nil

Function ChngFntLbls(nValue)
Local cFont := aFonts[nValue]

SetProperty("frmGTWTest","lblSize10","FONTNAME",cFont)
SetProperty("frmGTWTest","lblSize20","FONTNAME",cFont)
Test()
Return Nil

Function Test()
Local aSizes:={}, cText:=""

aSizes := GetPixelSizes ("frmGTWTest","lblSize10","Size10")
cText := "Width (lblSize10): "+AllTrim(Str(aSizes[1]))+CRLF+"Height (lblSize10): "+AllTrim(Str(aSizes[2]))+CRLF+CRLF
aSizes := GetPixelSizes ("frmGTWTest","lblSize20","Size20")
cText := cText + "Width (lblSize20): "+AllTrim(Str(aSizes[1]))+CRLF+"Height (lblSize20): "+AllTrim(Str(aSizes[2]))
SetProperty("frmGTWTest","lblText","Value",cText)
Return Nil

Function GetPixelSizes (cForm,cControl,cString)
Local hWnd := GetFormHandle(cForm)
Local hDC := GetDC( hWnd )
Local idx := GetControlIndex (cControl,cForm)
Local nHndFnt := _HMG_SYSDATA [ 36 ][ idx ]
Local nHeight := _HMG_SYSDATA [ 28 ][ idx ]
Local nWidth

DEFAULT cString := GetProperty(cForm,cControl,"Value")

nWidth := GetTextWidth( hDC, cString, nHndFnt )
// msgdebug(nwidth)
ReleaseDC (hWnd, hDC)
Return {nWidth,nHeight}