'===========================================================================
' Subject: Word wrap in PBWIN                 Date: 03-16-03 (  :  )       
'  Author: Edwin_Knoppert                     Code: PBDLL                  
'  Origin: ABC Archives Forum               Packet: TEXT.ABC
'===========================================================================
Compile Exe 

Option Explicit 

#Include "win32api.inc" 

'================================================================= 
' WordWrap proc. 
' I believe this is a true wordwrap procedure. 
' Similar to a textbox 
' The good new is that it works (i hope) for every Device Context! 
' The example containes textboxes. 
' These are never required by the wordwrap procedure itself! 
'================================================================= 

' hDC, target DC to measure text upon, can be a printer. 
' Be sure you have selected desired font into the DC. 
' sText, whatever text you want to wrap (if needed). 
' nWidth, the desired width in device pixels. 
' Returns modified string. 
Function WordWrap( ByVal hDC As Long, ByVal sText As String, ByVal nWidth As Long ) As String 

Dim a As Long 
Dim T As String 
Dim nCount As Long 
Dim sOut As String 
Dim PA As POINTAPI 
Dim R As RECT 
Dim DTP As DRAWTEXTPARAMS 

If hDC = 0 Then Exit Function 
If nWidth < 1 Then Exit Function 

GetCurrentPositionEx hDC, PA 

T = sText 

Do While T > "" 

R.nLeft = 0: R.nTop = 0: R.nRight = nWidth: R.nBottom = 0 
DTP.cbSize = Len( DTP ) 
DrawTextEx hDC, ByVal StrPtr( T ), Len( T ), R, %DT_BOTTOM Or %DT_EDITCONTROL Or %DT_WORDBREAK, DTP 
If DTP.uiLengthDrawn = 0 Then Exit Do 
sOut = sOut & RTrim$( Left$( T, DTP.uiLengthDrawn ), $CrLf ) 
T = Mid$( T, DTP.uiLengthDrawn + 1 ) 
If Len( T ) Then sOut = sOut & $CrLf 

Loop 

MoveTo hDC, PA.X, PA.Y 

Function = sOut 

End Function 


'===================================================== 
' Ordinary dialog for testing 
'===================================================== 

CallBack Function DlgProc() As Long 

Dim a As Long 
Dim R As Rect 
Dim T As String 
Dim hDC As Long 
Dim hFont As Long 
Dim hOldFont As Long 

Select Case CbMsg 
Case %WM_INITDIALOG 

'// Prepare a string to be modified. 
T = Repeat$( 12, "Aa" ) & $CrLf 
T = T & Repeat$( 5, "Bb" ) & $CrLf 
T = T & Repeat$( 15, "Cc Dd" ) 
T = T & Repeat$( Rnd( 5, 20 ), "xXx" ) 

'// Show this in the 1st textbox, just to show you how it will get wrapped. 
Control Add TextBox, CbHndl, 100, T, 2, 2, 100, 150 _ 
, %ES_MULTILINE _ 
Or %ES_WANTRETURN _ 
Or %WS_TABSTOP 

'// Measure the width of this textbox. 
'// We need it for the wordwrap as comparisation to the original textbox wrapping. 
GetWindowRect GetDlgItem( CbHndl, 100 ), R 

'// We need a target DC to make wordwarp possible. 
'// This example uses the screen device. 
hDC = GetDC( %HWND_DESKTOP ) 

'// Get the font from the edit field. 
'// Select it in the screen DC. 
hFont = SendDlgItemMessage( CbHndl, 100, %WM_GETFONT, 0, 0 ) 
If hFont Then hOldFont = SelectObject( hDC, hFont ) 

'// Now let's wordwrap! 
T = WordWrap( hDC, T, R.nRight - R.nLeft ) 

'// Deselect font from DC. 
If hFont Then hOldFont = SelectObject( hDC, hOldFont ) 

'// Release the DC again (don't forget). 
ReleaseDC %HWND_DESKTOP, hDC 

'// Place the modified text in the 2nd textbox. 
'// If everything goes fine, it should look similar as tb1. 
Control Add TextBox, CbHndl, 101, T, 112, 2, 100, 150 _ 
, %ES_MULTILINE _ 
Or %ES_WANTRETURN _ 
Or %WS_TABSTOP _ 
Or %WS_HSCROLL _ 

End Select 

End Function 

Function WinMain ( ByVal hCurInstance As Long, _ 
ByVal hPrevInstance As Long, _ 
lpszCmdLine As Asciiz Ptr, _ 
ByVal nCmdShow As Long ) As Long 

Dim a As Long 
Dim hDlg As Long 
Dim Result As Long 

Dialog New 0, "WordWrap for any DC",,, 240, 180 _ 
, %WS_OVERLAPPED _ 
Or %WS_SYSMENU _ 
Or %WS_MINIMIZEBOX _ 
Or %WS_MAXIMIZEBOX _ 
Or %WS_THICKFRAME _ 
Or %WS_CLIPSIBLINGS _ 
Or %WS_CLIPCHILDREN _ 
To hDlg 

If hDlg = 0 Then Exit Function 

Dialog Show Modal hDlg Call DlgProc To Result 

Function = 1 

End Function