Article ID: 186271
Article Last Modified on 7/1/2004
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As String) As Long
Control Default Name Property Setting --------------------------------------------------------------- Text Box Text1 MultiLine True Label Label1 AutoSize True
Option Explicit
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As String) _
As Long
Private Const EM_GETLINE = &HC4
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_REPLACESEL = &HC2
Private Sub Form_Load()
With Command1
.Caption = "Insert This Text"
.Height = 375
.Left = 120
.Top = 3000
.Width = 1455
End With
With Form1
.Caption = "Enhanced Text Box Sample Project"
.Height = 4485
.Width = 6990
End With
With Label1
.Height = 195
.Left = 120
.Top = 240
.Width = 3015
.WordWrap = True
End With
With Label2
.Height = 255
.Left = 1800
.Top = 3360
.Width = 3135
End With
With Text1
.Height = 2655
.Left = 3360
.Top = 240
.Width = 3375
End With
With Text2
.Height = 285
.Left = 1680
.Top = 3000
.Width = 5055
End With
End Sub
Private Sub Command1_Click()
Call SendMessage(Text1.hwnd, EM_REPLACESEL, 0, Text2.Text)
Label2.Caption = "Copied text is " + Text2.Text
ShowInfo
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
ShowInfo
End Sub
Private Sub Text1_MouseMove(Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)
ShowInfo
End Sub
Private Function ShowInfo()
'********************************************************************
' Purpose: Runs all the functions to get the necessary information
' in order to create the information text string. The text
' string is then displayed in the label control.
'********************************************************************
Dim strInfo As String
Dim lCurPos As Long
Dim lCurLineNum As Long, lTotLines As Long, lLineLength
Dim lNumBChar As Long
Dim sCurLine As String * 25
'Determine Cursor Position
If Text1.SelLength = 0 Then
lCurPos = Text1.SelStart
Else
lCurPos = Text1.SelStart + Text1.SelLength
End If
'Determine Line Number
lCurLineNum = SendMessage(Text1.hwnd, EM_LINEFROMCHAR, lCurPos, 0)
'Determine the Line Length
lLineLength = SendMessage(Text1.hwnd, EM_LINELENGTH, lCurPos, 0)
'Determine the number of characters in lines before current
'cursor position. Note that the number of characters includes a
'carriage return and line feed characters at the end of each
'line.
lNumBChar = SendMessage(Text1.hwnd, EM_LINEINDEX, lCurLineNum, 0)
'Determine Total number of lines
lTotLines = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0, 0)
'Determine Current Line
sCurLine = Space(25)
Call SendMessage(Text1.hwnd, EM_GETLINE, lCurLineNum, sCurLine)
'Display the information
strInfo = "Current Line: " + sCurLine + vbLf + _
"Line Length: " + CStr(lLineLength) + _
" Characters" + vbLf + _
"Line Number: " + CStr(lCurLineNum + 1) + _
" of " + CStr(lTotLines) + " Total Lines" + vbLf + _
"Cursor Position: " + CStr(lCurPos) + vbLf + _
"Total Characters in Previous Lines: " + _
CStr(lNumBChar) + vbLf + _
"Selected Length: " + CStr(Text1.SelLength) + vbLf + _
"Selected Text: " + Text1.SelText
Label1.Caption = strInfo
End Function
Additional query words: kbDSupport kbDSD kbSDKWin32 kbAPI kbVBp500 kbVBp600 kbVBp
Keywords: kbhowto KB186271