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.
Comments