frmadjust.frm

应用研究计算上的许多地方上用的到的算法

         Index           =   6
         Left            =   600
         TabIndex        =   11
         Top             =   480
         Width           =   1095
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "U31"
      Height          =   1575
      Index           =   0
      Left            =   8760
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   8775
      Begin VB.Frame Frame2 
         Caption         =   "690V档位"
         Height          =   975
         Index           =   2
         Left            =   6000
         TabIndex        =   7
         Top             =   360
         Width           =   2295
         Begin VB.CommandButton Command1 
            Caption         =   "校满"
            Height          =   375
            Index           =   5
            Left            =   1320
            TabIndex        =   9
            Top             =   360
            Width           =   735
         End
         Begin VB.CommandButton Command1 
            Caption         =   "校0"
            Height          =   375
            Index           =   4
            Left            =   240
            TabIndex        =   8
            Top             =   360
            Width           =   735
         End
      End
      Begin VB.Frame Frame2 
         Caption         =   "220V档位"
         Height          =   975
         Index           =   1
         Left            =   3240
         TabIndex        =   4
         Top             =   360
         Width           =   2295
         Begin VB.CommandButton Command1 
            Caption         =   "校满"
            Height          =   375
            Index           =   3
            Left            =   1320
            TabIndex        =   6
            Top             =   360
            Width           =   735
         End
         Begin VB.CommandButton Command1 
            Caption         =   "校0"
            Height          =   375
            Index           =   2
            Left            =   240
            TabIndex        =   5
            Top             =   360
            Width           =   735
         End
      End
      Begin VB.Frame Frame2 
         Caption         =   "100V档位"
         Height          =   975
         Index           =   0
         Left            =   480
         TabIndex        =   1
         Top             =   360
         Width           =   2295
         Begin VB.CommandButton Command1 
            Caption         =   "校0"
            Height          =   375
            Index           =   0
            Left            =   240
            TabIndex        =   3
            Top             =   360
            Width           =   735
         End
         Begin VB.CommandButton Command1 
            Caption         =   "校满"
            Height          =   375
            Index           =   1
            Left            =   1320
            TabIndex        =   2
            Top             =   360
            Width           =   735
         End
      End
   End
   Begin VB.Label Label1 
      Caption         =   "提示：校准P31S，P31,Q31,S32时，请按电压，电流，功率相位的顺序进行校准。"
      Height          =   255
      Left            =   360
      TabIndex        =   127
      Top             =   5400
      Visible         =   0   'False
      Width           =   6495
   End
End
Attribute VB_Name = "FrmAdjust"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Flag_Send As Boolean
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0, 22, 33, 72, 59, 50
            Call SendDataReady(3, 1, 0, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 1, 0, 1)
       Case 1, 21, 34, 73, 60, 49
            Call SendDataReady(3, 1, 0, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 1, 0, 2)
       Case 2, 20, 35, 70, 57, 52
            Call SendDataReady(3, 1, 1, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 1, 1, 1)
       Case 3, 19, 36, 71, 58, 51
            Call SendDataReady(3, 1, 1, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 1, 1, 2)
       Case 4, 18, 37, 68, 55, 54
            Call SendDataReady(3, 1, 2, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 1, 2, 1)
       Case 5, 17, 38, 69, 56, 53
            Call SendDataReady(3, 1, 2, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 1, 2, 2)
       Case 6, 23, 39, 74, 61, 48
            Call SendDataReady1(3, 2, 0, 0)
       Case 7, 24, 40, 75, 62, 47
            Call SendDataReady1(3, 2, 0, 1)
       Case 8, 25, 41, 76, 63, 46
            Call SendDataReady1(3, 2, 0, 2)
       Case 9
            Call SendDataReady(3, 3, 0, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 3, 0, 1)
       Case 10
            Call SendDataReady(3, 3, 0, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 3, 0, 2)
       Case 11
            Call SendDataReady(3, 3, 1, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 3, 1, 1)
       Case 12
            Call SendDataReady(3, 3, 1, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 3, 1, 2)
       Case 13
            Call SendDataReady(3, 3, 2, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 3, 2, 1)
       Case 14
            Call SendDataReady(3, 3, 2, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 3, 2, 2)
      Case 15
            Call SendDataReady1(3, 4, 0, 0)
      Case 16
            Call SendDataReady1(3, 4, 0, 1)
      Case 26, 77, 64, 45
            Call SendDataReady(3, 6, 0, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 6, 0, 1)
      Case 27, 78, 65, 44
            Call SendDataReady(3, 6, 0, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 6, 0, 2)
      Case 28, 79, 66, 43
            Call SendDataReady(3, 6, 1, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 6, 1, 1)
      Case 29, 80, 67, 42
            Call SendDataReady(3, 6, 2, 0)
            Call Sleep(3000)
            Call SendDataReady1(3, 6, 2, 1)
      Case 30
            Call SendDataReady1(3, 6, 0, 0)
      Case 31
            Call SendDataReady1(3, 5, 0, 0)
      Case 32
            Call SendDataReady1(3, 5, 0, 1)
   End Select
End Sub

Private Sub Form_Load()
    Flag_Send = False
    Frame1(HardwareType).Left = 360
    Frame1(HardwareType).Top = 240
    Frame1(HardwareType).Visible = True
    If HardwareType = 4 Or HardwareType = 10 Or HardwareType = 11 Or HardwareType = 12 Then
        Label1.Visible = True
    End If
    InitMscomm
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SendDataReady2
    FrmAdjust.MSComm.PortOpen = False
    FrmSysReg.MSComm.PortOpen = True
End Sub

Private Sub ModbusTrans()
    Dim i As Byte
    Dim Buf As String
On Error GoTo sendfailed
    Buf = String(SendLen, Chr(0))
    outbyte = StrConv(Buf, vbFromUnicode)
    For i = 0 To SendLen - 1
         outbyte(i) = SendBuf(i)
    Next i
    MSComm.Output = outbyte
    Exit Sub
sendfailed:
    Err.Clear
End Sub
Private Sub InitMscomm()
On Error GoTo ErrorHandler
    With MSComm
        .CommPort = COMport
        If .PortOpen = True Then
            .PortOpen = False
        End If
        .Settings = COMbaud + ",n,8,1"
        .InputMode = comInputModeBinary     '设置或返回 Input 属性取回的数据的类型,文本形式或二进制形式
        .NullDiscard = False        '确定 null 字符是否从端口传送到接收缓冲区
        .InBufferSize = 1000        '设置并返回接收缓冲区的字节数。
        .OutBufferSize = 1000       '设置并返回发送缓冲区的字节数。
        .InBufferCount = 0          '返回接收缓冲区中等待的字符数。属性设置为 0 来清除接收缓冲区。
        .OutBufferCount = 0         '返回在传输缓冲区中等待的字符数。 设置 OutBufferCount 属性为 0 可以清除传输缓冲区。
        .InputLen = 0               '设置并返回 Input 属性从接收缓冲区读取的字符数
                                    '设置 InputLen 为 0 时，使用 Input 将使 MSComm 控件读取接收缓冲区中全部的内容。
        .SThreshold = 0
        .RThreshold = 0             '设置并返回的要接收的字符数。 并将产生 OnComm的omEvReceive事件
        .PortOpen = True
    End With
    Exit Sub
ErrorHandler:
        MsgBox "串口" + Str(COMport) + " 打开失败", vbCritical       '+ vbCrLf + "无此串口或串口已打开"
End Sub

Private Sub SendDataReady(ByVal J1_H As Integer, ByVal J1_L As Integer, J2_H As Integer, J2_L As Integer)  '准备发送
    Dim i As Byte
    Dim temp As Long
        DataArr(0) = MTID
        DataArr(1) = &H66
        DataArr(2) = J1_H
        DataArr(3) = J1_L
        DataArr(4) = J2_H
        DataArr(5) = J2_L
        MSComm.RThreshold = 8
        For i = 0 To 5
            SendBuf(i) = DataArr(i)
        Next i
        temp = CRC16(6)
        SendBuf(6) = CrcDataHI
        SendBuf(7) = CrcDataLO
        SendLen = 8

    ModbusTrans
End Sub
Private Sub SendDataReady1(ByVal J1_H As Integer, ByVal J1_L As Integer, J2_H As Integer, J2_L As Integer) '校准发送
    Dim i As Byte
    Dim temp As Long
        DataArr(0) = MTID
        DataArr(1) = &H66
        DataArr(2) = J1_H
        DataArr(3) = J1_L
        DataArr(4) = J2_H
        DataArr(5) = J2_L
        MSComm.RThreshold = 8
        For i = 0 To 5
            SendBuf(i) = DataArr(i)
        Next i
        temp = CRC16(6)
        SendBuf(6) = CrcDataHI
        SendBuf(7) = CrcDataLO
        SendLen = 8
        Flag_Send = True
    ModbusTrans
End Sub
Private Sub MSComm_OnComm()
Dim i As Byte
On Error GoTo ErrHandler1
    With MSComm
        Select Case .CommEvent
            Case comEvReceive
                .RThreshold = 0
                inputbyte = .Input
                Reclen = 0
                For i = LBound(inputbyte) To UBound(inputbyte)
                    RecBuf(Reclen) = inputbyte(i)
                    DataArr(Reclen) = RecBuf(Reclen)
                    Reclen = Reclen + 1
                Next i
                CRC16 (Reclen - 2)
                If (RecBuf(Reclen - 2) = CrcDataHI) And (RecBuf(Reclen - 1) = CrcDataLO) Then
                    If RecBuf(0) = MTID And Reclen = 8 And Flag_Send = True Then
                        MsgBox "校准成功", , "提示"
                        Flag_Send = False
                    Else
                        MsgBox "请重新校准", , "提示"
                    End If
                Else
                    MsgBox "请重新校准", , "提示"
                End If
        End Select
    .InBufferCount = 0
    .OutBufferCount = 0
     End With
    Exit Sub
ErrHandler1:
End Sub

Private Sub SendDataReady2()
    Dim i As Byte
    Dim temp As Long

        DataArr(0) = MTID
        DataArr(1) = &H66
        DataArr(2) = &H3
        DataArr(3) = &H0
        DataArr(4) = &H0
        DataArr(5) = &H1
        MSComm.RThreshold = 8
        For i = 0 To 5
            SendBuf(i) = DataArr(i)
        Next i
        temp = CRC16(6)
        SendBuf(6) = CrcDataHI
        SendBuf(7) = CrcDataLO
        SendLen = 8

    ModbusTrans
End Sub