Re: Accuracy of GetTextWidth()
Posted: Tue Aug 19, 2014 5:45 pm
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.
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
Kek
