Word Wrap - Long Word Handling

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 10
#Compile Exe "gbsplitword.exe"
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg,hFont As Dword
%IDC_Graphic = 500
 
Function PBMain() As Long
   Dialog New Pixels, 0, "WordWrap Test",0,0,700,1000, %WS_OverlappedWindow To hDlg
   Control Add Graphic, hDlg, %IDC_Graphic, "",0,0,700,1000, %WS_Border
   Graphic Attach hDlg, %IDC_Graphic
   Font New "Tahoma", 112,1 To hFont
   Graphic Set Font hFont
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local w,h As Long, Part1, Part2 As String
   Select Case Cb.Msg
      Case %WM_Size
         Dialog Get Client hDlg To w,h
         Control Set Size hDlg, %IDC_Graphic, w,h
         Graphic Clear
         Wrap "Superman is the superhero of your dreams!"
'         Wrap "Now is the time for all good men to eat cake!"
   End Select
End Function
 
Sub Wrap(FullString$)
   Local Part1, Part2 As String, w As Long
   w = Graphic(Client.X)
   gbSplitWord FullString$, w, Part1, Part2
   While Len(Part2)
      Graphic Print Part1
      gbSplitWord Part2, w, Part1, Part2
   Wend
   Graphic Print Part1
End Sub
 
Sub gbSplitWord(ByVal FullString$, w As Long, Part1 As String, Part2 As String)
   Local i As Long, PreviousWords$, CurrentWord$
 
   'if only one word is in the string (no delimiter), use the entire string as Part1
   i = InStr(FullString$,$Spc)
   If i = 0 Then Part1 = FullString$ : Part2 = "" : Exit Sub
 
   'if 1st word is wider than available width, use that word as Part1
   Part1 = Left$(FullString$,i-1)
   If Graphic(Text.Size.X,Part1) > w Then Part2 = Mid$(FullString$,i+1) : Exit Sub
 
   'go through all words
   For i = 1 To ParseCount(FullString$,$Spc) 'cycle through all words
      CurrentWord$ = Parse$(FullString$,$Spc,i)
      If Graphic(Text.Size.X, PreviousWords$ + IIf$(i=1,"",$Spc) + CurrentWord$) > w Then
         'adding CurrentWord WILL exceed available width
         Part1 = PreviousWords$
         Part2 = Mid$(FullString$, Len(Part1)+2)
         Exit Sub
      Else
         'adding CurrentWord WILL NOT exceed available width
         PreviousWords$ += IIf$(i=1,"",$Spc) + CurrentWord$
         Part1 = PreviousWords$
         Part2 = ""
      End If
   Next i
 End Sub
 

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