Library code snippets
Altering the word break in a multiline text box
By MerrionComputing, published on 14 Jul 2001
Altering the word break in a multiline text box
This is an advanced topic and assumes an understanding of subclassing.
In this example we are subclassing an edit control to alter it's default processing of line breaks. Out of the box, a multi-line edit box will break a line wherever a space exists. This is inconvenient for users in countries where the regional settings predicate a space between digit groups in a number as the number can get broken accross different lines. The following prevents this:
'\ API DECLARATIONS
'\ Sending messages to a window....
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const EM_GETWORDBREAKPROC = &HD1 'wp = 0L, lp = 0L
Public Const EM_SETWORDBREAKPROC = &HD0 'wp = 0L, lp = procaddress
'\ WORD BREAK PROC replacement.
'\ The C header definition is:
'typedef int (CALLBACK* EDITWORDBREAKPROCA)(LPSTR lpch, int ichCurrent, int cch, int code);
'\ ** Notice that the string which represents the content of the text box is passed to us as a long pointer. In order to translate this to a string the CopyMem API call is used:
Public Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'\ --[StringFromPointer]----------------------------------------------
'\ Returns a VB string from an API returned string pointer
'\ -------------------------------------------------------------------
Public Function StringFromPointer(lpString As Long) As String
Dim sRet As String
Dim lret As Long
'\ Pre-initialise the return string...
sRet = Space$(1024)
CopyMemory ByVal sRet, ByVal lpString, ByVal Len(sRet)
If Err.LastDllError = 0 Then
If InStr(sRet, Chr$(0)) > 0 Then
sRet = Left$(sRet, InStr(sRet, Chr$(0)) - 1)
End If
End If
StringFromPointer = sRet
End Function
'\ **This is a very useful utility function for a large number of API calls.
'\ ** Now that we have a way of getting the text from the textbox in this procedure, the logic to return where to break the lines can be written:
'\ --[VB_EDITWORDBREAKPROCA]------------------------------------------------------------
'\ 'typedef int (CALLBACK* EDITWORDBREAKPROCA)(LPSTR lpch, int ichCurrent, int cch, int code);
'\ This gets called by an edit control when a line of text has filled up the available
'\ space.
'\ By default, a text edit box breaks on spaces.
'\ (This version prevents numbers being broken up if the digit grouping sepeartor is a space.)
'\ -------------------------------------------------------------------------------------
Public Function VB_EDITWORDBREAKPROCA(ByVal lpch As Long, _
ByVal ichCurrent As Long, _
ByVal cch As Long, _
ByVal code As Long) As Long
On Local Error Resume Next
Dim sCharacters As String
Dim lCharPos As Long
sCharacters = StringFromPointer(lpch)
Select Case code
Case WB_ISDELIMITER
'\ Edit control is asking if this character is a wordbreak char...
'\ Reply FALSE is it is not a space, or if the characters either side of it
'\ are numbers....
If Mid$(sCharacters, ichCurrent, 1) = " " Then
VB_EDITWORDBREAKPROCA = 1
If (ichCurrent > 0) And (ichCurrent < Len(sCharacters)) Then
If IsNumeric(Mid$(sCharacters, ichCurrent - 1, 1)) And IsNumeric(Mid$(sCharacters, ichCurrent + 1, 1)) Then
VB_EDITWORDBREAKPROCA = 0
End If
End If
Else
VB_EDITWORDBREAKPROCA = 0
End If
Case WB_LEFT
'\ Find the begining of a word to the left of this position....
For lCharPos = ichCurrent To 1 Step -1
If Mid$(sCharacters, lCharPos, 1) = " " Then
If Not (IsNumeric(Mid$(sCharacters, lCharPos - 1, 1)) And IsNumeric(Mid$(sCharacters, lCharPos + 1, 1))) Then
VB_EDITWORDBREAKPROCA = lCharPos
Exit For
End If
End If
Next lCharPos
Case WB_RIGHT
'\ Find the begining of a word to the right of this position....
For lCharPos = ichCurrent To Len(sCharacters)
If Mid$(sCharacters, lCharPos, 1) = " " Then
If Not (IsNumeric(Mid$(sCharacters, lCharPos - 1, 1)) And IsNumeric(Mid$(sCharacters, lCharPos + 1, 1))) Then
VB_EDITWORDBREAKPROCA = lCharPos
Exit For
End If
End If
Next lCharPos
End Select
End Function
'\ ** All that remains now is to tell the textbox that it is being subclassed:
'\ --[SetWordbreakProc]-----------------------------------------------
'\ Replaces the textbox's default word break proc with a custom one
'\ which can be used for altering th eway lines are broken up in
'\ a multi-line textbox.
'\ -------------------------------------------------------------------
Private Sub SetWordbreakProc(txtSubclass As TextBox)
Dim lret As Long
lDefWordbreakProc = SendMessageLong(txtSubclass.hwnd, EM_GETWORDBREAKPROC, 0, 0)
lret = SendMessageLong(txtSubclass.hwnd, EM_SETWORDBREAKPROC, 0, AddressOf VB_EDITWORDBREAKPROCA)
End Sub
'\ Note that this can be used for any number of edit boxes.
Related articles
Related discussion
-
Run-time error '91'
by converter2009 (1 replies)
-
VB6 Runtime error 381 subsript out of range Error
by Uncle (2 replies)
-
passing and reading parameters from using Shell
by jigartoliya (0 replies)
-
Convert C++ code to VB6
by mawcot (4 replies)
-
listbox scrollbar
by Dennijr (10 replies)
Related podcasts
-
Christian Beauclair
14 mai 2008 (�mission #0074) ::.Christian Beauclair: Stratégies de migration VB6 vers .NET Nous discutons avec Christian Beauclair des stratégies de migration VB6 vers .NET. Entre autres, nous discutons comment utiliser le "VB 6 Code Advisor" et le "Interop Forms Toolkit" pour ajouter la puiss...
Thanks for the code; I am implementing a phonetic write using Richtextbox for regional language. The code given works fine after a bit of modification. My problem is if I call API call to Justify text in Richtextbox then the above routine does not work. The Justify code is given under
Public Function SetAlignment(lHwnd As Long, ByVal eAlign As ERECParagraphAlignmentConstants)
Dim tP2 As PARAFORMAT2
Dim lR As Long
tP2.dwMask = PFM_ALIGNMENT
tP2.cbSize = Len(tP2)
tP2.wAlignment = eAlign
lR = SendMessageLong(lHwnd, EM_SETTYPOGRAPHYOPTIONS, _ TO_ADVANCEDTYPOGRAPHY, TO_ADVANCEDTYPOGRAPHY)
lR = SendMessage(lHwnd, EM_SETPARAFORMAT, 0, tP2)
End Function
But after this the cases
Case WB_ISDELIMITER
Case WB_RIGHT and
Case WB_LEFT
is not at all called in the
Public Function VB_EDITWORDBREAKPROCA(ByVal lpch As Long, _
ByVal ichCurrent As Long, _
ByVal cch As Long, _
ByVal code As Long) As Long
So the in the Justified text line breaks occurs at different places other that " "
Any help would be greatly appreciated.
The Product I am using is a free tool for any regional languages. The whole comunity would be benifited.
Regards,
Deeptish
This thread is for discussions of Altering the word break in a multiline text box.