2013-06-19 07:52

     $APPTYPE GUI
     $TYPECHECK ON
     $OPTIMIZE ON
     $INCLUDE "RAPIDQ.INC"
     $INCLUDE "COMPORT.CMP"

     DECLARE SUB OpenClick
     DECLARE SUB SendClick
     DECLARE SUB ComError(strErrorMessage AS STRING)
     DECLARE SUB PortOpen
     DECLARE SUB PortClosed
     DECLARE SUB StringWritten
     DECLARE SUB StringRead

     DIM strPort   AS STRING
     DIM dwBaud    AS DWORD
     DIM bParity   AS BYTE
     DIM bDataBits AS BYTE
     DIM bStopBits AS BYTE

     DIM MyPort AS COMPORT
     MyPort.OnComError     = ComError
     MyPort.OnOpen         = PortOpen
     MyPort.OnClose        = PortClosed
     MyPort.OnWriteString  = StringWritten
     MyPort.OnReadString   = StringRead

     DIM Font AS QFONT
     Font.Name="Courier New"

     CREATE Form AS QFORM
      CAPTION = "Form1"
      Width   = 820
      Height  = 355
      Center
      CREATE lblPort AS QLABEL
       Left    = 10
       Width   = 100
       Top     = 5
       CAPTION = "COM Port"
      END CREATE
      CREATE lblBaud AS QLABEL
       Left    = 10
       Width   = 100
       Top     = 30
       CAPTION = "Bits per second"
      END CREATE
      CREATE lblParity AS QLABEL
       Left    = 10
       Width   = 100
       Top     = 55
       CAPTION = "Parity"
      END CREATE
      CREATE lblDataBits AS QLABEL
       Left    = 10
       Width   = 100
       Top     = 80
       CAPTION = "Data bits"
      END CREATE
      CREATE lblStopBits AS QLABEL
       Left    = 10
       Width   = 100
       Top     = 105
       CAPTION = "Stop Bits"
      END CREATE
      CREATE lblSend AS QLABEL
       Left    = 10
       Width   = 100
       Top     = 130
       CAPTION = "String to Send"
      END CREATE
      CREATE cbPort AS QCOMBOBOX
       AddItems "COM1", _
        "COM2", _
        "COM3", _
        "COM4"
       Left      = 120
       Width     = 70
       Top       = 5
       ItemIndex = 0
      END CREATE
      CREATE cbBaud AS QCOMBOBOX
       AddItems "110", _
        "300", _
        "600", _
        "1200", _
        "2400", _
        "4800", _
        "9600", _
        "14400", _
        "19200", _
        "38400", _
        "56000", _
        "57600", _
        "115200"
       Left      = 120
       Width     = 70
       Top       = 30
       ItemIndex = 6
      END CREATE
      CREATE cbParity AS QCOMBOBOX
       AddItems  "None", _
        "Odd", _
        "Even", _
        "Mark", _
        "Space"
       Left      = 120
       Width     = 70
       Top       = 55
       ItemIndex = 0
      END CREATE
      CREATE cbDataBits AS QCOMBOBOX
       AddItems  "4", _
        "5", _
        "6", _
        "7", _
        "8"
       Left      = 120
       Width     = 70
       Top       = 80
       ItemIndex = 4
      END CREATE
      CREATE cbStopBits AS QCOMBOBOX
       AddItems "1", _
        "1.5", _
        "2"
       Left      = 120
       Width     = 70
       Top       = 105
       ItemIndex = 0
      END CREATE
      CREATE Edit1 AS QEDIT
       Text  = ""
       Left  = 120
       Top   = 130
       Width = 200
      END CREATE
      CREATE RichEdit1 AS QRICHEDIT
       Left        = 10
       Top         = 160
       Width       = 795
       Height      = 130
       PlainText   = 1
       ReadOnly    = 1
       ScrollBars  = 3
       WordWrap    = 0
       Font        = Font
      END CREATE
      CREATE StatusBar AS QSTATUSBAR
       Left      = 10
       Top       = 300
       Width     = 795
       Height    = 20
       SizeGrip  = FALSE
       AddPanels "Panel 1", "Panel 2"
       Panel(0).CAPTION = "Not Connected"
       Panel(0).Width = 645
       Panel(1).CAPTION = ""
      END CREATE
      CREATE OpenButton AS QBUTTON
       CAPTION = "&Open Port"
       Left    = 330
       Top     = 5
       Height  = 20
       OnClick = OpenClick
      END CREATE
      CREATE SendButton AS QBUTTON
       CAPTION = "&Send"
       Left    = 330
       Top     = 130
       Height  = 20
       Enabled = 0
       OnClick = SendClick
      END CREATE

     END CREATE

     SUB OpenClick

      SELECT CASE cbPort.ItemIndex
      CASE 0
       strPort = "COM1"
      CASE 1
       strPort = "COM2"
      CASE 2
       strPort = "COM3"
      CASE 3
       strPort = "COM4"
      END SELECT

      SELECT CASE cbBaud.ItemIndex
      CASE 0
       dwBaud = 110
      CASE 1
       dwBaud = 300
      CASE 2
       dwBaud = 600
      CASE 3
       dwBaud = 1200
      CASE 4
       dwBaud = 2400
      CASE 5
       dwBaud = 4800
      CASE 6
       dwBaud = 9600
      CASE 7
       dwBaud = 14400
      CASE 8
       dwBaud = 19200
      CASE 9
       dwBaud = 38400
      CASE 10
       dwBaud = 56000
      CASE 11
       dwBaud = 57600
      CASE 12
       dwBaud = 115200
      END SELECT

      SELECT CASE cbParity.ItemIndex
      CASE 0
       bParity = NOPARITY
      CASE 1
       bParity = ODDPARITY
      CASE 2
       bParity = EVENPARITY
      CASE 3
       bParity = MARKPARITY
      CASE 4
       bParity = SPACEPARITY
      END SELECT

      SELECT CASE cbDataBits.ItemIndex
      CASE 0
       bDataBits = 4
      CASE 1
       bDataBits = 5
      CASE 2
       bDataBits = 6
      CASE 3
       bDataBits = 7
      CASE 4
       bDataBits = 8
      END SELECT

      SELECT CASE cbStopBits.ItemIndex
      CASE 0
       bStopBits = ONESTOPBIT
      CASE 1
       bStopBits = ONE5STOPBITS
      CASE 2
       bStopBits = TWOSTOPBITS
      END SELECT

'Settings
      MyPort.Port     = strPort
      MyPort.BaudRate = dwBaud
      MyPort.Parity   = bParity
      MyPort.DataBits = bDataBits
      MyPort.StopBits = bStopBits

'Open COM Port
      MyPort.OPEN

      IF MyPort.Connected=TRUE THEN
       OpenButton.Enabled = 0
       SendButton.Enabled = 1
      END IF

     END SUB

     SUB SendClick
      DIM BytesRead AS DWORD

      IF Edit1.Text="" THEN
       SHOWMESSAGE "Please enter String to Send"
      ELSE
    'Write to COM Port
       MyPort.WriteString(Edit1.Text + CHR$(13) +CHR$(10), 1000)
       Edit1.Text=""

       WHILE MyPort.BytesNotRead > 0
        RichEdit1.Text=RichEdit1.Text & MyPort.ReadString(MyPort.BytesNotRead, 500)
        BytesRead=MyPort.BytesNotRead + BytesRead
        StatusBar.Panel(1).CAPTION = "Number of Bytes Read  " & STR$(BytesRead)
       WEND

    'Close the Port
       MyPort.CLOSE
      END IF

     END SUB

     SUB ComError (strErrorMessage AS STRING)
      SHOWMESSAGE strErrorMessage
     END SUB

     SUB PortOpen
      StatusBar.Panel(0).CAPTION = "Connected to " & MyPort.Port
     END SUB

     SUB PortClosed
      StatusBar.Panel(0).CAPTION = "Not Connected"
      OpenButton.Enabled = 1
      SendButton.Enabled = 0
     END SUB

     SUB StringWritten
'  SHOWMESSAGE "String was written"
     END SUB

     SUB StringRead
'  SHOWMESSAGE "String was read"
     END SUB
     Form.SHOWMODAL

2013-06-19 07:52