如何读取文本框1指定行的字符?

Question

例如文本框1数据如下: 第1系列 (2组): 11,22,11, 
(3组): 85,33,44, 
(4组): 26,04,66, 
(5组): 99,36,50, 第2系列 (1组): 01,02,03, 
(2组): 11,22,33, 
(3组): 22,33,44, 
(4组): 26,02,66, 
(5组): 99,02,03, 第3系列 
.
.
.(省略)现在要读取文本框1里面每个系列的第4组数据(只要数字和逗号), 
并且输出到文本框2怎么办? 
文本框2格式: 
26,04,66,26,02,66, 帮写写代码谢谢.

Answer 1

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 LongPrivate Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_GETLINE = &HC4Private Function GetLine(ByVal hWnd As Long, ByVal LineID As Long) As String
    Dim LnIndex&, LnLen&
    Dim bArr() As Byte, bArr2() As Byte    LnIndex = SendMessage(hWnd, EM_LINEINDEX, LineID, ByVal 0&)
    LnLen = SendMessage(hWnd, EM_LINELENGTH, LnIndex, ByVal 0&)
    
    If LnLen > 0 Then
        ReDim bArr(LnLen + 1), bArr2(LnLen - 1)
        Call RtlMoveMemory(bArr(0), LnLen, 2)
        Call SendMessage(hWnd, EM_GETLINE, LineID, bArr(0))
        Call RtlMoveMemory(bArr2(0), bArr(0), LnLen)
        GetLine = StrConv(bArr2, vbUnicode)
    Else
        GetLine = ""
    End If
End FunctionGetLine(Text1.hWnd, 3)

Answer 2

每个系列相当于一个大组,每个大组下面又有若干数据组,现在就是提取每个系列(大组)下面的
(4组):的数据.
truewill(无处不在)的代码只能够提取第一系列的(4组):的数据.谢谢关注了.
效果图如下:http://hiphotos.baidu.com/%CC%EC%B7%E7%BA%A3%CB%AE/pic/item/7688ab01f000b002738da5f9.jpg

Answer 3

Dim i, a, tmp, p, s
tmp = "4组": i = 1: Text2 = ""
Do
    p = InStr(i, Text1, tmp)
    If p = 0 Then Exit Do
    i = p + 2: Text2 = Text2 & Mid(Text1, InStr(p + 2, Text1, ")") + 2, InStr(p + 2, Text1, vbCrLf) - p - 2)
Loop
结果:
 26,04,66, 
 26,02,66,

Answer 4

Option ExplicitPrivate Sub Command1_Click()  
    Text2 = getDataByID(4)  '调用
End Sub
    
Function getDataByID$(n&)
    Dim s1, s2
    s2 = n & "组): "    For Each s1 In Split(Text1, "(")
        s1 = Split(s1, s2)
        If UBound(s1) > 0 Then getDataByID = getDataByID & s1(1)
    Next
End Function

Answer 5

你的界面不错
难道是在vista下开发的?

Answer 6

我的代码在环境里测试过了 肯定没问题^_^
另外 发现代码还能继续简化:)Function getDataByID$(n&)
    Dim s1, s2
    s2 = n & "组): "    On Error Resume Next
    For Each s1 In Split(Text1, "(")
        getDataByID = getDataByID & Split(s1, s2)(1)
    Next
End Function