Date: 02-16-2022
Return to Index
created by gbSnippets
'Word wrap is used to format text - on the screen or on a printer - to
'fit within an available area, or simply to make it visually more appealing.
'This snippet takes an incoming string (with no $crlf characters) and
'returns a string that uses $crlf characters to form lines of the specified
'width.
'Code is provided that handles width in pixels, inches, and characters.
'The code may be used to handle text containing $crlf characters by
'parsing the text on $crlf and feeding each parsed line to the snippet
'below.
'Primary Code:
'The approach used in this snippets is to parse the incoming string on spaces,
'creating an array of words. Looping through the word array, words are added
'to form lines until a maximum line size is reached. The lines is saved and
'the cycle starts over.
'The code is written as a function, allowing selection of the metric (pixels,
'inches, or characters) to be used for the wordwrap.
'The width of the text (pixels,inches) is measure in one of two ways. As
'written, it uses a GRAPHIC statement. In the example, wordwrap is applied
'to a textbox, which requires that a graphic target be attached that has
'the same font as the textbox.
'An alternate function for calculating text width is also provided which
'does not require the use of a graphic control.
'For length reasons, the wordwrap function is shown only in the compilable
'example below.
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg As DWord, Buffer As String
%IDC_Button1 = 500 : %IDC_Button2 = 501 : %IDC_Button3 = 502 : %IDC_TextBox = 503 : %IDC_Graphic = 504
Function PBMain() As Long
Local Style As Long
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 Or %WS_Border
Dialog New Pixels, 0, "Test Code",300,300,240,400, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %IDC_Button1,"Pixels", 50,10,100,20
Control Add Button, hDlg, %IDC_Button2,"Inches", 50,35,100,20
Control Add Button, hDlg, %IDC_Button3,"Characters", 50,60,100,20
buffer = "This is sample content for the textbox control, to be used for word wrapping tests. "
buffer = buffer + "How few lines of code can it take to get the job done? Anything less than "
buffer = buffer + "10 is a good answer. The input text must have no hard breaks (no $crlf characters)."
Control Add TextBox, hDlg, %IDC_TextBox,Buffer, 20,90,200,250, Style
Control Add Graphic, hDlg, %IDC_Graphic,"", 500,40,800,800 'used only for access to Graphic Text Size statement
Graphic Attach hDlg, %IDC_Graphic
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case CB.Msg
Case %WM_Command
Select Case CB.Ctl
Case %IDC_Button1 : Control Set Text hDlg, %IDC_TextBox, Buffer
Control Set Text hDlg, %IDC_TextBox, WordWrap(Buffer,80,0) '0-pixels
Case %IDC_Button2 : Control Set Text hDlg, %IDC_TextBox, Buffer
Control Set Text hDlg, %IDC_TextBox, WordWrap(Buffer,1.25,1) '1-inches
Case %IDC_Button3 : Control Set Text hDlg, %IDC_TextBox, Buffer
Control Set Text hDlg, %IDC_TextBox, WordWrap(Buffer,30,2) '2-characters
End Select
End Select
End Function
Function WordWrap(ByVal temp As String, mw As Single, Flag As Long) As String 'WL=WordList() mw=MaxWidth (pixel)
Local i, PPIx, PPIy As Long, CL, Rtn As String, w,h,r,s As Single
Dim WL(ParseCount(temp," ")-1) As String
Parse temp, WL(), " " 'parse on a space
For i = 0 To UBound(WL)
Select Case Flag
Case 0,1 'pixels/inches
Graphic Text Size CL To r,s 'returns pixels
Graphic Text Size (CL + " " + WL(i)) To w,h 'returns pixels
If Flag = 1 Then Graphic Get PPI To PPIx, PPIy : w = w/PPIx : r = r/PPIx 'converts to inches
'w = GetTextWidth (CL + " " + WL(i),%IDC_TextBox,Flag) 'optionally replace GRAPHIC statements
Case 2 'characters
r = Len(CL)
w = Len(CL + " " + WL(i)) 'line length if WL(i) is added (characters)
End Select
If w >= mw Or i=UBound(WL) Then 'do something if long line or is last element of word array
Rtn = Rtn+IIF$(Len(Rtn),$CrLf,"")+ CL + IIF$(i=UBound(WL), IIF$(w<mw," ",$CrLf)+WL(i),"")
CL = WL(i) 'start a new line
Else
CL = CL + IIF$(i=0,"",IIF$(r<mw," ","")) + WL(i) 'add word to current line. no preceding space if first word in line. no suffix space if CL is longer than mw.
End If
Next i
Function = Rtn
End Function
Function GetTextWidth(Buffer As String, CtlID As DWord, Flag As Long) As Single
Local hDC, hFont, hControl As DWord, R As SizeL
Control Handle hDlg, CtlID To hControl
hDC = GetDC(hControl)
hFont = SendMessage (hControl, %WM_GETFONT, 0, 0)
SelectObject hDc, hFont
GetTextExtentPoint32 (hDC, ByVal StrPTR(Buffer), Len(Buffer), R)
Function = R.cx / IIF(Flag,1,GetDeviceCaps(hDC, %LOGPIXELSX)) '0=pixels 1=inches
ReleaseDC hControl, hDC
End Function
'gbs_00556
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm