CD Shareware Magazine 1996 December/CD_shareware_12-96.iso/WIN/Programa/WSC4VB10.ZIP/RS232.FRM

Visual Basic Form | 1996-08-25 | 12.8 KB | 522 lines

VERSION 2.00
Begin Form RS232
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Double
   Caption         =   "RS232"
   ClientHeight    =   5595
   ClientLeft      =   2520
   ClientTop       =   3930
   ClientWidth     =   8565
   FontBold        =   0   'False
   FontItalic      =   0   'False
   FontName        =   "Courier New"
   FontSize        =   8.25
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   6285
   Left            =   2460
   LinkTopic       =   "Form1"
   ScaleHeight     =   5595
   ScaleWidth      =   8565
   Top             =   3300
   Width           =   8685
   Begin Timer Timer1
      Interval        =   125
      Left            =   360
      Top             =   240
   End
   Begin Menu menuLine
      Caption         =   "Line"
      Begin Menu menuExit
         Caption         =   "Exit"
      End
      Begin Menu menuOnLine
         Caption         =   "OnLine"
      End
      Begin Menu menuOffLine
         Caption         =   "OffLine"
         Enabled         =   0   'False
      End
   End
   Begin Menu menuChange
      Caption         =   "Change"
      Begin Menu menuPort
         Caption         =   "Port"
         Begin Menu menuCOM1
            Caption         =   "COM1"
            Checked         =   -1  'True
         End
         Begin Menu menuCOM2
            Caption         =   "COM2"
         End
         Begin Menu menuCOM3
            Caption         =   "COM3"
         End
         Begin Menu menuCOM4
            Caption         =   "COM4"
         End
      End
      Begin Menu menuBaud
         Caption         =   "Baud"
         Begin Menu menu110
            Caption         =   "110"
         End
         Begin Menu menu300
            Caption         =   "300"
         End
         Begin Menu menu1200
            Caption         =   "1200"
         End
         Begin Menu menu2400
            Caption         =   "2400"
         End
         Begin Menu menu4800
            Caption         =   "4800"
         End
         Begin Menu menu9600
            Caption         =   "9600"
         End
         Begin Menu menu19200
            Caption         =   "19200"
            Checked         =   -1  'True
         End
         Begin Menu menu38400
            Caption         =   "38400"
         End
         Begin Menu menu57600
            Caption         =   "57600"
         End
      End
      Begin Menu menuParity
         Caption         =   "Parity"
         Begin Menu menuNone
            Caption         =   "None"
            Checked         =   -1  'True
         End
         Begin Menu menuEven
            Caption         =   "Even"
         End
         Begin Menu menuOdd
            Caption         =   "Odd"
         End
      End
      Begin Menu menuDataBits
         Caption         =   "DataBits"
         Begin Menu menuSeven
            Caption         =   "Seven"
         End
         Begin Menu menuEight
            Caption         =   "Eight"
            Checked         =   -1  'True
         End
      End
      Begin Menu menuStopBits
         Caption         =   "StopBits"
         Begin Menu menuOne
            Caption         =   "One"
            Checked         =   -1  'True
         End
         Begin Menu menuTwo
            Caption         =   "Two"
         End
      End
   End
   Begin Menu menuStatus
      Caption         =   "Status"
      Enabled         =   0   'False
   End
   Begin Menu menuControl
      Caption         =   "Control"
      Enabled         =   0   'False
      Begin Menu menuDTR
         Caption         =   "DTR"
         Begin Menu menuSetDTR
            Caption         =   "Set"
            Checked         =   -1  'True
            Enabled         =   0   'False
         End
         Begin Menu menuClearDTR
            Caption         =   "Clear"
         End
      End
      Begin Menu menuRTS
         Caption         =   "RTS"
         Begin Menu menuSetRTS
            Caption         =   "Set"
            Checked         =   -1  'True
            Enabled         =   0   'False
         End
         Begin Menu menuClearRTS
            Caption         =   "Clear"
         End
      End
   End
   Begin Menu menuFlow
      Caption         =   "Flow_Control"
      Enabled         =   0   'False
      Begin Menu menuHardware
         Caption         =   "Hardware"
      End
      Begin Menu menuSoftware
         Caption         =   "Software"
      End
      Begin Menu menuNoFlow
         Caption         =   "NONE"
         Checked         =   -1  'True
      End
   End
   Begin Menu menuDebug
      Caption         =   "DEBUG"
   End
' RS232.BAS
Option Explicit
Sub Form_KeyPress (KeyAscii As Integer)
    Dim Code As Integer
    '''RS232.Print "["; Hex$(KeyAscii); "]";
    If KeyAscii <> 10 Then
      Code = SioPutc(ThePort, KeyAscii)
    End If
End Sub
Sub Form_Load ()
    Dim Row As Integer
    DataFlag = 0
    ParityText(0) = "N"
    ParityText(1) = "O"
    ParityText(2) = "E"
    ParityText(3) = "M"
    ParityText(4) = "S"
    BaudRateTable(0) = "110"
    BaudRateTable(1) = "300"
    BaudRateTable(2) = "1200"
    BaudRateTable(3) = "2400"
    BaudRateTable(4) = "4800"
    BaudRateTable(5) = "9600"
    BaudRateTable(6) = "19200"
    BaudRateTable(7) = "38400"
    BaudRateTable(8) = "57600"
    FatalFlag = 0
    ThePort = COM1
    TheBaudCode = Baud19200
    TheDataBits = WordLength8
    TheStopBits = OneStopBit
    TheParity = NoParity
    CurrentCol = 0
    CurrentRow = 0
    OnLineFlag = 0
    For Row = 0 To 23
      ScreenBuffer(Row) = Space$(80)
    Next Row
    RS232.Cls
    Call ShowConfig
End Sub
Sub menu110_Click ()
  Call UncheckBaudRate
  menu110.Checked = True
  TheBaudCode = Baud110
  Call SetBaud
  Call ShowConfig
End Sub
Sub menu1200_Click ()
  Call UncheckBaudRate
  menu1200.Checked = True
  TheBaudCode = Baud1200
  Call SetBaud
  Call ShowConfig
End Sub
Sub menu19200_Click ()
  Call UncheckBaudRate
  menu19200.Checked = True
  TheBaudCode = Baud19200
  Call SetBaud
  Call ShowConfig
End Sub
Sub menu2400_Click ()
  Call UncheckBaudRate
  menu2400.Checked = True
  TheBaudCode = Baud2400
  Call SetBaud
  Call ShowConfig
End Sub
Sub menu300_Click ()
  Call UncheckBaudRate
  menu300.Checked = True
  TheBaudCode = Baud300
  Call SetBaud
  Call ShowConfig
End Sub
Sub menu38400_Click ()
  Call UncheckBaudRate
  menu38400.Checked = True
  TheBaudCode = Baud38400
  Call SetBaud
  Call ShowConfig
End Sub
Sub menu4800_Click ()
  Call UncheckBaudRate
  menu4800.Checked = True
  TheBaudCode = Baud4800
  Call SetBaud
  Call ShowConfig
End Sub
Sub menu57600_Click ()
  Call UncheckBaudRate
  menu57600.Checked = True
  TheBaudCode = Baud57600
  Call SetBaud
  Call ShowConfig
End Sub
Sub menu9600_Click ()
  Call UncheckBaudRate
  menu9600.Checked = True
  TheBaudCode = Baud9600
  Call SetBaud
  Call ShowConfig
End Sub
Sub menuClearDTR_Click ()
  Dim Code As Integer
  'clear DTR
  Code = SioDTR(ThePort, Asc("C"))
  menuSetDTR.Checked = False
  menuClearDTR.Checked = True
  menuSetDTR.Enabled = True
  menuClearDTR.Enabled = False
End Sub
Sub menuClearRTS_Click ()
  Dim Code As Integer
  'clear RTS
  Code = SioRTS(ThePort, Asc("C"))
  menuSetRTS.Checked = False
  menuClearRTS.Checked = True
  menuSetRTS.Enabled = True
  menuClearRTS.Enabled = False
End Sub
Sub menuCOM1_Click ()
  Call UncheckComPorts
  menuCOM1.Checked = True
  ThePort = COM1
  Call ShowConfig
End Sub
Sub menuCOM2_Click ()
  Call UncheckComPorts
  menuCOM2.Checked = True
  ThePort = COM2
  Call ShowConfig
End Sub
Sub menuCOM3_Click ()
  Call UncheckComPorts
  menuCOM3.Checked = True
  ThePort = COM3
  Call ShowConfig
End Sub
Sub menuCOM4_Click ()
  Call UncheckComPorts
  menuCOM4.Checked = True
  ThePort = COM4
  Call ShowConfig
End Sub
Sub menuData_Click ()
DataFlag = 1 - DataFlag
End Sub
Sub menuDebug_Click ()
Dim I, Code As Integer
Dim S As String
'send alphabet 10 times
S = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Chr$(13) + Chr$(10)
For I = 1 To 10
  Code = SioPuts(ThePort, S, 28)
Next I
End Sub
Sub menuEight_Click ()
  Call UncheckDataBits
  menuEight.Checked = True
  TheDataBits = WordLength8
  Call ShowConfig
End Sub
Sub menuEven_Click ()
  Call UncheckParity
  menuEven.Checked = True
  TheParity = EvenParity
  Call ShowConfig
End Sub
Sub menuExit_Click ()
  Call GoOffLine
  End
End Sub
Sub menuHardware_Click ()
Dim Code As Integer
Code = SioFlow(ThePort, Asc("H"))
Call DisplayString("[Hardware flow control enabled]")
menuHardware.Checked = True
menuSoftware.Checked = False
menuNoflow.Checked = False
End Sub
Sub menuNoFlow_Click ()
Dim Code As Integer
Code = SioFlow(ThePort, Asc("N"))
Call DisplayString("[Flow control disabled]")
menuHardware.Checked = False
menuSoftware.Checked = False
menuNoflow.Checked = True
End Sub
Sub menuNone_Click ()
  Call UncheckParity
  menuNone.Checked = True
  TheParity = NoParity
  Call ShowConfig
End Sub
Sub menuOdd_Click ()
  Call UncheckDataBits
  menuOdd.Checked = True
  TheParity = OddParity
  Call ShowConfig
End Sub
Sub menuOffLine_Click ()
  '''menuChange.Enabled = True
  menuOffline.Enabled = False
  menuOnline.Enabled = True
  Call GoOffLine
  Call ShowConfig
End Sub
Sub menuOne_Click ()
  Call UncheckStopBits
  menuOne.Checked = True
  TheStopBits = OneStopBit
  Call ShowConfig
End Sub
Sub menuOnLine_Click ()
  CurrentRow = 0
  CurrentCol = 0
  RS232.Cls
  menuOffline.Enabled = True
  menuOnline.Enabled = False
  '''menuChange.Enabled = False
  Call GoOnLine
  Call ShowConfig
End Sub
Sub menuSet_Click ()
End Sub
Sub menuSetDTR_Click ()
  Dim Code As Integer
  If OnLineFlag = 0 Then
    Call DisplayString("[Not online!]")
    Exit Sub
  End If
  'set DTR
  Code = SioDTR(ThePort, Asc("S"))
  menuSetDTR.Checked = True
  menuClearDTR.Checked = False
  menuSetDTR.Enabled = False
  menuClearDTR.Enabled = True
End Sub
Sub menuSetRTS_Click ()
  Dim Code As Integer
  'set DTR
  Code = SioRTS(ThePort, Asc("S"))
  menuSetRTS.Checked = True
  menuClearRTS.Checked = False
  menuSetRTS.Enabled = False
  menuClearRTS.Enabled = True
End Sub
Sub menuSeven_Click ()
  Call UncheckDataBits
  menuSeven.Checked = True
  TheDataBits = WordLength7
  Call ShowConfig
End Sub
Sub menuSoftware_Click ()
Dim Code As Integer
Code = SioFlow(ThePort, Asc("S"))
Call DisplayString("[Software flow control enabled]")
menuHardware.Checked = False
menuSoftware.Checked = True
menuNoflow.Checked = False
End Sub
Sub menuStatus_Click ()
Dim S As String
Dim N As Integer
N = SioStatus(ThePort, &HFFFF)
'framing error ?
If (WSC_FRAME And N) > 0 Then
  Call DisplayString("[Framing error]")
End If
'overrun error ?
If (WSC_OVERRUN And N) > 0 Then
  Call DisplayString("[Data overrun error]")
End If
'parity error ?
If (WSC_PARITY And N) > 0 Then
  Call DisplayString("[Data parity error]")
End If
'RX overflow
If (WSC_RXOVER And N) > 0 Then
  Call DisplayString("[Receive queue overflow]")
End If
'TX overflow
If (WSC_TXFULL And N) > 0 Then
  Call DisplayString("[Transmit queue overflow]")
End If
'Show TX & RX queue sizes
S = "[RX queue size =" + Str$(SioRxQue(ThePort))
S = S + ", TX queue size =" + Str$(SioTxQue(ThePort)) + "]"
Call DisplayString(S)
'BREAK signal status
If SioBrkSig(ThePort, Asc("D")) > 0 Then
  Call DisplayString("[BREAK detected]")
End If
'DSR status
If SioDSR(ThePort) > 0 Then
  Call DisplayString("[DSR state changed]")
End If
'CTS status
If SioCTS(ThePort) > 0 Then
  Call DisplayString("[CTS state changed]")
End If
End Sub
Sub menuTwo_Click ()
  Call UncheckStopBits
  menuTwo.Checked = True
  TheStopBits = TwoStopBits
  Call ShowConfig
End Sub
Sub Timer1_Timer ()
  If OnLineFlag Then
    'get incoming serial data
    Call GetIncoming
  End If
End Sub
Sub UncheckBaudRate ()
'uncheck all baud rates
menu110.Checked = False
menu300.Checked = False
menu1200.Checked = False
menu2400.Checked = False
menu4800.Checked = False
menu9600.Checked = False
menu19200.Checked = False
menu38400.Checked = False
menu57600.Checked = False
End Sub
Sub UncheckComPorts ()
'uncheck all COM ports
menuCOM1.Checked = False
menuCOM2.Checked = False
menuCOM3.Checked = False
menuCOM4.Checked = False
End Sub
Sub UncheckDataBits ()
'uncheck data bits
menuSeven.Checked = False
menuEight.Checked = False
End Sub
Sub UncheckParity ()
'uncheck parity
menuOdd.Checked = False
menuEven.Checked = False
menuTwo.Checked = False
End Sub
Sub UncheckStopBits ()
'uncheck stop bits
menuOne.Checked = False
menuNone.Checked = False
End Sub