Accuracy of GetTextWidth()

[Rathinagiri]

Getting of Device Context is also not a problem, since we have GetDC and ReleaseDC functions, which are used in h_graph.prg around line no.840.

[tiampei]

Syntax of GetTextWidth:
1st parameter is HDC, handle to device context
2nd parameters is text
3rd parameters is HFONT, handle to logical font

When 1st parameter is Nil, the function will get DC from active window.
I can't find the HMG function to create HFONT. Maybe need some low level WINAPI function.

The following is sample how to get text width with bold and/or italic style.
And, it only work on screen (not work on printer)

Code: Select all

#include <hmg.ch>

#pragma BEGINDUMP
#include <windows.h>

// Create logical font and select into DC (device context)
// Must use DelectObject to destroy the logical font
HB_FUNC( CREATELOGFONT )
{
   HDC hDC = hb_parnl( 1 );
   const char * FontName = hb_parc( 2 );
   int FontSize = hb_parni( 3 );
   BOOL lBold = hb_parl( 4 ); 
   DWORD lItalic = (DWORD) hb_parl( 5 );

   int fnWeight = ( lBold ? FW_BOLD : FW_NORMAL );
   long FontHeight; HFONT hxfont;

   FontHeight = -MulDiv( FontSize, GetDeviceCaps( hDC, LOGPIXELSY ), 72 );
   hxfont = 
   CreateFont( FontHeight, 0, 0, 0, fnWeight, lItalic, 0, 0, 
      DEFAULT_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, 
      DEFAULT_QUALITY, FF_DONTCARE, FontName );

   hb_retnl( (LONG) hxfont ); 
}

HB_FUNC( DELETEHFONT ) // DELETEOBJECT already define in c_controlmisc.c
{
   BOOL lRet;
   HFONT hxfont = hb_parnl( 1 );
   lRet = DeleteObject(hxfont);
   hb_retl( lRet ); /* Return .t. if success */
}

/* LineDraw define in c_graph.c */
/* BT_DrawLine define in hfcl_BosTaurus.prg */
HB_FUNC( DRAWLINE ) // Draw a line
{
   int x1, x2;
   int y1, y2;
   HDC hDC = hb_parnl( 1 );

   y1 = hb_parni( 2 );
   x1 = hb_parni( 3 );
   y2 = hb_parni( 4 );
   x2 = hb_parni( 5 );

   MoveToEx(hDC, x1, y1, NULL);
   LineTo(hDC, x2, y2);
}

/* Define in c_graph.c */
/*
HB_FUNC( GETDC ) // Get DC (device context)
{
   HWND hWnd = hb_parnl( 1 );
   hb_retnl( GetDC( hWnd ) ); // Return value of DC (0 if fail)
}

HB_FUNC( RELEASEDC )
{
   HWND hWnd = hb_parnl( 1 );
   HDC hDC = hb_parnl( 2 );
   hb_retl( ReleaseDC( hWnd, hDC ) ); // Return .t. if success
}
*/

#pragma ENDDUMP

Procedure Main

   Define Window MainWindow;
      At 0, 0 Width 400 Height 250 Main ;
      Title "Test Drawing" ;
      NoMinimize NoMaximize ;
      On Init MainWin_Onload()

      @  10,  20 ComboBox cboFontName Width 150 Height 100 On Change cboFontName_Change()
      @  40,  20 CheckBox chkCheckBold Caption "Bold" Width 60 On Change chkCheckBold_Change()
      @  40,  90 CheckBox chkCheckItalic Caption "Italic" Width 60 On Change chkCheckItalic_Change()

      @  20, 200 Button cmdGetWidth Caption "Get Text Width"  Width 120 Height 25 On Click cmdGetWidth_Click()
      @  60, 200 Button cmdDrawRuler Caption "Draw Ruler"  Width 120 Height 25 On Click cmdDrawRuler_Click()

      @ 105,  20 Label lblSample Width 200 Height 20 Value "A Sample Text" Font "Arial" Size 12
   End Window

   MainWindow.cboFontName.AddItem("Arial")
   MainWindow.cboFontName.AddItem("Times New Roman")
   MainWindow.cboFontName.Value := 1

   MainWindow.Center
   MainWindow.Activate

Return

Procedure MainWin_Onload
Return

Procedure chkCheckBold_Change
   MainWindow.lblSample.FontBold := MainWindow.chkCheckBold.Value
Return

Procedure chkCheckItalic_Change
   MainWindow.lblSample.FontItalic := MainWindow.chkCheckItalic.Value
Return

Procedure cboFontName_Change
   Local cFontName, nItemNo
   nItemNo := MainWindow.cboFontName.Value
   cFontName := MainWindow.cboFontName.Item(nItemNo)
   MainWindow.lblSample.FontName := cFontName
Return

Procedure cmdGetWidth_Click
   // Local nControlID := GetControlIndex("lblSample", "MainWindow")
   Local nFormHandle := GetFormHandle("MainWindow") // Get form handle
   Local nTextWidth, nTextHeight
   Local hDC, hFont
   Local cFontName, lBold := .f. , lItalic := .f.

   // MsgInfo(hb_ValToStr(nControlID)) // Get control index

   If nFormHandle = 0
      MsgInfo("Can't get form handle", "GetFormHandle fail")
      Return
   EndIf

   hDC := GetDC(nFormHandle) // Must release DC after using it
   If hDC = 0
      MsgInfo("Can't get device context", "GetDC fail")
      Return
   EndIf

   cFontName := MainWindow.cboFontName.DisplayValue
   lBold := MainWindow.chkCheckBold.Value
   lItalic := MainWindow.chkCheckItalic.Value

   hFont := CreateLogFont(hDC, cFontName, 12, lBold, lItalic) // Must delete logfont after use it
   If hFont = 0
      MsgInfo("Fail to create logical font", "CreateLogFont fail")
      Return
   EndIf

   nTextWidth := GetTextWidth(hDC, "A Sample Text", hFont)
   MsgInfo("Text Width: "+ hb_ValToStr(nTextWidth))

   If .Not. DeleteHFont(hFont)
      MsgInfo("Can't delete logical font", "DeleteHFont fail")
   EndIf

   If .Not. ReleaseDC(nFormHandle, hDC) // release DC after using it
      MsgInfo("Can't release device context", "ReleaseDC fail")
   EndIf

Return

/* Draw ruler (150 pixels width) */
Procedure cmdDrawRuler_Click

   Local nFormHandle := GetFormHandle("MainWindow") // Get form handle
   Local hDC, nI, nCol

   If nFormHandle = 0
      MsgInfo("Can't get form handle", "GetFormHandle fail")
      Return
   EndIf

   hDC := GetDC(nFormHandle) // Must release DC after using it
   If hDC = 0
      MsgInfo("Can't get device context", "GetDC fail")
      Return
   EndIf

   // DrawLine( row1, col1, row2, col2 )
   DrawLine( hDC, 140, 20, 140, 170 )
   For nI := 0 To 15
      nCol := nI*10+20
      DrawLine( hDC, 135, nCol, 145, nCol )
   Next
   For nI := 0 To 3
      nCol := nI*50+20
      DrawLine( hDC, 130, nCol, 150, nCol )
   Next

   If .Not. ReleaseDC(nFormHandle, hDC) // release DC after using it
      MsgInfo("Can't release device context", "ReleaseDC fail")
   EndIf

Return

Regards,
Kek

[hmgchang]

Dear Masters,

I found win_prn_gettextwidth() in hbwin-32.dll....
is it same with gettextwidth() ?

the function to calc the printed width still not always accurate ...


TIA

thks n rgds
Chang

[Rathinagiri]

I think you can use the following code if select printer command is given and then used.

Code: Select all

function printLen( cString, nFontsize, cFontname)
  return round( gettextwidth( OpenPrinterGetDC(), cString, _HMG_CREATEFONT( OpenPrinterGetDC(), cFontname, nFontSize ) ) * 0.0254 * nFontsize, 2 )

#pragma BEGINDUMP

#include "SET_COMPILE_HMG_UNICODE.ch"

#ifndef COMPILE_HMG_UNICODE
   #define COMPILE_HMG_UNICODE   // Force to compile in UNICODE
#endif

#include "HMG_UNICODE.h"

#include <windows.h>
#include "hbapi.h"

HB_FUNC ( _HMG_CREATEFONT )
 
{
   HFONT hFont ;
   int bold = FW_NORMAL;
   int italic = 0;
   int underline = 0;
   int strikeout = 0;

   if ( hb_parl (4) )
      bold = FW_BOLD;

   if ( hb_parl (5) )
      italic = 1;

   if ( hb_parl (6) )
      underline = 1;

   if ( hb_parl (7) )
      strikeout = 1;

   HDC hDC = (HDC) HMG_parnl (1);
   TCHAR *FontName = (TCHAR *) HMG_parc (2);
   INT FontSize = hb_parni (3);

   SetGraphicsMode (hDC, GM_ADVANCED);

   FontSize = FontSize * GetDeviceCaps (hDC, LOGPIXELSY) / 72;   // Size of font in logic points

   hFont = CreateFont (0-FontSize, 0, 0, 0, bold, italic, underline, strikeout,
           DEFAULT_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH | FF_DONTCARE, FontName);

   HMG_retnl ((LONG_PTR) hFont );
}

#pragma enddump
  

It is from http://hmgforum.com/viewtopic.php?f=36&t=3776

[hmgchang]

Ops sorry Sir, i repeat my silly question again !
I try after upgrade to 3.3.1 !

Tia

Best rgds
Chang

[Javier Tovar]

Hola a todos,

Interesantes funciones!

Gracias por compartir!

Saludos
//////////////////////////////////////////////////////////////////////////////////
Hi all,

Capabilities!

Thanks for sharing!

greetings

[Pablo César]

It seems that GetTextWidth is based on when the control is being defined and is not changeable it properties even being forced thru SetProperty...

// Create logical font and select into DC (device context)
// Must use DelectObject to destroy the logical font
HB_FUNC( CREATELOGFONT )

Thank you Ken to share !

[esgici]

I think you can use the following code if select printer command is given and then used.

Thanks Mr. Rathinagiri

Added a small Main() procedure to make a working sample for this function

Code: Select all

#include <hmg.ch>

PROCEDURE MAIN()
   SELECT PRINTER DEFAULT
   START  PRINTDOC 
   MsgBox( printLen( "this is a test cString", 8, "Lucida" ), "Result" )
   END PRINTDOC 
RETURN // Main()

*.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._

[hmgchang]

Dear Masters,

I tried and modified your ssw as follow,

Code: Select all

#include <hmg.ch>

Function Main

    DEFINE WINDOW Form_1 ;
      AT 0,0 ;
      WIDTH 400 ;
      HEIGHT 400 ;
      MAIN;
      TITLE 'PrintLen Test' ;
      ON INIT PrintLenTest()
    END WINDOW
    
    CENTER WINDOW Form_1
    ACTIVATE WINDOW Form_1

Return

FUNCTION PrintLenTest()
   cString := "this is a test String"
   cFont := "Lucida" // "Times New Roman"
   nSize := 10
   SELECT PRINTER DIALOG TO lSuccess PREVIEW
   START  PRINTDOC
     START PRINTPAGE
       nWidth := printLen( cString, nSize, cFont ) 
       MsgBox( nWidth, "Result" )
       @ 10, 10 PRINT DATA cString FONT cFont SIZE nSize
       @ 17, 10 PRINT LINE TO 17, 10 + nWidth
       
       nWidth := HFprintLen( cString, nSize, cFont ) 
       MsgBox( nWidth, "Result" )
       @ 20, 10 PRINT DATA cString FONT cFont SIZE nSize
       @ 27, 10 PRINT LINE TO 27, 10 + nWidth
       
       // other font
       cFont := "Times New Roman"
       nWidth := printLen( cString, nSize, cFont ) 
       MsgBox( nWidth, "Result" )
       @ 30, 10 PRINT DATA cString FONT cFont SIZE nSize
       @ 37, 10 PRINT LINE TO 37, 10 + nWidth
       
       nWidth := HFprintLen( cString, nSize, cFont ) 
       MsgBox( nWidth, "Result" )
       @ 40, 10 PRINT DATA cString FONT cFont SIZE nSize
       @ 47, 10 PRINT LINE TO 47, 10 + nWidth
     END PRINTPAGE
   END PRINTDOC
RETURN // Main()

function HFprintLen( cString, nFontsize, cFontname)
  return round( gettextwidth( OpenPrinterGetDC(), cString, _HMG_CREATEFONT( OpenPrinterGetDC(), cFontname, nFontSize ) ) * 0.0254 * nFontsize, 2 )

#pragma BEGINDUMP

#include "SET_COMPILE_HMG_UNICODE.ch"

#ifndef COMPILE_HMG_UNICODE
   #define COMPILE_HMG_UNICODE   // Force to compile in UNICODE
#endif

#include "HMG_UNICODE.h"

#include <windows.h>
#include "hbapi.h"

HB_FUNC ( _HMG_CREATEFONT )
 
{
   HFONT hFont ;
   int bold = FW_NORMAL;
   int italic = 0;
   int underline = 0;
   int strikeout = 0;

   if ( hb_parl (4) )
      bold = FW_BOLD;

   if ( hb_parl (5) )
      italic = 1;

   if ( hb_parl (6) )
      underline = 1;

   if ( hb_parl (7) )
      strikeout = 1;

   HDC hDC = (HDC) HMG_parnl (1);
   TCHAR *FontName = (TCHAR *) HMG_parc (2);
   INT FontSize = hb_parni (3);

   SetGraphicsMode (hDC, GM_ADVANCED);

   FontSize = FontSize * GetDeviceCaps (hDC, LOGPIXELSY) / 72;   // Size of font in logic points

   hFont = CreateFont (0-FontSize, 0, 0, 0, bold, italic, underline, strikeout,
           DEFAULT_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH | FF_DONTCARE, FontName);

   HMG_retnl ((LONG_PTR) hFont );
}

#pragma enddump
 

then the preview as follow :

printlen.JPG (13.15 KiB) Viewed 3802 times

why is the printed string width does not equal to the value of the printline function ?
( in preview the string width <> length of the line )

Pls advise if i missed or make mistakes ...

TIA

Best rgds,
Chang

[Pablo César]

Syntax of GetTextWidth:
1st parameter is HDC, handle to device context
2nd parameters is text
3rd parameters is HFONT, handle to logical font

When 1st parameter is Nil, the function will get DC from active window.
I can't find the HMG function to create HFONT. Maybe need some low level WINAPI function.

Hi Kek and others,

I wish to share what Dr. Soto has recently passed to me and I believe, it could be useful:

To GET the FONT's handle from a control or from a window, you can use this:

#define WM_GETFONT 0x0031
hFont := SendMessage (ControlHandle, WM_GETFONT, 0, 0)

I hope be useful.