Io avevo fatto in questo modo provo a postarlo magari può esserti utile.
In un modulo di classe chiamato "CTextBoxEx"
codice:
Option Explicit
'API function declarations
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'Window messages sent to the textbox
Private Const EM_CANUNDO = &HC6
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Private Const EM_GETLINE = &HC4
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETMODIFY = &HB8
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_SETMODIFY = &HB9
Private Const EM_UNDO = &HC7
'local variables to hold property values
Private WithEvents mtxtBox As RichTextBox
Private mhWnd As Long 'the hWnd of the textbox
Public Function LineLen(CharPos As Long)
'Returns the number of character of the line that
'contains the character position specified by CharPos
LineLen = SendMessage(mhWnd, EM_LINELENGTH, CharPos, 0&)
End Function
Public Function GetLineFromChar(CharPos As Long) As Long
'Returns the zero based line number of the line
'that contains the specified character index
GetLineFromChar = SendMessage(mhWnd, EM_LINEFROMCHAR, CharPos, 0&)
End Function
Public Function LineCount() As Long
'Returns the number of lines in the textbox
LineCount = SendMessage(mhWnd, EM_GETLINECOUNT, 0&, 0&)
End Function
Public Function TopLine() As Long
'Returns the zero based line index of the first
'visible line in a multiline textbox.
'Or the position of the first visible character
'in a none multiline textbox
TopLine = SendMessage(mhWnd, EM_GETFIRSTVISIBLELINE, 0&, 0&)
End Function
Public Function CanUndo() As Boolean
'Returns True if it's possible to make an Undo
Dim lngRetVal As Long
lngRetVal = SendMessage(mhWnd, EM_CANUNDO, 0&, 0&)
CanUndo = (lngRetVal <> 0)
End Function
Public Function GetCharFromLine(LineIndex As Long)
'Returns the index of the first character of the line
'check if LineIndex is valid
If LineIndex < LineCount Then
GetCharFromLine = SendMessage(mhWnd, EM_LINEINDEX, LineIndex, 0&)
End If
End Function
Public Function GetLine(LineIndex As Long) As String
'Returns the text contained at the specified line
Dim bArray() As Byte 'byte array to contain the returned string
Dim lngLineLen As Long 'the length of the line
Dim sRetVal As String 'the return value
'Check the LineIndex value
If LineIndex >= LineCount Then
GetLine = ""
Exit Function
End If
'get the length of the line
lngLineLen = LineLen(GetCharFromLine(LineIndex))
If lngLineLen < 1 Then
GetLine = ""
Exit Function
End If
ReDim bArray(lngLineLen + 1)
'The first word of the array must contain
'the length of the line to return
bArray(0) = lngLineLen And 255
bArray(1) = lngLineLen \ 256
SendMessage mhWnd, EM_GETLINE, LineIndex, bArray(0)
'convert the byte array into a string
sRetVal = Left(StrConv(bArray, vbUnicode), lngLineLen)
'return the string
GetLine = sRetVal
End Function
Public Sub Undo()
'Undo the last edit
SendMessage mhWnd, EM_UNDO, 0&, 0&
End Sub
Public Sub DelLine(LineIndex As Long)
'Deletes the specified line from the textbox
Dim lngSelStart As Long 'used to save the caret position
Dim lngLineLen As Long 'the length of the line to delete
Dim lngCharPos As Long 'the index of the first character on the line
If LineIndex >= LineCount Then
Exit Sub
End If
lngSelStart = mtxtBox.SelStart
lngCharPos = GetCharFromLine(LineIndex)
lngLineLen = LineLen(lngCharPos)
mtxtBox = Left$(mtxtBox, lngCharPos) & Mid$(mtxtBox, lngCharPos + lngLineLen + 1)
mtxtBox.SelStart = lngSelStart
End Sub
Public Property Let IsDirty(ByVal blnDirty As Boolean)
Dim lngDirty As Long
lngDirty = Abs(blnDirty) '1 = True in API functions not -1 as in VB
SendMessage mhWnd, EM_SETMODIFY, lngDirty, 0&
End Property
Public Property Get IsDirty() As Boolean
IsDirty = (SendMessage(mhWnd, EM_GETMODIFY, 0&, 0&) <> 0)
End Property
Public Property Set RichTextBox(txtNewBox As RichTextBox)
Set mtxtBox = txtNewBox
mhWnd = txtNewBox.hwnd
End Property
Public Property Get RichTextBox() As RichTextBox
Set RichTextBox = mtxtBox
End Property
Private Sub mtxtBox_KeyDown(KeyCode As Integer, Shift As Integer)
Dim lngLineIndex As Long
If Shift = vbCtrlMask Then
Select Case KeyCode
Case vbKeyA 'CTRL+A = Select all
With mtxtBox
.SelStart = 0
.SelLength = Len(.Text)
End With
Case vbKeyY 'CTRL+Y = Cut current line and put it on the clipboard
lngLineIndex = GetLineFromChar(mtxtBox.SelStart)
Clipboard.SetText GetLine(lngLineIndex)
DelLine GetLineFromChar(lngLineIndex)
End Select
End If
End Sub
In Form_Load
codice:
Set txtBox = New CTextBoxEx
Set txtBox.RichTextBox = tua_RichTextBox
Procedura
codice:
Private Sub Command_Click()
Label1.Caption = txtBox.GetLine(txtBox.GetLineFromChar(textindirizzo.SelStart))
Label2.Caption = txtBox.GetLine(txtBox.GetLineFromChar(textindirizzo.SelStart) + 1)
Label3.Caption = txtBox.GetLine(txtBox.GetLineFromChar(textindirizzo.SelStart) + 2)
Label4.Caption = txtBox.GetLine(txtBox.GetLineFromChar(textindirizzo.SelStart) + 3)
Sembra più macchinoso ma è più gestibile
Ciao 
Permessi di invio
Rispondi quotando