03. oktober 2001 - 21:45
#1
Lidt hjælp som du kan bygge vider på. :-)
\'----Set disse på en Form----
\'Text1.MultiLine = True
\'Text2
\'Label1
\'----------------------------
\'------------------------------ Form1 ------------------------------
Private Declare Function SendMessageLong Lib \"USER32\" Alias \"SendMessageA\" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function SendMessageByRef Lib \"USER32\" Alias \"SendMessageA\" (ByVal hWnd As Long, ByVal wMsg As Long, wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageByLong Lib \"USER32\" Alias \"SendMessageA\" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Public Sub LinePos(txt As TextBox, LineNum, LineSel, LineEnd)
Dim lLine As Long, lSel As Long
Dim sSel As Long, lTotal As Long, I As Long
lTotal = txt.SelStart + 1
lLine = 1 + SendMessageLong(txt.hWnd, EM_LINEFROMCHAR, txt.SelStart, 0&)
sSel = SendMessageLong(txt.hWnd, EM_LINELENGTH, lTotal - 1, 0&)
I = SendMessageLong(txt.hWnd, EM_LINEINDEX, lLine - 1, 0&)
lEnd = SendMessageLong(txt.hWnd, EM_LINELENGTH, -1, 0&)
lSel = lTotal - I - 1
LineNum = lLine: LineSel = lSel: LineEnd = lEnd
End Sub
Private Sub Text1_Click()
Dim LineNum As Long, LineSel As Long, LineEnd As Long, SBack As Long
Call LinePos(Text1, LineNum, LineSel, LineEnd)
Label1.Caption = \"LineNum: \" & LineNum & \" LineSel: \" & LineSel & \" LineEnd: \" & LineEnd
SBack = Text1.SelStart
Text1.SelStart = Text1.SelStart - LineSel
Text1.SelLength = LineEnd
Text2 = Text1.SelText
Text1.SelStart = SBack
End Sub
\'------------------------------ Form1 ------------------------------
hy
Nybegynder
03. oktober 2001 - 21:48
#2
Du kan hente teksten med Text1.text dele teksten ved vbCrLf ændre den sidste del og derefter sætte den tilbage
F.eks. noget ala :
strText = Text1.Text
arrText = Split(strText,vbCrLf)
arrText(1) = \"Noget andet\"
strText = Join(arrText)
Text1.Text = strText
hyde
21. oktober 2001 - 01:35
#4
\'---------------------- Form1 ------------------------
Dim arrLine \'øverst i form1
Private Sub Command1_Click() \'Test Command1
Dim i As Integer
For i = 1 To UBound(arrLine)
List1.AddItem arrLine(i) \'Test List1
Next i
End Sub
Private Sub Command2_Click() \'Test Command2
Text1.Text = arrLine(2)
End Sub
Private Sub Form_Load()
\'Text1.MultiLine = True
Text1.Text = \"Linje 1\" & vbNewLine & \"Linje 2\" & vbNewLine & \"Linje 3\"
arrLine = LineText(Text1.Text)
End Sub
\'---------------------- Form1 ------------------------
\'------------------- Form1/Module1 -------------------
Public Function LineText(txt As String) As Variant
Dim i, aPos, bPos, cont As Long
Dim tRetArray() As Variant
Dim RetArray() As Variant
ReDim tRetArray(10000) \'max linjer
TextLine = Empty
If Right(txt, 2) <> Chr(13) & Chr(10) Then txt = txt & Chr(13)
aPos = 1
For i = 1 To Len(txt)
If Mid(txt, i, 1) = Chr(13) Then
bPos = i - 2
cont = cont + 1
tRetArray(cont) = Mid(txt, aPos, (bPos - aPos) + 2)
aPos = bPos + 4
End If
Next i
ReDim RetArray(cont)
For i = 1 To cont
RetArray(i) = tRetArray(i)
Next i
LineText = RetArray
End Function
\'------------------- Form1/Module1 -------------------