Hallo, ich weiß nicht, ob es funktionieren wird.
angepasst, das er ausgeführt wird. Ob es bei dir funktioniert,
musst du mal testen.
Code: Alles auswählen
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