form1.frm

ABxprotocol控件的编程应用

VERSION 5.00
Object = "{2882CC2F-C640-4997-A094-3A73BE6139DE}#56.0#0"; "ABx_Interface.ocx"
Begin VB.Form Form1 
   BorderStyle     =   5  'Sizable ToolWindow
   ClientHeight    =   6540
   ClientLeft      =   60
   ClientTop       =   300
   ClientWidth     =   8925
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6540
   ScaleWidth      =   8925
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Block_Read 
      Caption         =   "块读"
      Height          =   375
      Left            =   1200
      TabIndex        =   5
      Top             =   240
      Width           =   975
   End
   Begin VB.CommandButton Clear_Input 
      Caption         =   "清除显示"
      Height          =   375
      Left            =   3360
      TabIndex        =   4
      Top             =   240
      Width           =   975
   End
   Begin VB.CommandButton BlockWrite 
      Caption         =   "块写"
      Height          =   375
      Left            =   2280
      TabIndex        =   3
      Top             =   240
      Width           =   975
   End
   Begin VB.CommandButton Stop_cont 
      Caption         =   "停止连续读"
      Height          =   375
      Left            =   5520
      TabIndex        =   2
      Top             =   240
      Width           =   1215
   End
   Begin VB.CommandButton Continuous_Read 
      Caption         =   "连续读"
      Height          =   375
      Left            =   4440
      TabIndex        =   1
      Top             =   240
      Width           =   975
   End
   Begin VB.CommandButton Stop_Program 
      Caption         =   "结束"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   975
   End
   Begin ABx_Interface.ABx_Protocol ABx_Protocol 
      Left            =   6840
      Top             =   120
      _ExtentX        =   1931
      _ExtentY        =   1085
      InBufferSize    =   5000
      OutBufferSize   =   2500
   End
   Begin VB.Label COM1 
      Height          =   375
      Left            =   8040
      TabIndex        =   8
      Top             =   240
      Width           =   735
   End
   Begin VB.Label Label 
      BorderStyle     =   1  'Fixed Single
      Height          =   4815
      Left            =   0
      TabIndex        =   7
      Top             =   1680
      Width           =   8895
   End
   Begin VB.Line Line1 
      BorderWidth     =   5
      X1              =   0
      X2              =   8880
      Y1              =   1558
      Y2              =   1558
   End
   Begin VB.Label Sent_This 
      BorderStyle     =   1  'Fixed Single
      Height          =   495
      Left            =   0
      TabIndex        =   6
      Top             =   840
      Width           =   8895
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'

Option Explicit

Const VERSION_STRING = "Activex控件标准模式应用的实例"


Const MAX_CHAR_INLABEL = 1010

Const PROTOCOL_IN_USE = ABX_STANDARD_FMT

Const ERROR_SUCCESS = 0

Const FRS_ERR_INTERNAL = 8005


Private Sub Form_Load()
    Dim COM_Setup_State As Integer
    Dim Port As Integer
   
    
    Port = 1
    COM_Setup_State = ABx_Protocol.Setup_COMport(Port, 9600, PROTOCOL_IN_USE, False, False)
    If (COM_Setup_State = FRS_ERR_INTERNAL) Then
        Call MsgBox("COM" & LTrim(Str(Port)) & " 串口不可用或已经打开", vbOKOnly, "串口打开错误")
    ElseIf (COM_Setup_State <> ERROR_SUCCESS) Then
        Call MsgBox("COM" & LTrim(Str(Port)) & "没有打开。启动错误： " & Str(COM_Setup_State), vbOKOnly, "COM" & LTrim(Str(Port)) & " 打开错误")
    End If
  
    
    Form1.Caption = "Activex 控件演示实例"
   
    Form1.Show vbModeless
End Sub

Private Sub ABx_Protocol_DispEvents(Packet_Type As ABx_Interface.ABx_PACKET_TYPES, Received_Resp() As Byte, Pkt_Size As Integer)
    Dim Loop_Count As Integer
    Dim myRdata As String
    If (Len(Label.Caption) > MAX_CHAR_INLABEL) Then
        Label.Caption = ""
    End If
    Label.Caption = Label.Caption & Chr(10) & " 事件显示在COM" & LTrim(Str$(ABx_Protocol.CommPort)) & " "
    Select Case Packet_Type
        Case REC_NOTHING
            Label.Caption = Label.Caption & "读写没有响应。 "
        Case REC_ERROR
            Label.Caption = Label.Caption & "有效的ABx数据包 ->"
        Case REC_OK_RESPONSE
            Label.Caption = Label.Caption & "有效的响应包 ->"
        Case REC_PACKET_ERROR
            Label.Caption = Label.Caption & "有效的错误响应包 ->"
        Case REC_ALL_STATUS
            Label.Caption = Label.Caption & "状态响应包 ->"
        Case REC_LAST_PACKET
            Label.Caption = Label.Caption & "最后响应包 ->"
        Case Else
             Label.Caption = Label.Caption & "内部错误 "
   End Select
    
    If (Pkt_Size >= 1) Then
        For Loop_Count = 0 To (Pkt_Size - 1)
        
        
        If Received_Resp(Loop_Count) <= 15 Then
                 myRdata = "0" & Hex(Received_Resp(Loop_Count))
        Else
                 myRdata = Hex(Received_Resp(Loop_Count))
        End If
     
     
            Label.Caption = Label.Caption & " " & myRdata
        Next Loop_Count
        Label.Caption = Label.Caption & " <-"
    End If
End Sub


Private Sub ABx_Protocol_DispMessage(Show_This_Str As String)
                                    
    Label.Caption = Label.Caption & "COM" & LTrim(Str$(ABx_Protocol.CommPort)) & ": " & Show_This_Str & " "
End Sub


Private Sub ABx_Protocol_DispSent(MUX_Address As Integer, Packet_Sent() As Byte, Pkt_Size As Integer)
    Dim Looping As Integer
    Dim mySdata As String
    Sent_This.Caption = "Sent: "
    For Looping = 0 To Pkt_Size - 1
    
        If Packet_Sent(Looping) <= 15 Then
                 mySdata = "0" & Hex(Packet_Sent(Looping))
        Else
                 mySdata = Hex(Packet_Sent(Looping))
        End If
    
        Sent_This.Caption = Sent_This.Caption & " " & mySdata
    Next Looping
End Sub


Private Sub Clear_Input_Click()
    Sent_This.Caption = ""
    Label.Caption = ""
End Sub

Private Sub Block_Read_Click()
Form1.Hide
    If (ABx_Protocol.Block_Read(1, 8, 2000, RS232_MUXADDR_VAL, True) = False) Then
        Label.Caption = Label.Caption & "无块读响应在串口" & Str$(ABx_Protocol.CommPort) & "！ "
    
    End If
Form1.Show
End Sub

Private Sub BlockWrite_Click()
Dim BytesToWrite(4) As Byte

    BytesToWrite(0) = &H48
    BytesToWrite(1) = &H65
    BytesToWrite(2) = &H6C
    BytesToWrite(3) = &H6C
    BytesToWrite(4) = &H6F
    
  Form1.Hide
    If (ABx_Protocol.Block_Write(1, UBound(BytesToWrite) + 1, 2000, BytesToWrite, RS232_MUXADDR_VAL) = False) Then
        Label.Caption = Label.Caption & "无块写响应在串口" & Str$(ABx_Protocol.CommPort) & "！ "
    End If
  Form1.Show
End Sub

Private Sub Continuous_Read_Click()
Form1.Hide
    If (ABx_Protocol.Continuous_Block_Read(0, 10, 1) = False) Then
        Label.Caption = Label.Caption & "无连续读响应在串口" & LTrim(Str$(ABx_Protocol.CommPort)) & "! "
    End If
Form1.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ABx_Protocol.Close_ABx_COM
End Sub


Private Sub Stop_Cont_Click()
Form1.Hide
    If (ABx_Protocol.Continuous_Block_Read(0, 0, 0) = False) Then
        Label.Caption = Label.Caption & "无停止连续读命令响应在串口" & LTrim(Str$(ABx_Protocol.CommPort)) & "! "
    End If
Form1.Show
End Sub

Private Sub Stop_Program_Click()
    Unload Me
End Sub