Date: 02-16-2022
Return to Index
created by gbSnippets
'Some applications, such as HTML, do not support TAB
'characters so conversion to spaces is a useful technique.
'With variable width fonts the width of the space
'characters must be taken into account to determine
'how many spaces need to be added to pad content to
'reach the a TAB stop.
'Primary Code:
'Two approaches are provided as Functions. For length
'reasons they are provided only in the compilable code below.
'Both approaches parse text into lines, then lines into elements
'which were separated by tab characters. They differ in how
'the spaces are added.
'Approach#1 - calculates the needed number of spaces and
'uses the SPACE$ function to all that many spaces.
'Approach #2 - adds one space at a time, measuring the resulting
'length. Stops adding when the length goes beyond a tab stop. This
'approach may seem more brute force, but actually makes for simpler code.
'Also, the following function for getting the width of any
'text, given a specific font. is used (split apart in the
'compilable example to avoid running parts of it more than once.
Function GetTextWidth(buf$, hWnd as DWord) as Single
Local hDC as DWord, R as Rect
hDC = GetDC(hWnd)
hFont = SendMessage (hWnd, %WM_GETFONT, 0, 0)
SelectObject hDc, hFont
DrawTextEx hDC, ByVal StrPTR(buf$), Len(buf$), R, %DT_CalcRect, ByVal 0
Function = (R.nright - R.nleft)/GetDeviceCaps(hdc, %LOGPIXELSX)
ReleaseDC hWnd, hDC
End Function
'Compilable Example: (Jose Includes)
'The code below shows how to parse the text into lines, then parse
'each line on $tab characters. Each tab character is then replaced with
'the number of spaces in one of two approaches. Default tabstops
'of 0.5" are used in this example.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "win32api.inc"
#Include "RichEdit.inc"
#Include "CommCtrl.inc"
Global hDlg as DWord, hRichEdit as DWord, TabLoc() as Single, hFont as DWord, hDC as DWord
%ID_RichEdit = 500
Function PBMain() As Long
Local style&, buf$
buf$ = "This is" + $Tab + $Tab + "an example" + $Tab + "of a string with an embedded tab character."
buf$ = buf$ + $crlf + "2This is" + $Tab + "2an example" + $Tab + "2of a string with an embedded tab character."
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,550,150, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, 100,"Print", 30,10,140,20
LoadLibrary("riched32.dll") : InitCommonControls
Control Add "RichEdit", hDlg, %ID_RichEdit, buf$,20,40,510,100, style&, %WS_EX_ClientEdge
Control Handle hDlg, %ID_RichEdit To hRichEdit
Font New "Comic Sans MS", 10, 0 To hFont
Control Set Font hDlg, %ID_RichEdit, hFont
hDC = GetDC(hRichEdit)
hFont = SendMessage (hRichEdit, %WM_GETFONT, 0, 0)
SelectObject hDc, hFont
Dialog Show Modal hDlg Call DlgProc
ReleaseDC hRichEdit, hDC
End Function
CallBack Function DlgProc() As Long
If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
Local temp$, w as Single, h as Single, i as Long
ReDim TabLoc(50) 'tab locations
For i = 0 To 50 : TAbLoc(i) = i * 0.5 : Next i '0.5" tab locations
Control Get Text hDlg, %ID_RichEdit To temp$
temp$ = ConvertTABtoSpace (temp$) 'converted TABs to spaces
Control Set Text hDlg, %ID_RichEdit, temp$
End If
End Function
Function ConvertTABtoSpace(ByVal text$) As String
'build string with variable # of spaces to reach TAB stops
Local i As Long, j As Long, temp$, iSpaces&, iSpaceWidth!, result$, tempWidth!, ncWidth!, ncHeight!
Dim D(ParseCount(text$,$CrLf)-1) As String, iTab&, R as Rect
'split text into lines, put in array D()
Parse text$, D(), $CrLf
'get/save width of space for current font
temp$ = " "
' GetTextExtentPoint32 (hDc, ByVal StrPTR(temp$), Len(temp$), R)
DrawTextEx hDC, ByVal StrPTR(temp$), Len(temp$), R, %DT_CalcRect, ByVal 0
iSpaceWidth! = (R.nright - R.nleft)/GetDeviceCaps(hdc, %LOGPIXELSX)
'build replacement string, substituting tabs with variable # of spaces (to reach tab locations)
For j = 0 To UBound(D)
temp$ = ""
For i = 1 To ParseCount(D(j), $Tab)
temp$ = temp$ + Parse$(D(j),$Tab, i)
' GetTextExtentPoint32 (hDc, ByVal StrPTR(temp$), Len(temp$), R)
DrawTextEx hDC, ByVal StrPTR(temp$), Len(temp$), R, %DT_CalcRect, ByVal 0
tempWidth! = (R.nright - R.nleft)/GetDeviceCaps(hdc, %LOGPIXELSX)
iTab& = Fix(tempWidth!/0.5)+1 'next tab location after current endpoint
iSpaces& = (TabLoc(iTab&)-tempWidth!) / iSpaceWidth! '#spaces to widen to next tab location
temp$ = temp$ + Space$(iSpaces&)
'add extra single space as needed to ensure current tab position is crossed
' GetTextExtentPoint32 (hDc, ByVal StrPTR(temp$), Len(temp$), R)
DrawTextEx hDC, ByVal StrPTR(temp$), Len(temp$), R, %DT_CalcRect, ByVal 0
tempWidth! = (R.nright - R.nleft)/GetDeviceCaps(hdc, %LOGPIXELSX)
If tempWidth! < TabLoc(iTab&) Then temp$ = temp$ + " "
Next i
result$ = result$ + $CrLf + temp$
Next J
Function = Mid$(result$,3)
End Function
Function ConvertTABtoSpace2(ByVal text$) As String
'build string one space at a time until length reaches TAB stops
Local i As Long, j As Long, temp$, iSpaces&, iSpaceWidth!, result$, tempWidth!, ncWidth!, ncHeight!
Dim D(ParseCount(text$,$CrLf)-1) As String, iTab&, R as Rect
'split text into lines, put in array D()
Parse text$, D(), $CrLf
'build replacement string, substituting tabs with variable # of spaces (to reach tab locations)
For j = 0 To UBound(D)
temp$ = ""
For i = 1 To ParseCount(D(j), $Tab)
temp$ = temp$ + Parse$(D(j),$Tab, i)
DrawTextEx hDC, ByVal StrPTR(temp$), Len(temp$), R, %DT_CalcRect, ByVal 0
tempWidth! = (R.nright - R.nleft)/GetDeviceCaps(hdc, %LOGPIXELSX)
iTab& = Fix(tempWidth!/0.5)+1 'next location tab after current endpoint
Do
temp$ = temp$ + " "
DrawTextEx hDC, ByVal StrPTR(temp$), Len(temp$), R, %DT_CalcRect, ByVal 0
tempWidth! = (R.nright - R.nleft)/GetDeviceCaps(hdc, %LOGPIXELSX)
Loop While tempWidth! < TabLoc(iTab&)
Next i
result$ = result$ + $CrLf + temp$
Next J
Function = Mid$(result$,3)
End Function
'gbs_00306
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm