Hallo, ich weiß nicht, ob es funktionieren wird.
Ich habe folgenden Source erweitert und nach PB 5.31
angepasst, das er ausgeführt wird. Ob es bei dir funktioniert,
musst du mal testen.
Gruß,
Falko
Versuche das mal hiermit:
Code:
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