首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

求VB对textbox的行操作,增行/删行/修改行的操作参考代码.解决办法

2012-01-12 
求VB对textbox的行操作,增行/删行/修改行的操作参考代码.我想用VB做一个简单的文本操作程序.但是遇到以下

求VB对textbox的行操作,增行/删行/修改行的操作参考代码.
我想用VB做一个简单的文本操作程序.
但是遇到以下关于TextBox的问题搞不定,向高手请教!

***1,怎么通过代码修改或删除TextBox中指定的行N,或者增加一行?

***2,我用API得到第N行的字符串,有时候在字符串后面有一个特殊符号 "£ ",请问是怎么回事?
(我的代码是:   SendMessage   text1.hwnd,   EM_GETLINE,   N,   ByVal   s     )


[解决办法]
添加TEXTBOX,命名为TxtTest,添加2个label命名为lblLine,lblCol,然后测试以下代码
窗体
Option Explicit
Dim LineNo As Long, ColNo As Long, TmpStr As String

Private Sub Form_Load()
TxtTest.Text = "00000000 " & vbCrLf & "111111111 " & vbCrLf & "2222222222222 "
End Sub

Private Sub txttest_KeyUp(KeyCode As Integer, Shift As Integer)
Call GetCaretPos(TxtTest.hwnd, LineNo, ColNo)
lblLine.Caption = LineNo
lblCol.Caption = ColNo
Call TB_GetLine(TxtTest.hwnd, lblLine.Caption-1, TmpStr)
Me.Caption = TmpStr
End Sub

Private Sub txttest_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Call GetCaretPos(TxtTest.hwnd, LineNo, ColNo)
lblLine.Caption = LineNo
lblCol.Caption = ColNo
Call TB_GetLine(TxtTest.hwnd, lblLine.Caption-1, TmpStr)
Me.Caption = TmpStr
End Sub
模块
Option Explicit

Const EM_GETSEL = &HB0
Const EM_LINEFROMCHAR = &HC9
Const EM_LINEINDEX = &HBB
Public Const EM_GETLINE = &HC4
Public Const EM_LINELENGTH = &HC1


Private Declare Sub RtlMoveMemory Lib "KERNEL32 " (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

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

Public Sub GetCaretPos(ByVal hwnd5 As Long, LineNo As Long, ColNo As Long)
Dim i As Long, j As Long
Dim lParam As Long, wParam As Long
Dim k As Long
i = SendMessage(hwnd5, EM_GETSEL, wParam, lParam)
j = i / 2 ^ 16 '取得目前光标所在位置前有多少个Byte
LineNo = SendMessage(hwnd5, EM_LINEFROMCHAR, j, 0) '取得光标前面有多少行
LineNo = LineNo + 1
k = SendMessage(hwnd5, EM_LINEINDEX, -1, 0)
'取得目前光标所在行前面有多少个Byte
ColNo = j - k + 1
End Sub

Sub TB_GetLine(ByVal hwnd As Long, ByVal whichLine As Long, Line As String)

Dim length As Long, bArr() As Byte, bArr2() As Byte, lc As Long

lc = SendMessage(hwnd, EM_LINEINDEX, whichLine, ByVal 0&)

length = SendMessage(hwnd, EM_LINELENGTH, lc, ByVal 0&)

If length > 0 Then
ReDim bArr(length + 1) As Byte, bArr2(length - 1) As Byte
Call RtlMoveMemory(bArr(0), length, 2) '准备一个存储器,传递消息之前先在存储器的前两个字节填入存储器的长度
Call SendMessage(hwnd, EM_GETLINE, whichLine, bArr(0))
Call RtlMoveMemory(bArr2(0), bArr(0), length)
Line = StrConv(bArr2, vbUnicode)
Else
Line = " "
End If

End Sub
[解决办法]
能不用API就不会API,用数组方式最好
dim str as string
dim A() as string
A=split(str,vbcrlf)
你现在就是在对数组操作了,就很简单
[解决办法]
如果是基于Textbox操作的话,还是用api比较好,如果是基于文本文件的话,可以用数组


需要你注意的是,文本文件中的一行在textbox显示的不一定是一行(也就是说,textbox中每行结束的时候并不一定都有硬回车)
[解决办法]
//我以前用数组,把文本文件的内容保存到数组,好像效果不好

可以参考这个:
VB中对string array快速插入、删除某个元素的办法
http://www.cnblogs.com/rainstormmaster/archive/2006/01/09/313880.html
------解决方案--------------------


Textbox返回第N行的中文文字,在中文XP(Chinese (PRC) as non_Unicode Setting)下可以,但在英文XP(English as non-Unicode Setting)下中文返回问号。迄今为止,还没有发现好的Solution.

测试环境:XP,SP2,English,English as non-Unicode Setting;
SDK API-drawn Unicode Textbox (不是VB自带的ANSI Textbox),VB6,SP6

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 Sub CopyMemory Lib "KERNEL32 " Alias "RtlMoveMemory " (Destination As Any, Source As Any, ByVal Length As Long)
Private Const EM_GETLINE = &HC4
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1

Public Function GetLineText(ByVal handle As Long, ByVal Index As Long) As String

Dim LineText() As Byte
Dim size As Long
Dim pos As Long

pos = SendMessage(handle, EM_LINEINDEX, Index, 0)
size = SendMessage(handle, EM_LINELENGTH, pos, 0)
If size = 0 Then
GetLineText = " "
Else
ReDim LineText((size - 1) + 1)
CopyMemory LineText(0), size, 2
size = SendMessage(handle, EM_GETLINE, Index, LineText(0))
GetLineText = StrConv(LeftB(LineText, size), vbUnicode)
End If

End Function
[解决办法]
LineIndex从0开始
Private Sub DelLine(txtEditor As TextBoxEx, ByVal 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
Dim LineCount As Long

LineCount = SendMessage(txtEditor.hWnd,EM_GETLINECOUNT, 0&, 0&)

If LineIndex > = LineCount Then
Exit Sub
End If
lngSelStart = txtEditor.SelStart

If LineIndex < LineCount Then
lngCharPos = SendMessage(txtEditor.hWnd,EM_LINEINDEX, LineIndex, 0&)
End If

lngLineLen = SendMessage(txtEditor.hWnd, EM_LINELENGTH, lngCharPos, 0&)

txtEditor.Text = Left$(txtEditor.Text, lngCharPos) & Mid$(txtEditor.Text, lngCharPos + lngLineLen + 1)

txtEditor.SelStart = lngSelStart

End Sub

热点排行