irqdemo.frm

一个代码齐全功能强大的串口初步学习应用教程,值得大家下载.

VERSION 5.00
Begin VB.Form IrqDemo 
   Caption         =   "Irq Demo"
   ClientHeight    =   4110
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   5655
   LinkTopic       =   "Form1"
   ScaleHeight     =   4110
   ScaleWidth      =   5655
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   3480
      Top             =   960
   End
   Begin VB.TextBox Term 
      Height          =   4095
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   0
      Width           =   5655
   End
   Begin VB.Menu cmPort 
      Caption         =   "Port"
      Begin VB.Menu cmOpen 
         Caption         =   "Open"
      End
      Begin VB.Menu cmClose 
         Caption         =   "Close"
      End
      Begin VB.Menu test2 
         Caption         =   "-"
      End
      Begin VB.Menu cmClear 
         Caption         =   "Clear Screen"
      End
      Begin VB.Menu test 
         Caption         =   "-"
      End
      Begin VB.Menu cmExit 
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu cmSetting 
      Caption         =   "Setting..."
   End
   Begin VB.Menu cmHelp 
      Caption         =   "Help"
      Begin VB.Menu cmAbout 
         Caption         =   "About"
      End
   End
End
Attribute VB_Name = "IrqDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**********************************************************************
'    IrqDemoM.frm
'     -- Main window for Irq function demo example program.
'
'    Description:
'      1.Select "setting..." menu item to set com port option.
'      2.Select "Open" menu item to open com port.
'        After selected "Open" from menu,you can type any key to
'        test sio_Tx_empty_irq(). You can also connect to another
'        terminal to test Irq function:
'          a.Sending some data to gerenate 'Rx event'(sio_cnt_irq);
'          b.Changing modem line(DTR/RTS) to generate
'            'modem line changed event'(sio_modem_irq);
'          c.Sending break signal to generate 'break event'
'            (sio_break_irq);
'          d.Typing 'A' will generate 'RxFlag event'(sio_term_irq)
'            and 'Rx event'(sio_cnt_irq);
'        This program  will got evnet and show Irq count to screen.
'      3.Select "Close" menu item to close com port.
'
'
'    This program demo:
'        How to use Irq function(sio_xxx_irq);
'        How to disable Irq function;
'        How to use Irq callback funtion.
'
'    Use function:
'        sio_open,       sio_close,      sio_ioctl,
'        sio_flowctrl,   sio_DTR,        sio_RTS,
'        sio_putch,      sio_write,
'        sio_SetWriteTimeouts,
'
'        sio_term_irq,   sio_cnt_irq,    sio_break_irq,
'        sio_modem_irq,  sio_Tx_empty_irq.
'
'
'    History:   Date       Author         Comment
'               6/1/98     Casper         Wrote it.
'               12/08/98   Casper         Add timer.
'***********************************************************************)

Option Explicit

Public GbOpen As Boolean
Public GszAppName As String

Dim Ldx As Long
Dim Ldy As Long

Private Sub cmClear_Click()
    Term.Text = ""
End Sub

Private Sub Form_Load()
    With GCommData
        .Port = 1
        .BaudRate = B38400
        .Parity = P_NONE
        .ByteSize = BIT_8
        .StopBits = STOP_1
        .ibaudrate = 14
        .iparity = 0
        .ibytesize = 3
        .istopbits = 0
        .Hw = 0
        .Sw = 0
        .Dtr = 1
        .Rts = 1
    End With
    
    Ldx = Width - Term.Width
    Ldy = Height - Term.Height
    GhExit = False
    GbOpen = False
    Set GhForm = IrqDemo
    GszAppName = "Irq Function Demo"
    Call InitTable
    Call SwitchMenu
End Sub

Private Sub Form_Resize()
    If WindowState <> vbMinimized Then
        Term.Width = Width - Ldx
        Term.Height = Height - Ldy
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If GbOpen Then
        Call ClosePort
    End If
End Sub

Private Sub cmOpen_Click()
    Call OpenPort
End Sub

Private Sub cmClose_Click()
    Call ClosePort
End Sub

Private Sub cmSetting_Click()
Dim bakdata As COMMDATA

    bakdata = GCommData
    Config.Show vbModal
    If (GbOpen) Then
        If (PortSet() = False) Then
            GCommData = bakdata
            Exit Sub
        End If
    End If
    Call ShowStatus
End Sub

Private Sub cmAbout_Click()
    About.AboutTxt1.Caption = "PComm Irq Function Demo Example"
    About.Show
End Sub

Private Sub cmExit_Click()
    If GbOpen Then
        Call ClosePort
    End If
    Unload IrqDemo
    End
End Sub

Sub SwitchMenu()
    cmOpen.Enabled = Not GbOpen
    cmClose.Enabled = GbOpen
End Sub

Private Sub Term_KeyPress(KeyAscii As Integer)
    If GbOpen Then
       ' Send the keystroke to the port.
       Call sio_putch(GCommData.Port, KeyAscii)
       KeyAscii = 0
    End If
End Sub

Private Function OpenPort() As Boolean
Dim ret As Long
Dim syserr As Long
    
    OpenPort = False
    
    ret = sio_open(GCommData.Port)
    If ret <> SIO_OK Then
        Call MxShowError("sio_open", ret, GetLastError())
        sio_close (GCommData.Port)
        Exit Function
    End If
    
    If PortSet() = False Then
        sio_close (GCommData.Port)
        Exit Function
    End If
    
    If InitIrq(GCommData.Port, Asc("A")) = False Then
        sio_close (GCommData.Port)
        Exit Function
    End If
    OpenPort = True
    GbOpen = True
    Term.Text = ""
    Call SwitchMenu
    Call ShowStatus
End Function

Private Function ClosePort()
    GhExit = False
    Call ClearIrq(GCommData.Port)
    sio_close (GCommData.Port)
    GbOpen = False
    Call SwitchMenu
    Call ShowStatus
End Function

Private Function PortSet() As Boolean
Dim Port As Long
Dim mode As Long
Dim Hw  As Long, Sw As Long
Dim ret As Long
Dim tout As Long

    Port = GCommData.Port
    mode = GCommData.Parity Or GCommData.ByteSize Or GCommData.StopBits
    If GCommData.Hw = 1 Then
        Hw = 3      'bit0 and bit1
    Else
        Hw = 0
    End If
    If GCommData.Sw = 1 Then
        Sw = 12     'bit2 and bit3
    Else
        Sw = 0
    End If
    
    PortSet = False
    
    ret = sio_DTR(Port, GCommData.Dtr)
    If ret <> SIO_OK Then
        Call MxShowError("sio_DTR", ret, GetLastError())
        Exit Function
    End If

    ret = sio_ioctl(Port, GCommData.BaudRate, mode)
    If ret <> SIO_OK Then
        Call MxShowError("sio_ioctl", ret, GetLastError())
        Exit Function
    End If

    ret = sio_flowctrl(Port, Hw Or Sw)
    If ret <> SIO_OK Then
        Call MxShowError("sio_flowctrl", ret, GetLastError())
        Exit Function
    End If

    If GCommData.Hw = 0 Then
        ret = sio_RTS(Port, GCommData.Rts)
        If ret <> SIO_OK Then
            Call MxShowError("sio_RTS", ret, GetLastError())
            Exit Function
        End If
    End If

    tout = 1000 / sio_getbaud(Port)  'ms /byte'
    If tout < 1 Then
        tout = 1
    End If
    tout = tout * 1 * 3             ' 1 byte; '*3' is for delay
    Call sio_SetWriteTimeouts(Port, tout)
    
    Call ShowStatus
    PortSet = True
End Function

Public Sub ShowStatus()
Dim szMessage As String

    szMessage = GszAppName
    
    If GbOpen Then
        szMessage = szMessage & " -- COM" & GCommData.Port & ","
        szMessage = szMessage & _
                GstrBaudTable(GCommData.ibaudrate) & ","
        szMessage = szMessage & _
                GstrParityTable(GCommData.iparity) & ","
        szMessage = szMessage & _
                GstrByteSizeTable(GCommData.ibytesize) & ","
        szMessage = szMessage & _
                GstrStopBitsTable(GCommData.istopbits)
        
        If GCommData.Hw = 1 Then
            szMessage = szMessage & ",RTS/CTS"
        End If

        If GCommData.Sw = 1 Then
           szMessage = szMessage & ",XON/XOFF"
        End If
        Unload Config
    End If
    Caption = szMessage
End Sub

Private Function InitIrq(Port As Long, termcode As Integer) As Boolean
Dim ret As Long
    InitIrq = False
    
    GIdx = 0
    GTermIrqCnt = 0
    GCntIrqCnt = 0
    GModemIrqCnt = 0
    GBreakIrqCnt = 0
    GTxEmptyIrqCnt = 0
    
    ret = sio_term_irq(Port, AddressOf TermIrq, termcode)
    If ret <> SIO_OK Then
        Call MxShowError("sio_term_irq", ret, GetLastError())
        Exit Function
    End If
    ret = sio_cnt_irq(Port, AddressOf CntIrq, 1)
    If ret <> SIO_OK Then
        Call MxShowError("sio_cnt_irq", ret, GetLastError())
        Exit Function
    End If
    ret = sio_break_irq(Port, AddressOf BreakIrq)
    If ret <> SIO_OK Then
        Call MxShowError("sio_break_irq", ret, GetLastError())
        Exit Function
    End If
    ret = sio_modem_irq(Port, AddressOf ModemIrq)
    If ret <> SIO_OK Then
        Call MxShowError("sio_modem_irq", ret, GetLastError())
        Exit Function
    End If
    ret = sio_Tx_empty_irq(Port, AddressOf TxEmptyIrq)
    If ret <> SIO_OK Then
        Call MxShowError("sio_Tx_empty_irq", ret, GetLastError())
        Exit Function
    End If
    
    InitIrq = True
    
End Function

Private Sub ClearIrq(Port As Long)
Dim ret As Long
    Call sio_term_irq(Port, 0, 0)
    Call sio_cnt_irq(Port, 0, 0)
    Call sio_modem_irq(Port, 0)
    Call sio_break_irq(Port, 0)
    Call sio_Tx_empty_irq(Port, 0)
End Sub

Public Sub ShowCnt(cnt As Long, title As String)
Dim buf As String
Dim lend As Long
    
    lend = LenB(Term.Text)
    
    If lend >= 16384 Then
        Term.Text = Mid$(Term.Text, 4097)
        lend = LenB(Term.Text)
    End If
    
    GIdx = GIdx + 1
    Term.SelStart = lend
    Term.SelLength = 0
    buf = "(idx=" & GIdx & ")" & title & "count=" & cnt & Chr(13) & Chr(10)
    Term.SelText = buf
End Sub

Private Sub Timer1_Timer()
Dim buf(0 To 127) As Byte
Dim rlen As Long
Dim cnt As Long

    ' Read the dummy data to free the input buffer
    cnt = 0
    Do
        rlen = sio_read(GCommData.Port, buf(0), 128)
        cnt = cnt + 1
    Loop Until rlen = 0 Or cnt > 10

End Sub