PureBoard

Code:
; PureBasic SerialPort Library Demonstration
; Based on the demo Code by Marc Vitry and its MVCOM Library
; To sue this software connect a loop back connector to the tested serial port
; Or connect 2 PC with a serial cable and run this software on the 2 PC

; SerialPortError() results

;http://www.purebasic.fr/english/viewtopic.php?p=218644#p218644
; changed by Falko

#PB_SerialPort_RxOver       = (1 << 0)
#PB_SerialPort_OverRun      = (1 << 1)
#PB_SerialPort_RxParity     = (1 << 2)
#PB_SerialPort_Frame        = (1 << 3)
#PB_SerialPort_Break        = (1 << 4)
#PB_SerialPort_TxFull       = (1 << 5)
#PB_SerialPort_IOE          = (1 << 6)
#PB_SerialPort_WaitingCTS   = (1 << 7)
#PB_SerialPort_WaitingDSR   = (1 << 8)
#PB_SerialPort_WaitingRLSD  = (1 << 9)
#PB_SerialPort_XoffReceived = (1 << 10)
#PB_SerialPort_XoffSent     = (1 << 11)
#PB_SerialPort_EOFSent      = (1 << 12)

; For OpenSerialPort 'Parity' parameter
#PB_SerialPort_NoParity    = #NOPARITY
#PB_SerialPort_EvenParity  = #EVENPARITY
#PB_SerialPort_MarkParity  = #MARKPARITY   
#PB_SerialPort_OddParity   = #ODDPARITY
#PB_SerialPort_SpaceParity = #SPACEPARITY

; For the SetAttribute only
#PB_SerialPort_DTR = 1
#PB_SerialPort_RTS = 2
#PB_SerialPort_TXD = 3

; For the GetAttribute only
#PB_SerialPort_RI  = 4
#PB_SerialPort_DCD = 5
#PB_SerialPort_DSR = 6
#PB_SerialPort_CTS = 7

; For Get/SetAttribute
#PB_SerialPort_XonCharacter  = 8
#PB_SerialPort_XoffCharacter = 9

; For OpenSerialPort 'Handshake' parameter

#PB_SerialPort_NoHandshake = #HandShakeModeNone
#PB_SerialPort_RtsEnable   = #HandShakeModeRtsEnable
#PB_SerialPort_RtsCts      = #HandShakeModeRtsCts
#PB_SerialPort_XonXoff     = #HandShakeModeXonXoff

; For the stop bit: can be 0,1 or 2 with the following limitations:
; "The use of 5 data bits with 2 stop bits is an invalid combination, as is 6, 7, or 8 data bits with 1.5 stop bits."

;Windows
Enumeration
  #Window_0
EndEnumeration

;Gadgets
Enumeration
  #Text01
  #Label01
  #Key_Quit
  #Key_SR
  #Key_RTSON
  #Key_RTSOFF
  #Key_DTRON
  #Key_DTROFF
  #Key06
  #Key07
  #Key08
  #Key09
  #ListBaud
  #ListData
  #ListStopbits
  #ListParity
  #ListHandshake
  #ListPorts
  #Gadget_50
  #Gadget_51
  #Gadget_54
  #Gadget_55
  #Gadget_56
  #Gadget_57
  #Gadget_58
  #Gadget_59
  #Gadget_60
  #Gadget_61
  #Gadget_62
  #Gadget_63
  #Gadget_64
  #Gadget_65
  #Gadget_66
  #Gadget_67
  #Gadget_68
  #Gadget_Xon
  #Gadget_Xoff
EndEnumeration

;Menu
Enumeration
  #Menu_Return
EndEnumeration

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 0, 0, 370, 310, "PureBasic Serial Demonstration", #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
    ;If CreateGadgetList(WindowID(#Window_0))
      StringGadget(#Text01, 50, 10, 310, 20, "")
      ComboBoxGadget(#ListPorts, 10, 140, 70, 80)
      ComboBoxGadget(#ListBaud, 130, 140, 100, 80)
      ComboBoxGadget(#ListData, 130, 170, 100, 80)
      ComboBoxGadget(#ListStopbits, 130, 200, 100, 80)
      ComboBoxGadget(#ListParity, 130, 230, 100, 80)
      ComboBoxGadget(#ListHandshake, 130, 260, 100, 80)
      ButtonGadget(#Key_SR, 240, 70, 120, 30, "Send / Read Data")
      ButtonGadget(#Key_RTSON, 240, 100, 60, 30, "RTS ON")
      ButtonGadget(#Key_RTSOFF, 300, 100, 60, 30, "RTS OFF")
      ButtonGadget(#Key_DTRON, 240, 130, 60, 30, "DTR ON")
      ButtonGadget(#Key_DTROFF, 300, 130, 60, 30, "DTR OFF")
      ButtonGadget(#Key06, 240, 160, 60, 30, "TXD ON")
      ButtonGadget(#Key07, 300, 160, 60, 30, "TXD OFF")
      ButtonGadget(#Key08, 240, 190, 120, 30, "Open Com Port")
      ButtonGadget(#Key09, 240, 220, 120, 30, "Close Com Port")
      ButtonGadget(#Key_Quit, 240, 250, 120, 30, "Quit")
      TextGadget(#Label01, 50, 30, 310, 20, "", #PB_Text_Border)
      TextGadget(#Gadget_50, 10, 10, 40, 20, "TxD")
      TextGadget(#Gadget_51, 10, 30, 30, 20, "RxD")
      TextGadget(#Gadget_54, 120, 60, 70, 20, "RTS ------>CTS")
      TextGadget(#Gadget_55, 120, 80, 70, 20, "DTR ----->DSR")
      TextGadget(#Gadget_56, 160, 100, 30, 20, "DCD", #PB_Text_Right)
      TextGadget(#Gadget_57, 160, 120, 30, 20, "RI", #PB_Text_Right)
      TextGadget(#Gadget_58, 210, 60, 20, 18, "")
      TextGadget(#Gadget_59, 210, 80, 20, 18, "")
      TextGadget(#Gadget_60, 210, 100, 20, 18, "")
      TextGadget(#Gadget_61, 210, 120, 20, 18, "")
      TextGadget(#Gadget_62, 85, 140, 40, 20, "Speed", #PB_Text_Right)
      TextGadget(#Gadget_63, 85, 170, 40, 20, "Data", #PB_Text_Right)
      TextGadget(#Gadget_64, 85, 200, 40, 20, "Stopbits", #PB_Text_Right)
      TextGadget(#Gadget_65, 85, 230, 40, 20, "Parity", #PB_Text_Right)
      TextGadget(#Gadget_66, 55, 260, 70, 20, "Handshaking", #PB_Text_Right)
      TextGadget(#Gadget_67, 5, 290, 70, 20, "Xon character", #PB_Text_Right)
      TextGadget(#Gadget_68, 125, 290, 70, 20, "Xoff character", #PB_Text_Right)
      StringGadget(#Gadget_Xon, 80, 290, 30, 20, "17")
      StringGadget(#Gadget_Xoff, 200, 290, 30, 20, "19")
      AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #Menu_Return)
    ;EndIf
  EndIf
EndProcedure

Global ComBaud.l           ;Index of selected com baudrate
Global ComData.l           ;Index of selected data bit
Global ComStopbits.l       ;Index of selected stopbits
Global ComParity.l         ;Index of selected parity
Global ComHandshake.l      ;Index of selected handshake mode

Global Hcom.l               ;Communication Handle
Global ComPort.s            ;Communications Port
Global Baud.l               ;Baudrate
Global Parity.l             ;Parity
Global DataBits.l           ;DataBits
Global StopBits.l           ;StopBits
Global Handshake.l          ;Handshake
; -----------------------------------------------------------------------------------------------

Procedure Affiche01()
  SetGadgetState(#ListBaud,ComBaud)
  SetGadgetState(#ListData,ComData)
  SetGadgetState(#ListStopbits,ComStopbits)
  SetGadgetState(#ListParity,ComParity)
  SetGadgetState(#ListHandshake,ComHandshake)
  If CountGadgetItems(#ListPorts)
    SetGadgetState(#ListPorts,0)
  EndIf
EndProcedure

; ----------------------------------------------------------------------------
; Procedure:  Init01()
; Parameter:  No
; Action:     Init gadgets list and some variables
; Return:     
; ----------------------------------------------------------------------------
Procedure Init01()
  Boucle.l = 0
  Chaine.s = ""
  ClearGadgetItems(#ListBaud)
  AddGadgetItem(#ListBaud,-1,"75 Bauds")
  AddGadgetItem(#ListBaud,-1,"110 Bauds")
  AddGadgetItem(#ListBaud,-1,"134 Bauds")
  AddGadgetItem(#ListBaud,-1,"150 Bauds")
  AddGadgetItem(#ListBaud,-1,"300 Bauds")
  AddGadgetItem(#ListBaud,-1,"600 Bauds")
  AddGadgetItem(#ListBaud,-1,"1200 Bauds")
  AddGadgetItem(#ListBaud,-1,"1800 Bauds")
  AddGadgetItem(#ListBaud,-1,"2400 Bauds")
  AddGadgetItem(#ListBaud,-1,"4800 Bauds")
  AddGadgetItem(#ListBaud,-1,"7200 Bauds")
  AddGadgetItem(#ListBaud,-1,"9600 Bauds")
  AddGadgetItem(#ListBaud,-1,"14400 Bauds")
  AddGadgetItem(#ListBaud,-1,"19200 Bauds")
  AddGadgetItem(#ListBaud,-1,"38400 Bauds")
  AddGadgetItem(#ListBaud,-1,"57600 Bauds")
  AddGadgetItem(#ListBaud,-1,"115200 Bauds")
  AddGadgetItem(#ListBaud,-1,"128000 Bauds")
  AddGadgetItem(#ListBaud,-1,"250000 Bauds")
 
  ClearGadgetItems(#ListData)
  AddGadgetItem(#ListData,-1,"4 Bits")
  AddGadgetItem(#ListData,-1,"5 Bits")
  AddGadgetItem(#ListData,-1,"6 Bits")
  AddGadgetItem(#ListData,-1,"7 Bits")
  AddGadgetItem(#ListData,-1,"8 Bits")
 
  ClearGadgetItems(#ListStopbits)
  AddGadgetItem(#ListStopbits,-1,"1 Bits")
  AddGadgetItem(#ListStopbits,-1,"1.5 Bits")
  AddGadgetItem(#ListStopbits,-1,"2 Bits")
 
  ClearGadgetItems(#ListParity)
  AddGadgetItem(#ListParity,-1,"None")
  AddGadgetItem(#ListParity,-1,"Even")
  AddGadgetItem(#ListParity,-1,"Odd")
  AddGadgetItem(#ListParity,-1,"Space")
  AddGadgetItem(#ListParity,-1,"Mark")
 
  ClearGadgetItems(#ListHandshake)
  AddGadgetItem(#ListHandshake,-1,"None")
  AddGadgetItem(#ListHandshake,-1,"RTS Enable")
  AddGadgetItem(#ListHandshake,-1,"RTS / CTS")
  AddGadgetItem(#ListHandshake,-1,"Xon / Xoff")
 
  SetGadgetText(#Text01,"The quick brown fox jumps over the lazy dog!!!")
 
  ClearGadgetItems(#ListPorts)
  For Boucle = 1 To 255
    Chaine = "COM" + Str(Boucle)
    Hcom = OpenSerialPort(#PB_Any,Chaine,1200,0,8,0,0,1024,1024)
    If Hcom And IsSerialPort(hCom)
      AddGadgetItem(#ListPorts,-1,"COM" + Str(Boucle))
      If CloseSerialPort(Hcom)
        Hcom = 0
      EndIf
    EndIf
  Next
 
  Hcom = 0
  ComBaud = 11      ;9600 Bauds
  ComData = 4       ;8 Bits
  ComStopbits = 0   ;1 Stopbit
  ComParity = 0     ;None
  ComHandshake = 0  ;None
 
  Affiche01()
EndProcedure

; ----------------------------------------------------------------------------
; Procedure:  GetComDescription()
; Parameter:  No
; Action:     Create the Communication Description string (Ex: COM1:9600,N,8,1)
; Return:     String
; ----------------------------------------------------------------------------
Procedure GetComDescription()
  ComPort = GetGadgetText(#ListPorts)
 
  Select GetGadgetState(#ListBaud)
    Case 0
      Baud = 75
    Case 1
      Baud = 110
    Case 2
      Baud = 134
    Case 3
      Baud = 150
    Case 4
      Baud = 300
    Case 5
      Baud = 600
    Case 6
      Baud = 1200
    Case 7
      Baud = 1800
    Case 8
      Baud = 2400
    Case 9
      Baud = 4800
    Case 10
      Baud = 7200
    Case 11
      Baud = 9600
    Case 12
      Baud = 14400
    Case 13
      Baud = 19200
    Case 14
      Baud = 38400
    Case 15
      Baud = 57600
    Case 16
      Baud = 115200
    Case 17
      Baud = 128000
    Case 18
      Baud = 250000
  EndSelect
 
  Select GetGadgetState(#ListParity)
    Case 0 ; None
      Parity = #PB_SerialPort_NoParity
    Case 1 ; Even
      Parity = #PB_SerialPort_EvenParity
    Case 2 ; Odd
      Parity = #PB_SerialPort_OddParity
    Case 3 ; Space
      Parity = #PB_SerialPort_SpaceParity
    Case 4 ; Mark
      Parity = #PB_SerialPort_MarkParity
  EndSelect

  Select GetGadgetState(#ListData)
    Case 0 ; DateBits=4
      DataBits = 4
    Case 1 ; DateBits=5
      DataBits = 5
    Case 2 ; DateBits=6
      DataBits = 6
    Case 3 ; DateBits=7
      DataBits = 7
    Case 4 ; DateBits=8
      DataBits = 8
  EndSelect
 
  Select GetGadgetState(#ListStopbits)
    Case 0 ; 1
      StopBits = 0
    Case 1 ; 1.5
      StopBits = 1
    Case 2 ; 2
      StopBits = 2
  EndSelect
 
  Select GetGadgetState(#ListHandshake)
    Case 0 ; None
      Handshake = #PB_SerialPort_NoHandshake
    Case 1 ; RTS Enable
      Handshake = #PB_SerialPort_RtsEnable
    Case 2 ; RTS / CTS
      Handshake = #PB_SerialPort_RtsCts
    Case 3 ; Xon / Xoff
      Handshake = #PB_SerialPort_XonXoff
  EndSelect
 
  Debug "ComPort="+ComPort
  Debug "Baud="+Str(Baud)
  Debug "Parity="+Str(Parity)
  Debug "DataBits="+Str(DataBits)
  Debug "StopBits="+Str(StopBits)
  Debug "Handshake="+Str(Handshake)
EndProcedure

Procedure DisplayComError()
  ComErrorText.s = ""
  If IsSerialPort(hCom)
    ComError.l = SerialPortError(Hcom)
    If ComError & #PB_SerialPort_RxOver : ComErrorText + "An input buffer overflow has occurred"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_OverRun : ComErrorText + "A character-buffer overrun has occurred"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_RxParity : ComErrorText + "The hardware detected a parity error"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_Frame : ComErrorText + "The hardware detected a framing error"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_Break : ComErrorText + "The hardware detected a break condition"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_TxFull : ComErrorText + "The output buffer was full"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_IOE : ComErrorText + "An I/O error occurred during communications with the device"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_WaitingCTS : ComErrorText + "Waiting  CTS"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_WaitingDSR : ComErrorText + "Waiting  DSR"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_WaitingRLSD : ComErrorText + "Waiting  RLSD"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_XoffReceived : ComErrorText + "Waiting  because the XOFF character was received"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_XoffSent : ComErrorText + "Waiting  because the XOFF character was transmitted"+Chr(13) : EndIf
    If ComError & #PB_SerialPort_EOFSent : ComErrorText + "EOF character has been received"+Chr(13) : EndIf
    If Right(ComErrorText,1)=Chr(13):ComErrorText=Left(ComErrorText,Len(ComErrorText)-1):EndIf
    MessageRequester("Serial: Communication error occured !",ComErrorText)
  EndIf
EndProcedure

; -----------------------------------------------------------------------------------------------
; Main loop
; -----------------------------------------------------------------------------------------------

Open_Window_0()

Init01()

Repeat
  Event = WaitWindowEvent(100)
  Select Event
    Case 0
      If Hcom And IsSerialPort(Hcom)
        If GetActiveGadget()<>#Gadget_Xon
          SetGadgetText(#Gadget_Xon,StrU(GetSerialPortStatus(Hcom,#PB_SerialPort_XonCharacter),#PB_Byte))
        EndIf
        If GetActiveGadget()<>#Gadget_Xoff
          SetGadgetText(#Gadget_Xoff,StrU(GetSerialPortStatus(Hcom,#PB_SerialPort_XoffCharacter),#PB_Byte))
        EndIf
        Buffer.b = 0
        Text.s = GetGadgetText(#Label01)
        While AvailableSerialPortInput(Hcom) > 0
          If ReadSerialPortData(Hcom, @Buffer, 1) ; Read Byte
            Text = Text + Chr(Buffer)
            SetGadgetText(#Label01, Text)
          EndIf
        Wend
        If GetSerialPortStatus(Hcom,#PB_SerialPort_CTS)
          SetGadgetColor(#Gadget_58,#PB_Gadget_BackColor,#Green)
        Else
          SetGadgetColor(#Gadget_58,#PB_Gadget_BackColor,#Red)
        EndIf
        If GetSerialPortStatus(Hcom,#PB_SerialPort_DSR)
          SetGadgetColor(#Gadget_59,#PB_Gadget_BackColor,#Green)
        Else
          SetGadgetColor(#Gadget_59,#PB_Gadget_BackColor,#Red)
        EndIf
        If GetSerialPortStatus(Hcom,#PB_SerialPort_DCD)
          SetGadgetColor(#Gadget_60,#PB_Gadget_BackColor,#Green)
        Else
          SetGadgetColor(#Gadget_60,#PB_Gadget_BackColor,#Red)
        EndIf
        If GetSerialPortStatus(Hcom,#PB_SerialPort_RI)
          SetGadgetColor(#Gadget_61,#PB_Gadget_BackColor,#Green)
        Else
          SetGadgetColor(#Gadget_61,#PB_Gadget_BackColor,#Red)
        EndIf
      Else
        SetGadgetColor(#Gadget_58,#PB_Gadget_BackColor,#Red)
        SetGadgetColor(#Gadget_59,#PB_Gadget_BackColor,#Red)
        SetGadgetColor(#Gadget_60,#PB_Gadget_BackColor,#Red)
        SetGadgetColor(#Gadget_61,#PB_Gadget_BackColor,#Red)
      EndIf
    Case #PB_Event_Menu
      Select EventMenu()
        Case #Menu_Return
          Select GetActiveGadget()
            Case #Gadget_Xon
              If Hcom And IsSerialPort(Hcom)
                SetSerialPortStatus(Hcom,#PB_SerialPort_XonCharacter,Val(GetGadgetText(#Gadget_Xon))&$FF)
              EndIf
            Case #Gadget_Xoff
              If Hcom And IsSerialPort(Hcom)
                SetSerialPortStatus(Hcom,#PB_SerialPort_XoffCharacter,Val(GetGadgetText(#Gadget_Xoff))&$FF)
              EndIf
          EndSelect
      EndSelect
    Case #PB_Event_Gadget
      GadgetID = EventGadget()
      Select GadgetID
        Case #Key_Quit                             ;Quit
          Break
        Case #Key_SR                             ;Send and Get Data
          If Hcom And IsSerialPort(hCom)        ;Send the string to Communication Port
            EOL.b=13
            Chaine.s = GetGadgetText(#Text01)
            SetGadgetText(#Label01,"")         
            Select 1
              Case 1
                WriteSerialPortString(Hcom,Chaine) ; forced conversion to ASCII (Standard in PB4.20)
              Case 2
                WriteSerialPortString(Hcom,Chaine,#PB_Unicode) ; convert to UNICODE
              Case 3
                WriteSerialPortString(Hcom,Chaine,#PB_UTF8) ; convert to UTF8
            EndSelect
            WriteSerialPortData(Hcom,@EOL,1)
          Else
            MessageRequester("Message","Communication Port not open!!!",#MB_ICONEXCLAMATION)
          EndIf
        Case #Key_RTSON ; Set RTS ON
          If Hcom And IsSerialPort(hCom):SetSerialPortStatus(Hcom,#PB_SerialPort_RTS,1):EndIf
        Case #Key_RTSOFF ; Set RTS OFF
          If Hcom And IsSerialPort(hCom):SetSerialPortStatus(Hcom,#PB_SerialPort_RTS,0):EndIf
        Case #Key_DTRON ; Set DTR ON
          If Hcom And IsSerialPort(hCom):SetSerialPortStatus(Hcom,#PB_SerialPort_DTR,1):EndIf
        Case #Key_DTROFF ; Set DTR OFF
          If Hcom And IsSerialPort(hCom):SetSerialPortStatus(Hcom,#PB_SerialPort_DTR,0):EndIf
        Case #Key06 ; Set TXD ON
          If Hcom And IsSerialPort(hCom):SetSerialPortStatus(Hcom,#PB_SerialPort_TXD,1):EndIf
        Case #Key07 ; Set TXD OFF
          If Hcom And IsSerialPort(hCom):SetSerialPortStatus(Hcom,#PB_SerialPort_TXD,0):EndIf
        Case #Key08                               ;Open Com Port
          If hCom And IsSerialPort(hCom)          ;If one port is used then close it
            If CloseSerialPort(hCom)
              hCom = 0
            EndIf
          EndIf
          GetComDescription()
          hCom = OpenSerialPort(#PB_Any,ComPort,Baud,Parity,DataBits,StopBits,Handshake,1024,1024)
          If hCom = 0
            MessageRequester("Message","Communication Port not available!!!",#MB_ICONEXCLAMATION)
          Else
            Debug "hCom="+Str(hCom)
          EndIf
        Case #Key09             ;Close Com Port
          If hCom And IsSerialPort(hCom)
            If CloseSerialPort(hCom)
              hCom = 0
            EndIf
          EndIf
      EndSelect
  EndSelect
Until Event = #PB_Event_CloseWindow

If Hcom And IsSerialPort(hCom)
  CloseSerialPort(Hcom)                ;Close the Communication Port
  Hcom=0
EndIf
CloseWindow(#Window_0)                ;Close the window

End

Buffer1.b = 200
Buffer2.a = 200

Debug Chr(Buffer1)
Debug Chr(Buffer2)