frmregister.frm

一个读取支持modbus协议的设备的数据工具

Private Sub IpText_GotFocus()
    DopSitY = 0
    IpText_DblClick
End Sub

Private Sub IpText_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 46 Then
        If Mid(IpText.Text, IpText.SelStart + 1, 1) = "." Then
            KeyCode = 0
        End If
    End If
End Sub

Private Sub IpText_KeyPress(KeyAscii As Integer)
Dim ChStr  As String
Dim Lastr As String
Dim L As Integer
Dim Dc As Integer
Dim i As Integer
Dim Tstr As String
Dim SStr As String
Dim CurSitIndex As Integer  '''当前光标所在位置
Dim CurSelL As Integer
Dim DopSit(3) As Integer

    ChStr = Chr(KeyAscii)
    Lastr = IpText.Text
    CurSitIndex = IpText.SelStart
    CurSelL = IpText.SelLength
    If KeyAscii <> 8 Then
        If (ChStr < "0" Or ChStr > "9") Then    '''非数字
            If ChStr = "." Then                      '''输入小数点
                If CurSelL > 0 Then '= 3 Then
                    KeyAscii = 0
                    Exit Sub
                End If
'                If CurSelL = 0 Then
                    Lastr = IpText.Text
                    Dc = InStr(CurSitIndex, Lastr, ".")
                    If Dc > 0 Then
                        IpText.SelStart = Dc
                        L = InStr(Dc + 1, Lastr, ".")
                        If L > 0 Then
                            IpText.SelLength = L - (Dc + 1)
                        Else
                            IpText.SelLength = 3
                        End If
'                        KeyAscii = 0
'                        Exit Sub
                    End If
'                End If
                Dc = 0
                L = 1
                Do
                    i = InStr(L, Lastr, ".")
                    If i > 0 Then
                        Dc = Dc + 1
                        L = i + 1
                    Else
                        Exit Do
                    End If
                Loop While (True)
                If CurSelL > 0 Then
                    SStr = Mid(Lastr, CurSitIndex, CurSelL)
                    If InStr(1, SStr, ".") > 0 Then Dc = Dc - 1 '33
                End If
                If Dc < 3 Then
                    Exit Sub
                Else
                    If Mid(IpText.Text, IpText.SelStart + 1, 1) = "." Then
                        IpText.SelStart = IpText.SelStart + 1
                        Lastr = Mid(Lastr, IpText.SelStart + 1)
                        If Lastr <> "" Then
                            i = InStr(1, Lastr, ".")
                            If i > 0 Then
                                Lastr = Mid(Lastr, 1, i - 1)
                            End If
                            IpText.SelLength = Len(Lastr)
                        End If
                    End If
                End If
            End If
            KeyAscii = 0
            Exit Sub
        ElseIf Lastr <> "" Then
            Dc = 0
            L = 1
            Do              '''查找小数点的位置
                i = InStr(L, Lastr, ".")
                If i > 0 Then
                    DopSit(Dc) = i
                    Dc = Dc + 1
                    L = i + 1
                Else
                    If L > 1 Then DopSit(Dc) = Len(Lastr) + 1
                    Exit Do
                End If
            Loop While (True)
            If DopSit(0) > 0 Then
                If CurSitIndex < DopSit(0) Then             '''取光标所在区段内的数据
                    SStr = Mid(Lastr, 1, DopSit(0) - 1)
                    
                ElseIf CurSitIndex < DopSit(1) Then
                    SStr = Mid(Lastr, DopSit(0) + 1, DopSit(1) - DopSit(0) - 1)
                    CurSitIndex = CurSitIndex - DopSit(0)
                ElseIf CurSitIndex < DopSit(2) Then
                    SStr = Mid(Lastr, DopSit(1) + 1, DopSit(2) - DopSit(1) - 1)
                    CurSitIndex = CurSitIndex - DopSit(1)
                Else
                    SStr = Mid(Lastr, DopSit(2) + 1)
                    CurSitIndex = CurSitIndex - DopSit(2)
                End If
            Else
                SStr = Lastr
            End If
            If CurSitIndex < 0 Then CurSitIndex = 0
            If CurSelL > 0 Then
                If SStr <> Mid(Lastr, IpText.SelStart + 1, CurSelL) Then
                    Select Case CurSitIndex
                    Case 0
                        SStr = Mid(SStr, CurSelL + 1)
                    Case 1
                        SStr = Left(SStr, 1) + Mid(SStr, CurSelL + 2)
                    Case 2
                        SStr = Mid(SStr, 1, 2)
                    Case Else
                    End Select
                Else
                    Exit Sub
                End If
            End If
            If Len(SStr) < 3 And SStr <> "" Then
                Select Case CurSitIndex
                Case 0      ''''在区段的最前面
                    If Val(ChStr) > 0 Then
                        SStr = ChStr + SStr
'                    Else
'                        KeyAscii = 0
                    End If
                Case 1      ''''在区段的中间
                    If Len(SStr) < 2 Then
                        SStr = Left(SStr, 1) + ChStr
                    Else
                        SStr = Left(SStr, 1) + ChStr + Mid(SStr, 2)
                    End If
                Case 2      ''''在区段的最后面
                    SStr = SStr + ChStr
                    SelFlag = True
                End Select
                If Val(SStr) <= 255 Then
                    Exit Sub
                End If
            ElseIf SStr = "" And ChStr <> "0" Then
                Exit Sub
            ElseIf Len(SStr) >= 3 Then
                IpText.SelStart = IpText.SelStart + 1
            End If
            KeyAscii = 0
        End If
    Else
        If CurSitIndex > 0 Then
            If Mid(Lastr, CurSitIndex, 1) = "." Then
                CurSitIndex = CurSitIndex - 1
                IpText.SelStart = CurSitIndex
                KeyAscii = 0
            End If
        End If
    End If
End Sub

Private Sub IpText_KeyUp(KeyCode As Integer, Shift As Integer)
Dim SelL As Integer
Dim Lastr As String
Dim SelS As Integer
Dim i As Integer
Dim L As Integer

    SelL = IpText.SelLength
    If Shift = 1 And SelL > 0 Then
        SelS = IpText.SelStart
        Lastr = IpText.Text
        Lastr = Mid(Lastr, SelS + 1, SelL)
        i = InStr(1, Lastr, ".")
        If i > 0 Then
            If i = 1 Then
                If Len(Lastr) > 1 Then
                    SelS = SelS + 1
                    Lastr = Mid(Lastr, 2)
                    IpText.SelStart = SelS
                    i = InStr(1, Lastr, ".")
                    If i > 0 Then
                        SelL = Len(Mid(Lastr, 1, i - 1))
                    Else
                        SelL = Len(Lastr)
                    End If
                    IpText.SelLength = SelL
                Else
                    IpText.SelLength = 0
                End If
            Else
                Lastr = Mid(Lastr, 1, i - 1)
                i = InStr(1, Lastr, ".")
                If i > 0 Then
                    SelL = Len(Mid(Lastr, 1, i - 1))
                Else
                    SelL = Len(Lastr)
                End If
                IpText.SelLength = SelL
            End If
        End If
    End If
    If SelFlag = True Then
        SelFlag = False
        i = IpText.SelStart
        L = InStr(i + 2, IpText.Text, ".")
        If L = 0 Then
            L = 3
        Else
            L = L - i - 2
        End If
        IpText.SelStart = i + 1
        IpText.SelLength = L
    End If

End Sub

Private Sub IpText_LostFocus()
    If Trim(IpText.Text) = "" Then
        IpText.Text = "127.0.0.1"
    End If
End Sub

Private Sub IpText_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim SelL As Integer
Dim Lastr As String
Dim SelS As Integer
Dim i As Integer

    SelL = IpText.SelLength
    If Button = 1 And SelL > 0 Then
        SelS = IpText.SelStart
        Lastr = IpText.Text
        Lastr = Mid(Lastr, SelS + 1, SelL)
        i = InStr(1, Lastr, ".")
        If i > 0 Then
            If i = 1 Then
                If Len(Lastr) > 1 Then
                    SelS = SelS + 1
                    Lastr = Mid(Lastr, 2)
                    IpText.SelStart = SelS
                    i = InStr(1, Lastr, ".")
                    If i > 0 Then
                        SelL = Len(Mid(Lastr, 1, i - 1))
                    Else
                        SelL = Len(Lastr)
                    End If
                    IpText.SelLength = SelL
                Else
                    IpText.SelLength = 0
                End If
            Else
                Lastr = Mid(Lastr, 1, i - 1)
                i = InStr(1, Lastr, ".")
                If i > 0 Then
                    SelL = Len(Mid(Lastr, 1, i - 1))
                Else
                    SelL = Len(Lastr)
                End If
                IpText.SelLength = SelL
            End If
        End If
    End If
End Sub

Private Sub LocalText_KeyPress(KeyAscii As Integer)
Dim ChStr As String

    If KeyAscii = 8 Then Exit Sub
    ChStr = Chr(KeyAscii)
    If (ChStr < "0" Or ChStr > "9") Then    '''非数字
        KeyAscii = 0
    End If
End Sub

Private Sub MSGrid_DblClick()
Dim L As Integer

    If WFlag = False Then Exit Sub
    Text2.Visible = False
    If DbClickFlag = True Then
        If SelGCol > 0 And SelGRow > 0 Then
            Set_TextPositon
            Text2.Text = MSGrid.TextMatrix(SelGRow, SelGCol)
            Text2.Visible = True
            L = Len(Text2.Text)
            Text2.SetFocus
            Text2.SelStart = 0
            Text2.SelLength = L
        End If
    End If
    DbClickFlag = False
End Sub

Private Sub MSGrid_KeyPress(KeyAscii As Integer)
    If WFlag = False Then Exit Sub
    If KeyAscii = 13 Or KeyAscii = 32 Then
        DbClickFlag = True
        MSGrid_DblClick
    End If
End Sub

Private Sub MSGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If WFlag = False Then Exit Sub
    If Button = 1 Then
        DbClickFlag = True
    Else
        DbClickFlag = False
    End If
    SelGCol = MSGrid.MouseCol
    SelGRow = MSGrid.MouseRow
End Sub

Private Sub MSGrid_Scroll()
    If WFlag = False Then Exit Sub
    If MSGrid.TopRow <> LastGrid1Top Then
        Text2.Top = Text2.Top + (LastGrid1Top - MSGrid.TopRow) * MSGrid.RowHeight(0)
        LastGrid1Top = MSGrid.TopRow
        If SelGRow < LastGrid1Top Or SelGRow >= (LastGrid1Top + MaxVisbleRows) Then
            If Text2.Visible = True Then
                Text2.Visible = False
                HsNoFlag = True
            End If
        ElseIf HsNoFlag = True Then
            Text2.Visible = True
            Text2.SetFocus
            HsNoFlag = False
        End If
    End If
End Sub

Private Sub NumText_Change()
Dim i As Integer
    i = Val(NumText.Text)
    If i < 1 Or i > 127 Then
        i = 1
        NumText.Text = "1"
    End If
    MSGrid.Rows = i + 1
    InitGrid
    Check2.Value = 0
    AutoStr = ""
    Frame2.Enabled = False
End Sub

Private Sub InitGrid()
Dim i As Integer
Dim k As Long
Dim j As Integer
    
    k = Val(StartText.Text)
    For i = 1 To MSGrid.Rows - 1
        j = i - 1
        MSGrid.TextMatrix(i, 0) = "0x" + Hexn(k + j, 4)
    Next i
End Sub

Private Sub NumText_KeyPress(KeyAscii As Integer)
Dim ChStr As String

    If KeyAscii = 8 Then Exit Sub
    ChStr = Chr(KeyAscii)
    If (ChStr < "0" Or ChStr > "9") Then    '''非数字
        KeyAscii = 0
    End If
End Sub

Private Sub Option1_Click(Index As Integer)
    If Index = 0 Then
        Frame2.Enabled = True
        WFlag = False
    Else
        Frame2.Enabled = False
        WFlag = True
    End If
End Sub

Private Sub Process_data(ByVal Datstr As String)
Dim i As Integer
Dim L As Integer
Dim j As Integer
Dim k As Integer
On Error GoTo ErrP
'Dim TmStr As String

    L = LenB(Datstr)
    k = 1
    For i = 1 To L
        j = AscB(MidB(Datstr, i, 1))
        k = ((i - 1) Mod 2) + 1
        MSGrid.TextMatrix((i + 1) \ 2, k) = j
        If k = 2 Then
            MSGrid.TextMatrix((i + 1) \ 2, 3) = MSGrid.TextMatrix((i + 1) \ 2, 1) * 256 + MSGrid.TextMatrix((i + 1) \ 2, 2)
'            TmStr = MSGrid.TextMatrix((i + 1) \ 2, 3)
'            MSGrid.TextMatrix((i + 1) \ 2, 4) = Val("&H" + Hexn(Val(TmStr), 4))