Now, what I'am looking for is to be able to replace any line when I put the curser on that line.
I mean if I put the curser on the third line, and click on the listview item, I get the clicknum back to that line.
Thank you.
Thank you for the illustration. That's exactly my setup.
Now imagine I want to replace Metzger, Philip. W with Thiel James R.
I put the curser where the red arrow and click where the blue arrow.
I wonder if that possible.
thank you
Good UI design does not require a pointing device. The keystroke that means "click" is the space bar, and that probably isn't a good choice in a TextBox for obvious reasons. Fail.
This should be rethought. Otherwise the Accessibility Police may ticket you.
I'm a bit confused about what all the replies are about, but I just worked off of the thread title. It seemed like a fun little challenge, so I threw together a few procedures.
I've got them all in Form1, but they could quite easily be placed into a BAS module for general purpose use.
Again, replacing text in a multi-line text box. That's what the title asks for.
Here's my code (in Form1):
Code:
Option Explicit
'
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
Private Declare Function SendMessageStr 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_LINEINDEX = &HBB&
Private Const EM_LINELENGTH = &HC1&
Private Const EM_LINEFROMCHAR = &HC9&
Private Const EM_REPLACESEL = &HC2&
'
Private Sub Command1_Click()
TxtReplaceLineWithCaret Text1, "aaaaaaaa"
Text1.SetFocus
End Sub
Public Sub TxtReplaceLineWithCaret(txt As TextBox, NewText As String, Optional AssumeCrLfOnLastLine As Boolean = True)
TxtReplaceLine txt, TxtCaretLine(txt), NewText, AssumeCrLfOnLastLine
End Sub
Public Sub TxtReplaceLine(txt As TextBox, TheLine As Long, NewText As String, Optional AssumeCrLfOnLastLine As Boolean = True)
' Does nothing if TheLine is out of range.
'
' The 1& allows undo. Set it to 0& to disable undo.
TxtSelectLine txt, TheLine, AssumeCrLfOnLastLine
SendMessageStr txt.hwnd, EM_REPLACESEL, 1&, NewText
End Sub
Public Sub TxtSelectLine(txt As TextBox, TheLine As Long, Optional AssumeCrLfOnLastLine As Boolean = True)
' Does nothing if TheLine is out of range.
'
With txt
If TheLine < 0& Or TheLine >= TxtLineCount(txt, AssumeCrLfOnLastLine) Then Exit Sub
'
.SelStart = SendMessage(.hwnd, EM_LINEINDEX, TheLine, 0&)
.SelLength = SendMessage(.hwnd, EM_LINELENGTH, txt.SelStart, 0&)
End With
End Sub
Public Sub TxtSetCaratToStartOfLine(txt As TextBox, TheLine As Long, Optional AssumeCrLfOnLastLine As Boolean = True)
' Does nothing if TheLine is out of range.
'
With txt
If TheLine < 0& Or TheLine >= TxtLineCount(txt, AssumeCrLfOnLastLine) Then Exit Sub
'
.SelStart = SendMessage(.hwnd, EM_LINEINDEX, TheLine, 0&)
.SelLength = 0&
End With
End Sub
Public Function TxtLineCount(txt As TextBox, Optional AssumeCrLfOnLastLine As Boolean = True) As Long
TxtLineCount = (SendMessage(txt.hwnd, EM_GETLINECOUNT, 0&, 0&) - Abs(AssumeCrLfOnLastLine))
End Function
Public Function TxtLineText(txt As TextBox, TheLine As Long, Optional AssumeCrLfOnLastLine As Boolean = True) As String
' TheLine is zero based.
' Will return an empty string if TheLine is out of range.
'
With txt
If TheLine < 0& Or TheLine >= TxtLineCount(txt, AssumeCrLfOnLastLine) Then Exit Function
'
TxtLineText = Space$(SendMessage(.hwnd, EM_LINELENGTH, TheLine, 0&))
SendMessageStr .hwnd, EM_GETLINE, TheLine, TxtLineText
End With
End Function
Public Function TxtCaretLine(txt As TextBox) As Long
' Zero based.
' If the textbox has never been selected, it'll return the first line (zero).
' Note that the carat is a bit different from the Sel... stuff. The carat can be anywhere within the selected text.
' The selected text may be multiple lines, but the carat will still be within a specific line.
'
With txt
TxtCaretLine = SendMessage(.hwnd, EM_LINEFROMCHAR, SendMessage(.hwnd, EM_LINEINDEX, -1&, 0&), 0&)
End With
End Function
Here's what Form1 looks like (one Command1 and one multi-line TextBox):
I also zipped and attached it.
Enjoy,
Elroy
Last edited by Elroy; Oct 13th, 2017 at 05:50 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
thank you all of you.
Special thanks to Elroy
the attachement is so interesting.
However it doesn't fit my situation which seems too complicated as I have to replace two lines at once.
Anyway thank you all for the interest and help.
I did some cogitating (as others have as well), and came up with this ...
Issues
1. Basic approach
Save 1st 4 entries to textfile
Allow user to select "to-be-replaced" entry from TextBox .. "red arrow"
Allow user to select "replace-with" .. "blue arrow"
Repopulate TextBox
copy unchanged entries from textfile
insert "to-be-replaced" entry from ListView
2. Detecting the "to-be-replaced entry" at your "red" in the TextBox
I resorted to using the .SelText property
This involves using MouseDown and MouseUp
MouseDown sets samXdn to the x position .. to be sure that it is at start of a line
A drag is then needed to constitute a SelText
MouseUp sets samSel .. the integer value of the selected text .. ie, the "entry" to be replaced
3. Detect the "replacement" chosen from the ListView, perform "insert"
Click the "replacement" in the ListView
Re-create TextBox text as described above.
Here is the code snippet
Code:
Public samXdn
Public samNN As Integer
Public samSel As Integer
Private Sub ListView1_Click()
'
With ListView1
' 1. initial 4 selections
If samSel = Empty Then
ClickNum = ClickNum + 1
Select Case ClickNum
Case 1
Text2.Text = " " _
& "1-" _
& " " _
& .SelectedItem.Text _
& " " _
& .SelectedItem.ListSubItems(1).Text _
& vbNewLine _
& " " _
& .SelectedItem.ListSubItems(2).Text
Case Is >= 2
Text2.Text = Text2.Text _
& vbNewLine _
& vbNewLine _
& " " _
& CInt(ClickNum) & "-" _
& " " _
& .SelectedItem.Text _
& " " _
& .SelectedItem.ListSubItems(1).Text _
& vbNewLine _
& " " _
& .SelectedItem.ListSubItems(2).Text
If ClickNum = 4 Then
fpath = "D:\VBForums\Samer.txt"
' write to text file .. overwrite existing file
Open fpath For Output As #1
Print #1, Text2.Text & vbCrLf
Close #1
End If
End Select
' 2. do replacement
ElseIf samSel > 0 Then
zz = .SelectedItem
txt2 = "" _
& " " _
& CInt(samSel) & "-" _
& " " _
& .SelectedItem.Text _
& " " _
& .SelectedItem.ListSubItems(1).Text _
& vbNewLine _
& " " _
& .SelectedItem.ListSubItems(2).Text
fpath1 = "D:\VBForums\Samer.txt"
Open fpath1 For Input As #1
' 4 entries
Text2.Text = Empty
For ii = 1 To 4
' 3 lines per entry
For jj = 1 To 3
Line Input #1, xtr
' copy from textfile
If ii <> samSel Then
Text2.Text = Text2.Text & xtr & vbCrLf
' insert -- 1-time
ElseIf ii = samSel Then
If jj = 1 Then
Text2.Text = Text2.Text & txt2 & vbCrLf & vbCrLf
End If
End If
Next jj
Next ii
Close #1
End If
End With
'
End Sub
Private Sub Text2_MouseDown(button As Integer, shift As Integer, x As Single, y As Single)
'
samXdn = x
'
End Sub
Private Sub Text2_MouseUp(button As Integer, shift As Integer, x As Single, y As Single)
'
With Text2
txt = .SelText
If samXdn < 150 Then
samSel = CInt(Left(LTrim(txt), 1))
End If
End With
'
End Sub
Here is the "to-be-replaced" step image .. the "red arrow"
It can't just be a mouse click on the desired line
It needs to be a "select text"
Here is the "replace with" .. "blue arrow" .. and revised TextBox image
Granted, this is a little complex.
Other approaches may be worthy of consideration.
Well, Samer, I suppose I'm still not clear on what you're trying to do, but here's a modified attempt. I'm following your lead as you posted it in post #5.
I'll let you work out the "blue arrow" code, as I don't see that as difficult. However, my modified attempt is more about the "red arrow".
Code:
Option Explicit
'
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
Private Declare Function SendMessageStr 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_LINEINDEX = &HBB&
Private Const EM_LINELENGTH = &HC1&
Private Const EM_LINEFROMCHAR = &HC9&
Private Const EM_REPLACESEL = &HC2&
'
Private Sub Command1_Click()
TxtReplaceLineWithCaretAndNext Text1, "Joe Smith", " some extra stuff related to Joe Smith"
Text1.SetFocus
End Sub
Public Sub TxtReplaceLineWithCaretAndNext(txt As TextBox, NewLine1 As String, NewLine2 As String, Optional AssumeCrLfOnLastLine As Boolean = True)
' If TxtCaretLine isn't even (zero based), it's decremented because it must then be on the second (information) line.
' Also, there must be one more line after TxtCaretLine, or nothing is done, because we've got no "information" line.
'
Dim TheLine As Long
'
TheLine = TxtCaretLine(txt)
If TheLine Mod 2 <> 0 Then TheLine = TheLine - 1 ' Make sure caret is on even line number.
If TheLine >= TxtLineCount(txt, AssumeCrLfOnLastLine) - 1 Then Exit Sub ' Make sure we've got one line beyond caret.
'
TxtReplaceLine txt, TheLine, NewLine1, AssumeCrLfOnLastLine
TheLine = TheLine + 1
TxtReplaceLine txt, TheLine, NewLine2, AssumeCrLfOnLastLine
End Sub
Public Sub TxtReplaceLineWithCaret(txt As TextBox, NewText As String, Optional AssumeCrLfOnLastLine As Boolean = True)
TxtReplaceLine txt, TxtCaretLine(txt), NewText, AssumeCrLfOnLastLine
End Sub
Public Sub TxtReplaceLine(txt As TextBox, TheLine As Long, NewText As String, Optional AssumeCrLfOnLastLine As Boolean = True)
' Does nothing if TheLine is out of range.
'
' The 1& allows undo. Set it to 0& to disable undo.
TxtSelectLine txt, TheLine, AssumeCrLfOnLastLine
SendMessageStr txt.hwnd, EM_REPLACESEL, 1&, NewText
End Sub
Public Sub TxtSelectLine(txt As TextBox, TheLine As Long, Optional AssumeCrLfOnLastLine As Boolean = True)
' Does nothing if TheLine is out of range.
'
With txt
If TheLine < 0& Or TheLine >= TxtLineCount(txt, AssumeCrLfOnLastLine) Then Exit Sub
'
.SelStart = SendMessage(.hwnd, EM_LINEINDEX, TheLine, 0&)
.SelLength = SendMessage(.hwnd, EM_LINELENGTH, txt.SelStart, 0&)
End With
End Sub
Public Sub TxtSetCaratToStartOfLine(txt As TextBox, TheLine As Long, Optional AssumeCrLfOnLastLine As Boolean = True)
' Does nothing if TheLine is out of range.
'
With txt
If TheLine < 0& Or TheLine >= TxtLineCount(txt, AssumeCrLfOnLastLine) Then Exit Sub
'
.SelStart = SendMessage(.hwnd, EM_LINEINDEX, TheLine, 0&)
.SelLength = 0&
End With
End Sub
Public Function TxtLineCount(txt As TextBox, Optional AssumeCrLfOnLastLine As Boolean = True) As Long
TxtLineCount = (SendMessage(txt.hwnd, EM_GETLINECOUNT, 0&, 0&) - Abs(AssumeCrLfOnLastLine))
End Function
Public Function TxtLineText(txt As TextBox, TheLine As Long, Optional AssumeCrLfOnLastLine As Boolean = True) As String
' TheLine is zero based.
' Will return an empty string if TheLine is out of range.
'
With txt
If TheLine < 0& Or TheLine >= TxtLineCount(txt, AssumeCrLfOnLastLine) Then Exit Function
'
TxtLineText = Space$(SendMessage(.hwnd, EM_LINELENGTH, TheLine, 0&))
SendMessageStr .hwnd, EM_GETLINE, TheLine, TxtLineText
End With
End Function
Public Function TxtCaretLine(txt As TextBox) As Long
' Zero based.
' If the textbox has never been selected, it'll return the first line (zero).
' Note that the carat is a bit different from the Sel... stuff. The carat can be anywhere within the selected text.
' The selected text may be multiple lines, but the carat will still be within a specific line.
'
With txt
TxtCaretLine = SendMessage(.hwnd, EM_LINEFROMCHAR, SendMessage(.hwnd, EM_LINEINDEX, -1&, 0&), 0&)
End With
End Function
Specifically, that TxtReplaceLineWithCaretAndNext function allows you to replace two lines in the multi-line TextBox. As per what you've shown, it insists that the caret be on an even line (or it gets decremented by one), and that there be one additional line to follow.
When you click your ListView (i.e., your blue-arrow), you can snag the information you want out of it and make the call to TxtReplaceLineWithCaretAndNext. That seems to be what you want.
Enjoy,
Elroy
p.s. You could just download the project I attached to post #9, and then use the above code to replace the code in Form1, if you wanted to play around with it.
p.p.s. Also, you need to learn about the HitTest when dealing with a ListView. There are quite a few posts around here that talk about it. But that's the way I'd go about getting a line that was clicked (or possibly double-clicked) in a ListView. I'm a bit rushed at the moment, but, if you ask, I'll post something later on.
Last edited by Elroy; Oct 14th, 2017 at 01:37 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Thank you men for your time and help.
Spooman
Your approach is genius. I could replace items as I was hoping.
However I could not add more than one item to the textbox.
You'll have noticed that I modified your original code .. Case 1 to Case 4
I simplified it to Case 1 and Case Is >= 2
Update
regarding Sub Text2_MouseUp()
I added a branch .. there are now 2
"good" selection
"bad" selection
Code:
Private Sub Text2_MouseUp(button As Integer, shift As Integer, x As Single, y As Single)
'
With Text2
txt = .SelText
' 1. "good" selection .. began before 1st character
If samXdn < 150 Then
samSel = CInt(Left(LTrim(txt), 1))
' 2. "bad" selection .. began beyond far left .. turn off "hilite"
Else
.SelLength = 0
End If
End With
'
End Sub
In branch "2", setting SelLength = 0 turns off the "blue" hilite
This is done to "alert" you that an improper select was performed.
But I'm having trouble with formatting items in the textbox after the replacement.
Secondly, when checking the item on the listview, it replaces the targeted item but it is exported to the textbox too and added as a last item.
I attached a sample.
Try clicking on listview to export items to texbox.
You can only export data in the selected row once. Then it will just replace the data in the texbox.
No problem. It was fun to play around a bit with some of the API calls that could be used with a TextBox. If Spoo's code got you going, that's great.
Take Care,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Here's my take on it. TD is a tom.ITextDocument interface of an RTB placed into text mode. Here are the relevant snippets:
Code:
Private Sub LVW_Click()
With RTB
If .SelLength > 0 And LVW.SelectedItem.Selected Then
.SelText = FormatItemForLine(LVW.SelectedItem, RTBItemNumber)
LVW.SelectedItem.Selected = False
End If
End With
End Sub
Private Sub RTB_Click()
Dim Line As Long
Dim ExpandStart As Long
Dim ExpandEnd As Long
With TD.Selection
.Collapse tomTrue
.Expand tomLine
Line = .GetIndex(tomLine) - 1
ExpandStart = Line Mod 4
If ExpandStart > 0 Then .MoveStart tomLine, -ExpandStart
ExpandEnd = 3 - Line Mod 4
If ExpandEnd > 0 Then .MoveEnd tomLine, ExpandEnd
End With
RTBItemNumber = Line \ 4 + 1
End Sub
Text item 5 clicked
List item 8 clicked
Notice that the "text item" entries are 4 lines each. You could eliminate one of the paired newlines and adjust the constants within RTB_Click.
Sorry about that.
I finally got your zip loaded and noticed these differences ..
1. How you loaded the ListView
Code:
Private Sub Form_Load()
Dim li As ListItem
With ListView1
Set li = .ListItems.Add(, , "Item1")
li.SubItems(1) = "Item2"
li.SubItems(2) = "Item3"
Set li = .ListItems.Add(, , "Item4")
li.SubItems(1) = "Item5"
li.SubItems(2) = "Item6"
Set li = .ListItems.Add(, , "Item7")
li.SubItems(1) = "Item8"
li.SubItems(2) = "Item9"
End With
End Sub
2. Here are 2 screenshots
First, when click "2nd" item
Then, when click "3rd" item
Only the "3rd" appears, it is not added to the "2nd"
dilettante
Fascinating work !
Unfortunatelyit doesnot fitmy case.
In my situation, I need to add data to textbox dynamicallyfrom the listview.
Second, i need a textbox nota richtextbox.
Thanks a lot
Spooman
I'm sorry from my disturbance to you.
Yes, the initial problem was solved by defining ClickNum but now I can't replace items in the textbox.
Thank you sir
Unfortunatelyit doesnot fitmy case.
In my situation, I need to add data to textbox dynamicallyfrom the listview.
Second, i need a textbox nota richtextbox.
Well in post #1 you ask for data to be replaced, not added. But if you click at the very end of the RTB new data does get inserted.
I'm not sure why the more powerful RichTextBox can't be used instead of the far simpler TextBox. However if this is really a requirement you can probably simulate the same thing through a brute-force approach scanning through the text contents yourself. Since it is a human-driven process performance should not be an issue.
It seems like you have plenty of sample code and different techniques now to get whatever it is you need to do.
.... but now I can't replace items in the textbox.
I think I have to abandon the idea.
I hope not quite yet ..
I see 3 possible "hard-wired" situations that merit attention
1. Textfile
As I mentioned earlier, this approach relies on a Textfile to enable
the "insert/replace" feature.
I've added a few scrub lines of code to deal with that file
Code:
Private Sub Form_Load()
Dim li As ListItem
With ListView1
...
End With
' scrub
fpath = "D:\VBForums\Samer.txt"
Open fpath For Output As #1
Print #1, ""
Close #1
'
End Sub
At a minimum, you should
modify the filepath to meet your situation
make similar modifications at the several other locations this filepath occurs
2. When to write to Textfile
Your OP had 4 Case branches, and I inappropriately focused on that amount.
As currently coded, you can only begin modifying textbox items if there are 4 of them
This may be the cause of your current issue.
So, replace this
Code:
Private Sub ListView1_Click()
'
With ListView1
' 1. initial 4 selections
If samSel = Empty Then
ClickNum = ClickNum + 1
Select Case ClickNum
Case 1
...
Case Is >= 2
Text2.Text = Text2.Text _
& vbNewLine _
& vbNewLine _
& " " _
& CInt(ClickNum) & "-" _
& " " _
& .SelectedItem.Text _
& " " _
& .SelectedItem.ListSubItems(1).Text _
& vbNewLine _
& " " _
& .SelectedItem.ListSubItems(2).Text
If ClickNum = 4 Then
fpath = "D:\VBForums\Samer.txt"
' write to text file .. overwrite existing file
Open fpath For Output As #1
Print #1, Text2.Text & vbCrLf
Close #1
End If
.. with this
Code:
Private Sub ListView1_Click()
'
With ListView1
' 1. initial 4 selections
If samSel = Empty Then
ClickNum = ClickNum + 1
Select Case ClickNum
Case 1
...
Case Is >= 2
Text2.Text = Text2.Text _
& vbNewLine _
& vbNewLine _
& " " _
& CInt(ClickNum) & "-" _
& " " _
& .SelectedItem.Text _
& " " _
& .SelectedItem.ListSubItems(1).Text _
& vbNewLine _
& " " _
& .SelectedItem.ListSubItems(2).Text
If ClickNum > 1 Then
fpath = "D:\VBForums\Samer.txt"
' write to text file .. overwrite existing file
Open fpath For Output As #1
Print #1, Text2.Text & vbCrLf
Close #1
End If
3. Inserting
Similarly, in the "2. do replacement" section, I assumed there would be 4 textbox lines
Code:
Private Sub ListView1_Click()
'
With ListView1
' 1. initial 4 selections
If samSel = Empty Then
...
' 2. do replacement
ElseIf samSel > 0 Then
zz = .SelectedItem
txt2 = "" _
& " " _
& CInt(samSel) & "-" _
& " " _
& .SelectedItem.Text _
& " " _
& .SelectedItem.ListSubItems(1).Text _
& vbNewLine _
& " " _
& .SelectedItem.ListSubItems(2).Text
fpath1 = "D:\VBForums\Samer.txt"
Open fpath1 For Input As #1
' 4 entries
Text2.Text = Empty
For ii = 1 To 4If EOF(1) Then
Exit For
End If
' 3 lines per entry
...
You probably will want to
modify For ii = 1 To 4 to For ii = 1 To xx, where xx is up to you
add the If EOF(1) Then branch
Other tweaks may be needed, but for sure, the above 3.
Let me know how you progress.