www.pudn.com > windowsrunning > modEditMessages.bas
Attribute VB_Name = "modEditMessages"
Option Explicit
' Note: because of the vast complexity of sending messages around the place,
' I have used private copies of sendmessage and postmessage in here.
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function SSendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
' The extra S stands for special- used only for string manipulation.
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
' For EM_GETSEL
Private Declare Function RefSendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByRef wParam As Long, ByRef lParam As Long) As Long
Public Sub SendEditMessage(ByRef Textout As TextBox, ByVal Message As Long, ByVal wParam As Variant, ByVal lParam As Variant, ByVal hWnd As Long)
' Oh, don't worry, there's only HOW MANY STUPID MESSAGES?!?!?!?
Dim Temp As String
Dim Result As Long
Dim wTemp As Long
Dim lTemp As Long
Dim TempRect As RECT
Select Case Message
' Start with the easy ones.
' EM_Undo, and WM_Undo
Case Is = EM_UNDO
Result = SendMessage(hWnd, EM_UNDO, &H0, &H0)
If Result <> 0 Then Temp = "True" Else Temp = "False"
Case Is = WM_UNDO
Result = SendMessage(hWnd, WM_UNDO, &H0, &H0)
If Result <> 0 Then Temp = "True" Else Temp = "False"
' Next can come more easy ones.
' WM_COPY, CUT, and PASTE
Case Is = WM_COPY
Result = SendMessage(hWnd, WM_COPY, &H0, &H0)
Temp = "True - " & Trim(Str(Result)) & " characters copied."
Case Is = WM_CUT
Result = SendMessage(hWnd, WM_CUT, &H0, &H0)
Temp = "True"
Case Is = WM_PASTE
Result = SendMessage(hWnd, WM_PASTE, &H0, &H0)
Temp = "True"
' Hopefully this next batch won't be too hard either.
' EM_GET and EM_SET PASSWORDCHAR
Case Is = EM_GETPASSWORDCHAR
Result = SendMessage(hWnd, EM_GETPASSWORDCHAR, &H0, &H0)
If Result <> 0 Then
Temp = Trim(Str(Result)) & " - """ & Chr$(Result) & """"
Else
Temp = Trim(Str(Result)) & " - No password character"
End If
Case Is = EM_SETPASSWORDCHAR
If Not IsNumeric(wParam) Then
Temp = "Error in wParam"
Else
Result = SendMessage(hWnd, EM_SETPASSWORDCHAR, CLng(CByte(wParam)), &H0)
If Val(wParam) = 0 Then
Temp = "Password Character set to nothing."
Else
Temp = "Password Character set to """ & Chr$(wParam) & """."
End If
End If
' A few more easy ones - the limit stuph. As Setlimtext and straight limtext are the same...
Case Is = EM_SETLIMITTEXT
'Case Is = EM_LIMITTEXT
If Not IsNumeric(wParam) Then
Temp = "Error in wParam"
Else
Result = SendMessage(hWnd, EM_SETLIMITTEXT, CLng(wParam), &H0)
If Val(wParam) = 0 Then
Temp = "Max text length limit removed."
Else
Temp = "Max text length limit set to " & Trim(Str(wParam)) & "."
End If
End If
Case Is = EM_GETLIMITTEXT
Result = SendMessage(hWnd, EM_GETLIMITTEXT, &H0, &H0)
If Result = 0 Then
Temp = "There is no limit to the amount of text placed in the edit control."
Else
Temp = "There is a limit of " & Trim(Str(Result)) & " characters for this edit control."
End If
' Now I'll just have to plow through them all. Of course, I start with the easy ones...
Case Is = EM_CANUNDO
Result = SendMessage(hWnd, EM_CANUNDO, &H0, &H0)
If Result = 0 Then
Temp = "0 - Cannot undo"
Else
Temp = "1 - Undo data exists"
End If
Case Is = EM_SETTABSTOPS
Temp = "Cannot implement this yet due to technical troubles"
Case Is = EM_GETMODIFY
Result = SendMessage(hWnd, EM_GETMODIFY, &H0, &H0)
If Result = 0 Then
Temp = "False - Not modified"
Else
Temp = "True - Modified"
End If
Case Is = EM_SETMODIFY
If Not IsNumeric(wParam) Then
Temp = "Error in wParam"
Else
Result = SendMessage(hWnd, EM_SETMODIFY, CLng(Abs(CBool(wParam))), &H0)
If Val(wParam) = 0 Then
Temp = "Modify bit cleared"
Else
Temp = "Modify bit set"
End If
End If
Case Is = EM_SETREADONLY
If Not IsNumeric(wParam) Then
Temp = "Error in wParam"
Else
Result = SendMessage(hWnd, EM_SETREADONLY, CLng(Abs(CBool(wParam))), &H0)
If Val(wParam) = 0 Then
Temp = "Read-only bit cleared"
Else
Temp = "Read-only bit set"
End If
End If
Case Is = EM_GETTHUMB
Result = SendMessage(hWnd, EM_GETTHUMB, &H0, &H0)
Temp = "Thumb is at position " & Trim(Str(Result)) & ". If you can get this value to be other than 0, TELL ME!"
Case Is = EM_EMPTYUNDOBUFFER
Result = SendMessage(hWnd, EM_EMPTYUNDOBUFFER, &H0, &H0)
Temp = "Undo buffer is emptied."
' Finally, a slightly technical hitch ={
Case Is = EM_GETLINE
If Not IsNumeric(wParam) Or wParam < 0 Then
Temp = "Error in wParam"
Else
'CopyMemory TempByte(1), ByVal "512"
'Temp = TempByte(1) & TempByte(2) & Space$(510)
'Result = SSendMessage(hWnd, EM_GETLINE, wParam, Temp)
Temp = "Due to technical difficulties, this function is not working."
End If
Case Is = EM_GETLINECOUNT
Result = SendMessage(hWnd, EM_GETLINECOUNT, &H0, &H0)
Temp = Trim(Str(Result))
Case Is = EM_SETHANDLE
Temp = "Due to technical difficulties, this function is not working."
Case Is = EM_GETHANDLE
Result = SendMessage(hWnd, EM_GETHANDLE, &H0, &H0)
Temp = Trim(Str(Result))
Case Is = EM_GETFIRSTVISIBLELINE
Result = SendMessage(hWnd, EM_GETFIRSTVISIBLELINE, &H0, &H0)
Temp = Trim(Str(Result)) & ": character number for single line edit classes, line number for multiline edit classes."
Case Is = EM_REPLACESEL
Result = SSendMessage(hWnd, EM_REPLACESEL, Val(wParam), lParam)
Temp = "Selection replaced by " & lParam
Case Is = EM_GETSEL
Result = RefSendMessage(hWnd, EM_GETSEL, wTemp, lTemp)
Temp = "Start: " & Trim(Str(wTemp)) & " End: " & Trim(Str(lTemp))
Case Is = EM_GETRECT
Result = SendMessage(hWnd, EM_GETRECT, &H0, TempRect)
Temp = "Left: " & Trim(Str(TempRect.Left)) & " Top: " & Trim(Str(TempRect.Top)) & " Right: " & Trim(Str(TempRect.Right)) & " Bottom: " & Trim(Str(TempRect.Bottom))
Case Is = EM_SCROLL
If wParam < 0 Or wParam > 4 Then
Temp = "Error in wParam"
Else
Result = SendMessage(hWnd, EM_SCROLL, wParam, &H0)
Temp = "Return Value: " & Trim(Str(Result))
End If
Case Is = EM_LINESCROLL
Result = SendMessage(hWnd, EM_LINESCROLL, wParam, lParam)
Temp = "Return Value: " & Trim(Str(Result))
Case Is = EM_LINEINDEX
If Not IsNumeric(wParam) Then
Temp = "Error in wParam."
Else
Result = SendMessage(hWnd, EM_LINEINDEX, wParam, &H0)
If Result = -1 Then
Temp = "Error"
Else
Temp = "Character offset is " & Trim(Str(Result)) & " for first character in line " & Trim(Str(wParam)) & "."
End If
End If
Case Is = EM_LINELENGTH
If Not IsNumeric(wParam) Then
Temp = "Error in wParam."
Else
Result = SendMessage(hWnd, EM_LINELENGTH, wParam, &H0)
If Result = -1 Then
Temp = "Error"
Else
Temp = Trim(Str(wParam))
End If
End If
Case Is = EM_LINEFROMCHAR
If Not IsNumeric(wParam) Then
Temp = "Error in wParam."
Else
Result = SendMessage(hWnd, EM_LINEFROMCHAR, wParam, &H0)
If Result = -1 Then
Temp = "Error"
Else
Temp = Trim(Str(wParam))
End If
End If
Case Is = EM_SETMARGINS
Temp = "Not implemented due to technical difficulties."
Case Is = EM_GETMARGINS
Result = SendMessage(hWnd, EM_GETMARGINS, &H0, &H0)
Temp = "Left Margin: " & Trim(Str(LoWord(Result))) & " Right Margin: " & Trim(Str(HiWord(Result)))
Case Is = EM_SETSEL
If Not IsNumeric(wParam) Then
Temp = "Error in wParam."
ElseIf Not IsNumeric(lParam) Then
Temp = "Error in lParam."
Else
Result = SendMessage(hWnd, EM_SETSEL, wParam, lParam)
Temp = Trim(Str(wParam))
End If
Case Is = EM_POSFROMCHAR
Dim PointStruct As POINTAPI
If Not IsNumeric(lParam) Then
Temp = "Error in lParam."
Else
Result = SendMessage(hWnd, EM_POSFROMCHAR, ByVal VarPtr(PointStruct), lParam)
Temp = Trim(Str(PointStruct.X)) & ", " & Trim(Str(PointStruct.Y))
End If
Case Is = EM_SCROLLCARET
SendMessage hWnd, EM_SCROLLCARET, &H0, &H0
Temp = "Done"
Case Is = EM_FMTLINES
If Not IsNumeric(lParam) Then
Temp = "Error in lParam."
Else
Result = SendMessage(hWnd, EM_FMTLINES, wParam, &H0)
Temp = "Done"
End If
Case Is = EM_CHARFROMPOS
If Not IsNumeric(wParam) Then
Temp = "Error in wParam."
ElseIf Not IsNumeric(lParam) Then
Temp = "Error in lParam."
Else
Result = SendMessage(hWnd, EM_CHARFROMPOS, wParam, lParam)
Temp = Trim(Str(Result))
End If
Case Is = EM_SETRECT
On Error Resume Next
If InStr(wParam, ", ") < 1 Then
Temp = "Error in wParam."
ElseIf InStr(wParam, ", ") < 1 Then
Temp = "Error in lParam."
Else
TempRect.Left = Val(Left(wParam, InStr(wParam, ",") - 1))
TempRect.Top = Val(Mid(wParam, InStr(wParam, ",") + 2))
TempRect.Right = Val(Left(lParam, InStr(lParam, ",") - 1))
TempRect.Bottom = Val(Mid(lParam, InStr(lParam, ",") + 2))
Result = SendMessage(hWnd, EM_SETRECT, &H0, TempRect)
Temp = Trim(Str(Result))
End If
Case Is = EM_SETRECTNP
On Error Resume Next
If InStr(wParam, ", ") < 1 Then
Temp = "Error in wParam."
ElseIf InStr(wParam, ", ") < 1 Then
Temp = "Error in lParam."
Else
TempRect.Left = Val(Left(wParam, InStr(wParam, ",") - 1))
TempRect.Top = Val(Mid(wParam, InStr(wParam, ",") - 2))
TempRect.Right = Val(Left(lParam, InStr(lParam, ",") - 1))
TempRect.Bottom = Val(Mid(wParam, InStr(lParam, ",") - 2))
Result = SendMessage(hWnd, EM_SETRECTNP, &H0, TempRect)
Temp = Trim(Str(Result))
End If
Case Is = WM_COMMAND
Result = SendMessage(hWnd, WM_COMMAND, CLng(wParam), CLng(lParam))
Temp = Result
Case Is = WM_GETTEXT
Dim TempString As String
TempString = Space$(1024)
Result = SSendMessage(hWnd, WM_GETTEXT, Len(TempString), TempString)
Temp = FixApi(TempString)
' Ok. Now that I have come to the last one, which is an important one, I am pleased.
' I have only had to cancel 2 or 3 messages due to slight technical problems.
' This one, which has a little problem, will probably defeat me, though.
' But now that I know about sending strings along DLL's, we'll see what happens.
Case Is = WM_SETTEXT
Result = SSendMessage(hWnd, WM_SETTEXT, &H0, lParam)
Temp = Trim(Str(Result))
End Select
Textout.Text = Temp
End Sub
Public Function CombineWord(ByVal LoWord As Integer, ByVal HiWord As Integer) As Long
CopyMemory CombineWord, LoWord, 2
CopyMemory ByVal (VarPtr(CombineWord) + 2), HiWord, 2
End Function