frmdevicereadwrite.frm

此为交通信号机

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form FrmDeviceReadWrite 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "PLC读/写操作"
   ClientHeight    =   4545
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6330
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4545
   ScaleWidth      =   6330
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox TxtWriteNums 
      Height          =   390
      Left            =   4920
      MaxLength       =   2
      TabIndex        =   10
      Top             =   480
      Width           =   975
   End
   Begin VB.CommandButton CmdWrite 
      Caption         =   "写操作"
      Height          =   495
      Left            =   4560
      TabIndex        =   8
      Top             =   3480
      Width           =   1335
   End
   Begin VB.TextBox TxtEdit 
      BackColor       =   &H00FF0000&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000005&
      Height          =   255
      Left            =   5880
      MaxLength       =   2
      TabIndex        =   7
      Top             =   3120
      Visible         =   0   'False
      Width           =   375
   End
   Begin MSFlexGridLib.MSFlexGrid Grid1 
      Height          =   1875
      Left            =   480
      TabIndex        =   6
      Top             =   1080
      Width           =   5415
      _ExtentX        =   9551
      _ExtentY        =   3307
      _Version        =   393216
      Rows            =   8
      Cols            =   8
      FixedRows       =   0
      FixedCols       =   0
      HighLight       =   0
      ScrollBars      =   0
      AllowUserResizing=   3
   End
   Begin VB.CommandButton CmdReturn 
      Caption         =   "返回"
      Height          =   495
      Left            =   2520
      TabIndex        =   5
      Top             =   3480
      Width           =   1215
   End
   Begin VB.CommandButton CmdRead 
      Caption         =   "读操作"
      Height          =   495
      Left            =   480
      TabIndex        =   4
      Top             =   3480
      Width           =   1215
   End
   Begin VB.TextBox TxtNum 
      Height          =   375
      Left            =   2640
      MaxLength       =   2
      TabIndex        =   3
      Top             =   480
      Width           =   975
   End
   Begin VB.TextBox TxtAddStart 
      Height          =   375
      Left            =   480
      MaxLength       =   4
      TabIndex        =   1
      Top             =   480
      Width           =   1020
   End
   Begin VB.Label Label3 
      Caption         =   "写数据个数(1-64)"
      Height          =   255
      Left            =   4680
      TabIndex        =   9
      Top             =   120
      Width           =   1455
   End
   Begin VB.Label Label2 
      Caption         =   "读数据个数(1-64)"
      Height          =   255
      Left            =   2520
      TabIndex        =   2
      Top             =   120
      Width           =   1455
   End
   Begin VB.Label Label1 
      Caption         =   "位/字元件起始地址:"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1695
   End
End
Attribute VB_Name = "FrmDeviceReadWrite"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub CmdRead_Click()
       Dim Sum As Integer
       Dim Num As String
       Dim i, j, col, row As Integer
       Dim instring As String
       Dim sumstring As String
       Dim sumstring2 As String
       Dim time1
       
       '清除数据表
       Grid1.Clear
       
       '判断有无起始地址
         If TxtAddStart.Text = "" Then
              response = MsgBox("无起始地址!", 48, title)
              TxtAddStart.SetFocus
              GoTo End2:
          Else
         End If
         
       '判断读数据量是否超出范围
           If Val(TxtNum.Text) > 64 Or Val(TxtNum.Text) < 1 Then
             MsgBox "读数据个数超出范围(1-64)"
             TxtNum.SetFocus
             GoTo End2
           Else
           End If
        TxtNum.Text = Val(TxtNum.Text)
       
        '将地址调整为4位
      If Len(TxtAddStart.Text) <> 4 Then
            Select Case Len(TxtAddStart.Text)
               Case 1
                   TxtAddStart.Text = "0" + "0" + "0" + TxtAddStart.Text
               Case 2
                   TxtAddStart.Text = "0" + "0" + TxtAddStart.Text
               Case 3
                   TxtAddStart.Text = "0" + TxtAddStart.Text
            End Select
       End If
       
       '地址和校验
       Sum = &H30
       For i = 1 To 4
       Sum = Sum + Asc(Mid(TxtAddStart.Text, i, 1))
       Next i
       
       '调整位数
       Num = Hex(Val(TxtNum.Text))
       If Len(Num) = 1 Then
       Num = "0" + Num
       End If
       
       '数量和校验
       For i = 1 To 2
       Sum = Sum + Asc(Mid(Num, i, 1))
       Next
       
       Sum = Sum + 3
       sumstring = Hex(Sum)
       sumstring2 = Right(sumstring, 2)
        
       FrmMain.MSComm1.PortOpen = True
       FrmMain.MSComm1.Output = Chr(&H2) + Chr(&H30)   'STX  CMD 0
       FrmMain.MSComm1.Output = TxtAddStart.Text
       FrmMain.MSComm1.Output = Num
       FrmMain.MSComm1.Output = Chr(3)            'ETX
       FrmMain.MSComm1.Output = sumstring2        'SUM
       
         
         '接收数据
         '检测是否有NAK!
         i = 0
         time1 = Timer
         Do
         DoEvents
            If FrmMain.MSComm1.InBufferCount = 2 Then
            i = i + 1
            Else
            End If
            
         Loop Until FrmMain.MSComm1.InBufferCount >= (2 * Val(TxtNum.Text) + 4) Or i >= 10 Or (Timer - time1) > 3
         
         instring = FrmMain.MSComm1.Input
         
         If (Timer - time1) > 3 Then
           MsgBox "PLC没有响应！"
           GoTo end1:
         Else
            If i >= 10 Then
                If Left(instring, 1) = Chr(&H15) Then
                     MsgBox "PLC不能辨别指令或者数据校验错误！"
                    GoTo end1:
                  
             Else
             End If
         Else
         End If
         End If
        '和校验收到的数据
        Sum = 0
        For i = 2 To 2 * Val(TxtNum.Text) + 2
            Sum = Sum + Asc(Mid(instring, i, 1))
        Next
        sumstring = Hex(Sum)
        sumstring2 = Right(sumstring, 2)
              If sumstring2 <> Mid(instring, 2 * Val(TxtNum.Text) + 3, 2) Then
                  MsgBox "数据校验错误！请从新读取数据"
              GoTo end1:
              Else
             
              End If
        '显示读来的数据：
            i = 2
            j = 0
           For row = 0 To 7
               For col = 0 To 7
                  Grid1.col = col
                  Grid1.row = row
                  Grid1.Text = Mid(instring, i, 2)
                 i = i + 2
                  j = j + 1
                  If j >= Val(TxtNum.Text) Then
                   Exit For
                   Else
                   End If
                Next
              If j >= Val(TxtNum.Text) Then
                 Exit For
              Else
           End If
        Next
         MsgBox "数据接收正确！"
       
end1:        FrmMain.MSComm1.PortOpen = False
End2:
        
End Sub        '读数据过程结束
Private Sub CmdReturn_Click()
       FrmDeviceReadWrite.Hide
End Sub

Private Sub CmdWrite_Click()
         Dim outstring, instring As String
         Dim i, j, col, row As Integer
         Dim Sum As Integer
         Dim WriteNum As String
         Dim time1
         
         '是否继续
          response = MsgBox("此次操作将修改PLC中原有数据，继续吗？", vbYesNo, title)
         If response = vbNo Then    ' 用户按下“否”。
         GoTo end1:
         End If
            
         '判断有无起始地址
         If TxtAddStart.Text = "" Then
              response = MsgBox("无起始地址!", 48, title)
              TxtAddStart.SetFocus
              GoTo end1:
          Else
         End If
         
         '判断写数据量是否超出范围1-64
           If Val(TxtWriteNums.Text) > 64 Or Val(TxtWriteNums.Text) < 1 Then
             response = MsgBox("写数据个数超出范围(1-64)", 48, title)
             TxtWriteNums.SetFocus
             GoTo end1
           Else
           End If
        TxtWriteNums.Text = Val(TxtWriteNums.Text)
        
        ' 判断是否有不合格的字符
         For i = 0 To Val(TxtWriteNums.Text) - 1
            If Grid1.TextArray(i) = "" Or Len(Grid1.TextArray(i)) < 2 Then
            response = MsgBox("待发数据中有不合格的字符", 48, title)
            Grid1.SetFocus
            GoTo end1:
            Exit For
            Else
            End If
         Next
         
         '将地址调整为4位
         If Len(TxtAddStart.Text) <> 4 Then
            Select Case Len(TxtAddStart.Text)
               Case 1
                   TxtAddStart.Text = "0" + "0" + "0" + TxtAddStart.Text
               Case 2
                   TxtAddStart.Text = "0" + "0" + TxtAddStart.Text
               Case 3
                   TxtAddStart.Text = "0" + TxtAddStart.Text
            End Select
         End If
         
          '调整位数
            WriteNum = Hex(Val(TxtWriteNums.Text))
            If Len(WriteNum) = 1 Then
              WriteNum = "0" + WriteNum
            End If
         
          '将待发数据整理成字符串
            outstring = ""
            For i = 0 To Val(TxtWriteNums.Text) - 1
              outstring = outstring + Grid1.TextArray(i)
            Next
          
          
          
          '地址和校验
           Sum = &H31               'CMD 1
           For i = 1 To 4
           Sum = Sum + Asc(Mid(TxtAddStart.Text, i, 1))
           Next i
         
           '数量和校验
            For i = 1 To 2
               Sum = Sum + Asc(Mid(WriteNum, i, 1))
           Next
         
           '数据和校验
             
            For i = 1 To 2 * Val(TxtWriteNums.Text)
                Sum = Sum + Asc(Mid(outstring, i, 1))
            Next
           Sum = Sum + 3      '和校验完毕
            
           '发送数据
          
           FrmMain.MSComm1.PortOpen = True
           FrmMain.MSComm1.Output = Chr(&H2) + Chr(&H31)   'STX  CMD 1
           FrmMain.MSComm1.Output = TxtAddStart.Text
           FrmMain.MSComm1.Output = WriteNum
           FrmMain.MSComm1.Output = outstring
           FrmMain.MSComm1.Output = Chr(3)            'ETX
           FrmMain.MSComm1.Output = Right(Hex(Sum), 2)            'SUM


           '接收应答：
           time1 = Timer
           Do
           DoEvents
           Loop Until FrmMain.MSComm1.InBufferCount >= 1 Or (Timer - time1) > 10
           instring = FrmMain.MSComm1.Input
           
           If (Timer - time1) > 10 Then
               MsgBox "PLC没有响应！"
           Else
               If instring = Chr(6) Then
                 MsgBox "数据传输成功！"
               Else
                 If instring = Chr(&H15) Then
                  MsgBox "数据传输失败！请重试"
                 Else
                 End If
               End If
            End If
           FrmMain.MSComm1.PortOpen = False
          
end1:
End Sub

Private Sub Form_Load()
          Left = (Screen.Width - Width) / 2
          Top = (Screen.Height - Height) / 2
          
          For i = 0 To 7
          Grid1.ColWidth(i) = Grid1.Width / 8 - 9
          Grid1.ColAlignment(i) = 2
          Next
         
End Sub








Private Sub TxtAddStart_Change()
      
       TxtAddStart.Text = UCase(TxtAddStart.Text)
      
      
End Sub

Private Sub TxtEdit_Change()
       '大写
       TxtEdit.Text = UCase(TxtEdit.Text)
       Grid1.Text = TxtEdit.Text
End Sub

Private Sub TxtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
       Select Case KeyCode
           Case vbKeyEscape         '当 ESC键按下时
              CmdRead.SetFocus
              TxtEdit.Visible = False
           
           Case vbKeyUp             '当 UP键按下时
              If Grid1.row > 0 Then
                 Grid1.row = Grid1.row - 1
              End If
              EditGrid Grid1, TxtEdit
           
           Case vbKeyDown             '当 DOWN键按下时
            If TxtEdit.Text = "" Then
               GoTo endcase1:
               Else
               
               If Grid1.row < 7 Then
                 Grid1.row = Grid1.row + 1
              End If
            End If
endcase1:      EditGrid Grid1, TxtEdit
           
           Case vbKeyLeft               '当 LEFT键按下时
              If Grid1.col > 0 Then
                 Grid1.col = Grid1.col - 1
              Else
                 If Grid1.row > 0 Then
                   Grid1.col = 7
                   Grid1.row = Grid1.row - 1
                 Else
                 End If
              End If
                 EditGrid Grid1, TxtEdit
           
           Case vbKeyRight                '当 RIGHT键按下时
               If TxtEdit.Text = "" Then
                 GoTo endcase2:
                 Else
                 If Grid1.col < 7 Then
                 Grid1.col = Grid1.col + 1
                 Else
                 If Grid1.row < Grid1.Rows - 1 Then
                   Grid1.col = 0
                   Grid1.row = Grid1.row + 1
                   Else
                 End If
              End If
             End If
endcase2:       EditGrid Grid1, TxtEdit
              
       End Select
       
End Sub


Private Sub TxtEdit_LostFocus()
        'TxtEdit.Visible = False
        
End Sub




  '添加编辑功能。。。

Sub grid1_GotFocus()
     EditGrid Grid1, TxtEdit
End Sub

   ' 自定义
Sub EditGrid(Msflexgrid As Control, Text As Control)
    Text = Msflexgrid
    Text.Visible = True
     '在合适的位置显示 TxtEdit。
    Text.Move Msflexgrid.CellLeft + Msflexgrid.Left, Msflexgrid.CellTop + Msflexgrid.Top, _
    Msflexgrid.CellWidth, Msflexgrid.CellHeight
     '启动工作。
    Text.SetFocus
    
End Sub
Sub grid1_LeaveCell()
    If TxtEdit.Visible = False Then Exit Sub
    Grid1 = TxtEdit
    TxtEdit.Visible = False
End Sub

Function GridIndex(c As Integer, r As Integer) As Integer
       GridIndex = r * Grid1.FixedCols + c
End Function