Get Physical Length of String

Category: Strings

Date: 03-28-2012

Return to Index


 
'Before putting text into a control, it's helpful to know how long the text
'is - to see if it will fit or to see how big to make the control.
 
'Primary Code:
'The GetTextExtentPoint32 returns width in pixels, which is used with
'GetDeviceCaps to convert to inches.
Function GetTextWidth(buf$, hWnd as Dwordas Single
      Local hDC as Dword, R as SizeL
      hDC = GetDC(hWnd)
      hFont = SendMessage (hWnd, %WM_GETFONT, 0, 0)
      SelectObject hDc, hFont
      GetTextExtentPoint32 (hDc, ByVal StrPTR(buf$), Len(buf$), R)
      Function = R.cx/GetDeviceCaps(hdc, %LOGPIXELSX)
      ReleaseDC hWnd, hDC
End Function
 
'Compilable Example:
'This example calculates string width in a RichEdit control, but should
'work for any control or even for the dialog.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "win32api.inc
#Include "RichEdit.inc"
#Include "CommCtrl.inc"
Global hDlg as Dword, hRichEdit as Dword, hFont as Dword
%ID_RichEdit = 500
 
Function PBMain() As Long
   Local style&, buf$
   buf$ =  "This" + $Tab + "text" + $Tab + "rocks!" + $crlf + String$(6,"x") +$crlf + String$(12,"x")
   style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
      Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
   Dialog New Pixels, 0, "Test Code",300,300,200,150, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Push", 30,10,140,20
   LoadLibrary("riched32.dll") : InitCommonControls
   Control Add "RichEdit", hDlg, %ID_RichEdit, buf$,20,40,160,100, style&, %WS_EX_ClientEdge
   Control Handle hDlg, %ID_RichEdit To hRichEdit
   Font New "Comic Sans MS", 10,1 To hFont
   Control Set Font hDlg, %ID_RichEdit, hFont
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
      Local buf$
      buf$ = String$(6,"x")
      MsgBox Str$( GetTextWidth(buf$, hRichEdit) )
      buf$ = String$(12,"x")
      MsgBox Str$( GetTextWidth(buf$, hRichEdit) )
   End If
End Function
 
Function GetTextWidth(buf$, hWnd as Dwordas Single
   Local hDC as Dword, R as SizeL
   hDC = GetDC(hWnd)
   hFont = SendMessage (hWnd, %WM_GETFONT, 0, 0)
   SelectObject hDc, hFont
   GetTextExtentPoint32 (hDc, ByVal StrPTR(buf$), Len(buf$), R)
   Function = R.cx/GetDeviceCaps(hdc, %LOGPIXELSX)
   ReleaseDC hWnd, hDC
End Function
 
'gbs_00304
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm