Exeperimente mit usb Code für ampelschaltung

jochenZ_e94891 · 11. November 2019 um 16:30

Lenrnpaket Experimente mit USB von Franzis-Verlag
Enthält einen VB 6 Code für eine Ampelschaltung der
ist unvollständig.
Wer kennt den vollständigen Code?

Joe_515c88 · 11. November 2019 um 16:32

Zeig uns den Code
Ich kann so nichts finden, aber evtl sehen wir zusammen was im Code fehlt.

mfg jonny

jochenZ_e94891 · 11. November 2019 um 16:51

Option Explicit

Private ModusLicht As Boolean

Private AmpelLichtNummer As Integer
Private AmpelBlinkNummer As Integer

Private Sub comStartAmpelLicht_Click()
If comStartAmpelLicht.Caption = „Start“ Then
comStartAmpelLicht.Caption = „Stopp“
comStartAmpelBlink.Enabled = False
ModusLicht = True
AmpelLichtNummer = 0
Timer1.Enabled = True
Else
Timer1.Enabled = False
comStartAmpelLicht.Caption = „Start“
comStartAmpelLicht.Enabled = True
comStartAmpelBlink.Enabled = True
End If

labRot.ForeColor = vbBlack
labGelb.ForeColor = vbBlack
labGrün.ForeColor = vbBlack
End Sub

Private Sub comStartAmpelBlink_Click()
If comStartAmpelBlink.Caption = „Start“ Then
comStartAmpelBlink.Caption = „Stopp“
comStartAmpelLicht.Enabled = False
ModusLicht = False
AmpelLichtNummer = 0
Timer1.Enabled = True
Else
Timer1.Enabled = False
comStartAmpelLicht.Enabled = True
comStartAmpelBlink.Caption = „Start“
comStartAmpelBlink.Enabled = True
End If

labRot.ForeColor = vbBlack
labGelb.ForeColor = vbBlack
labGrün.ForeColor = vbBlack
End Sub

Private Sub Timer1_Timer()

AmpelLichtNummer = AmpelLichtNummer + 1

If ModusLicht Then
Select Case AmpelLichtNummer

Case 1 'Rot
labRot.ForeColor = vbRed
labGelb.ForeColor = vbBlack
labGrün.ForeColor = vbBlack

Case 11 'Rot gelb
labGelb.ForeColor = vbYellow

Case 21 'Grün
labGrün.ForeColor = vbGreen
labRot.ForeColor = vbBlack
labGelb.ForeColor = vbBlack

Case 41 'Grün nach Gelb
labGrün.ForeColor = vbBlack
labGelb.ForeColor = vbYellow

Case 51 'zurück nach rot
AmpelLichtNummer = 0
End Select

Else
Select Case AmpelLichtNummer
Case 1 'an
labGelb.ForeColor = vbYellow

Case 6 'aus
labGelb.ForeColor = vbBlack

Case 8 ’ zurück nach an
AmpelLichtNummer = 0
End Select
End If
End Sub
Dieses Programm funktioniert ausgezeichnet!
Aber jetzt soll ein Modul eingebunden werden, so das
der Usb -Adapter auch angesprochen wird und die
Ampel auf der Paltine entsprchend funktioniert.

also hier ist der Code des Moduls:

Option Explicit
'====================================
'INTERFACE DEKlarationen für FTDI DLL
'====================================
Public Declare Function FT_ListDevices Lib „FTD2XX.DLL“ ( _
ByVal arg1 As Long, _
ByVal arg2 As String, _
ByVal dwFlags As Long) As Long

Public Declare Function FT_GetNumDevices Lib „FTD2XX.DLL“ Alias „FT_ListDevices“ ( _
ByRef arg1 As Long, _
ByVal arg2 As String, _
ByVal dwFlags As Long) As Long

Public Declare Function FT_Open Lib „FTD2XX.DLL“ ( _
ByVal intDeviceNumber As Integer, _
ByRef lngHandle As Long) As Long

Public Declare Function FT_OpenEx Lib „FTD2XX.DLL“ ( _
ByVal arg1 As String, _
ByVal arg2 As Long, _
ByRef lngHandle As Long) As Long

Public Declare Function FT_Close Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long) As Long

Public Declare Function FT_Read Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByVal lpszBuffer As String, _
ByVal lngBufferSize As Long, _
ByRef lngBytesReturned As Long) As Long

Public Declare Function FT_Write Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByVal lpszBuffer As String, _
ByVal lngBufferSize As Long, _
ByRef lngBytesWritten As Long) As Long

Public Declare Function FT_WriteByte Lib „FTD2XX.DLL“ Alias „FT_Write“ ( _
ByVal lngHandle As Long, _
ByRef lpszBuffer As Any, _
ByVal lngBufferSize As Long, _
ByRef lngBytesWritten As Long) As Long

Public Declare Function FT_SetBaudRate Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByVal lngBaudRate As Long) As Long

Public Declare Function FT_SetDataCharacteristics Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByVal byWordLength As Byte, _
ByVal byStopBits As Byte, _
ByVal byParity As Byte) As Long

Public Declare Function FT_SetFlowControl Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByVal intFlowControl As Integer, _
ByVal byXonChar As Byte, _
ByVal byXoffChar As Byte) As Long

Public Declare Function FT_SetDtr Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long) As Long

Public Declare Function FT_ClrDtr Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long) As Long

Public Declare Function FT_SetRts Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long) As Long

Public Declare Function FT_ClrRts Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long) As Long

Public Declare Function FT_GetModemStatus Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByRef lngModemStatus As Long) As Long

Public Declare Function FT_SetChars Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByVal byEventChar As Byte, _
ByVal byEventCharEnabled As Byte, _
ByVal byErrorChar As Byte, _
ByVal byErrorCharEnabled As Byte) As Long

Public Declare Function FT_Purge Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByVal lngMask As Long) As Long

Public Declare Function FT_SetTimeouts Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByVal lngReadTimeout As Long, _
ByVal lngWriteTimeout As Long) As Long

Public Declare Function FT_GetQueueStatus Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByRef lngRxBytes As Long) As Long

Public Declare Function FT_SetBreakOn Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long) As Long

Public Declare Function FT_SetBreakOff Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long) As Long

Public Declare Function FT_GetStatus Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByRef lngRxBytes As Long, _
ByRef lngTxBytes As Long, _
ByRef lngEventsDWord As Long) As Long

Public Declare Function FT_SetEventNotification Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByVal dwEventMask As Long, _
ByVal pVoid As Long) As Long

Public Declare Function FT_ResetDevice Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long) As Long

Public Declare Function FT_GetBitMode Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByRef intData As Any) As Long

Public Declare Function FT_SetBitMode Lib „FTD2XX.DLL“ ( _
ByVal lngHandle As Long, _
ByVal intMask As Byte, _
ByVal intMode As Byte) As Long

Public Declare Function FT_SetLatencyTimer Lib „FTD2XX.DLL“ ( _
ByVal Handle As Long, _
ByVal pucTimer As Byte) As Long

Public Declare Function FT_GetLatencyTimer Lib „FTD2XX.DLL“ ( _
ByVal Handle As Long, _
ByRef ucTimer As Long) As Long

’ Return codes
Public Const FT_OK = 0
Public Const FT_INVALID_HANDLE = 1
Public Const FT_DEVICE_NOT_FOUND = 2
Public Const FT_DEVICE_NOT_OPENED = 3
Public Const FT_IO_ERROR = 4
Public Const FT_INSUFFICIENT_RESOURCES = 5
Public Const FT_INVALID_PARAMETER = 6
Public Const FT_INVALID_BAUD_RATE = 7
Public Const FT_DEVICE_NOT_OPENED_FOR_ERASE = 8
Public Const FT_DEVICE_NOT_OPENED_FOR_WRITE = 9
Public Const FT_FAILED_TO_WRITE_DEVICE = 10
Public Const FT_EEPROM_READ_FAILED = 11
Public Const FT_EEPROM_WRITE_FAILED = 12
Public Const FT_EEPROM_ERASE_FAILED = 13
Public Const FT_EEPROM_NOT_PRESENT = 14
Public Const FT_EEPROM_NOT_PROGRAMMED = 15
Public Const FT_INVALID_ARGS = 16
Public Const FT_NOT_SUPPORTED = 17
Public Const FT_OTHER_ERROR = 18

’ Flags für FT_OpenEx
Public Const FT_OPEN_BY_SERIAL_NUMBER = 1
Public Const FT_OPEN_BY_DESCRIPTION = 2

’ Flags für FT_ListDevices
Public Const FT_LIST_BY_NUMBER_ONLY = &H80000000
Public Const FT_LIST_BY_INDEX = &H40000000
Public Const FT_LIST_ALL = &H20000000

’ IO buffer
Public Const FT_In_Buffer_Size = 1024
Public Const FT_Out_Buffer_Size = 1024

Public FT_In_Buffer As String * FT_In_Buffer_Size
Public FT_Out_Buffer As String * FT_Out_Buffer_Size
Public FT_IO_Status As Long
Public FT_Result As Long
Public FT_Device_Count As Long
Public FT_Device_String_Buffer As String * 50
Public FT_Device_String As String

Global lngHandle As Long

Public FT_HANDLE As Long

Public Sub FT_Error_Report(ErrStr As String, PortStatus As Long)
’ Fehlermeldungen
Dim Str As String

Select Case PortStatus
Case FT_INVALID_HANDLE
Str = ErrStr & " - Invalid Handle"
Case FT_DEVICE_NOT_FOUND
Str = ErrStr & " - Device Not Found"
Case FT_DEVICE_NOT_OPENED
Str = ErrStr & " - Device Not Opened"
Case FT_IO_ERROR
Str = ErrStr & " - General IO Error"
Case FT_INSUFFICIENT_RESOURCES
Str = ErrStr & " - Insufficient Resources"
Case FT_INVALID_PARAMETER
Str = ErrStr & " - Invalid Parameter"
Case FT_INVALID_BAUD_RATE
Str = ErrStr & " - Invalid Baud Rate"
Case FT_DEVICE_NOT_OPENED_FOR_ERASE
Str = ErrStr & " - Device not opened for Erase"
Case FT_DEVICE_NOT_OPENED_FOR_WRITE
Str = ErrStr & " - Device not opened for Write"
Case FT_FAILED_TO_WRITE_DEVICE
Str = ErrStr & " - Failed to write Device"
Case FT_EEPROM_READ_FAILED
Str = ErrStr & " - EEPROM read failed"
Case FT_EEPROM_WRITE_FAILED
Str = ErrStr & " - EEPROM write failed"
Case FT_EEPROM_ERASE_FAILED
Str = ErrStr & " - EEPROM erase failed"
Case FT_EEPROM_NOT_PRESENT
Str = ErrStr & " - EEPROM not present"
Case FT_EEPROM_NOT_PROGRAMMED
Str = ErrStr & " - EEPROM not programmed"
Case FT_INVALID_ARGS
Str = ErrStr & " - Invalid Arguments"
Case FT_NOT_SUPPORTED
Str = ErrStr & " - not supported"
Case FT_OTHER_ERROR
Str = ErrStr & " - other error"
End Select

End Sub

In einem vorherigen Experiment funktioniert die Ansprache an die Experimentierplatine.

In der Anleitung heißt es, man soll die Ampel mit etwas Geschick selbst aufbauen könne.

Dazu muss der Quellcode eigesetzt werden.
If Me.CBTXD.Value Then
if FT_SetBreakON( lngHandle) = FT_OK Then
LoggerList.AddItem „Break On -LED an ?“
End If
Else
If FT_SetBreakOff(lngHandle) = FT_OK Then
LoggeList.AddItem „Break OFF“
End If
End If

Es bietet sich an, mit den drei Ausgangssignalen DTR / RTS und TxD
der Schnittstelle eine Ampel aufbauen zu können.

Ich fühl mich dabei etwas überfordert, zumal ich VB erst jetzt wieder ausgegraben habe und wieder ganz am Anfang stehe.

Vielen Dank für die schnelle Reaktion.
Mit der Hoffnung auf Hilfe warte ich und Danka im Vorraus.
Mfg. Jochen Z

jochenZ_e94891 · 11. November 2019 um 16:51

Ich hoffe das jetzt der vollständige Code vorhanden ist!
mfg. jochenZ

Option Explicit

Private ModusLicht As Boolean

Private AmpelLichtNummer As Integer
Private AmpelBlinkNummer As Integer

Private Sub comStartAmpelLicht_Click()
If comStartAmpelLicht.Caption = „Start“ Then
comStartAmpelLicht.Caption = „Stopp“
comStartAmpelBlink.Enabled = False
ModusLicht = True
AmpelLichtNummer = 0
Timer1.Enabled = True
Else
Timer1.Enabled = False
comStartAmpelLicht.Caption = „Start“
comStartAmpelLicht.Enabled = True
comStartAmpelBlink.Enabled = True
End If

labRot.ForeColor = vbBlack
labGelb.ForeColor = vbBlack
labGrün.ForeColor = vbBlack
End Sub

Private Sub comStartAmpelBlink_Click()
If comStartAmpelBlink.Caption = „Start“ Then
comStartAmpelBlink.Caption = „Stopp“
comStartAmpelLicht.Enabled = False
ModusLicht = False
AmpelLichtNummer = 0
Timer1.Enabled = True
Else
Timer1.Enabled = False
comStartAmpelLicht.Enabled = True
comStartAmpelBlink.Caption = „Start“
comStartAmpelBlink.Enabled = True
End If

labRot.ForeColor = vbBlack
labGelb.ForeColor = vbBlack
labGrün.ForeColor = vbBlack
End Sub

Private Sub Form_Load()

End Sub

Private Sub labAmpelBlink_Click()

End Sub

Private Sub labAmpelLicht_Click()

End Sub

Private Sub labGelb_Click()

End Sub

Private Sub labGrün_Click()

End Sub

Private Sub labRot_Click()

End Sub

Private Sub Timer1_Timer()

AmpelLichtNummer = AmpelLichtNummer + 1

If ModusLicht Then
Select Case AmpelLichtNummer

Case 1 'Rot
labRot.ForeColor = vbRed
labGelb.ForeColor = vbBlack
labGrün.ForeColor = vbBlack

Case 11 'Rot gelb
labGelb.ForeColor = vbYellow

Case 21 'Grün
labGrün.ForeColor = vbGreen
labRot.ForeColor = vbBlack
labGelb.ForeColor = vbBlack

Case 41 'Grün nach Gelb
labGrün.ForeColor = vbBlack
labGelb.ForeColor = vbYellow

Case 51 'zurück nach rot
AmpelLichtNummer = 0
End Select

Else
Select Case AmpelLichtNummer
Case 1 'an
labGelb.ForeColor = vbYellow

Case 6 'aus
labGelb.ForeColor = vbBlack

Case 8 ’ zurück nach an
AmpelLichtNummer = 0
End Select
End If
End Sub

Joe_515c88 · 11. November 2019 um 16:52

Guten Tag,

Hast du eine Form mit Schaltflächen ?
Oder was Passwiert wenn du auf „Play“ drückst ?

Fehlermeldung?

mfg jonny

jochenZ_e94891 · 11. November 2019 um 16:54

http://www.bilder-speicher.de/10092723667669.gratis-…

Das Bild! link oben! unter Bilder-speichern.de

Private Sub Form_Load()

End Sub

Private Sub Timer1_Timer()

AmpelLichtNummer = AmpelLichtNummer + 1

If ModusLicht Then
Select Case AmpelLichtNummer

Case 1 'Rot
labRot.ForeColor = vbRed
labGelb.ForeColor = vbBlack
labGrün.ForeColor = vbBlack

Case 11 'Rot gelb
labGelb.ForeColor = vbYellow

Case 21 'Grün
labGrün.ForeColor = vbGreen
labRot.ForeColor = vbBlack
labGelb.ForeColor = vbBlack

Case 41 'Grün nach Gelb
labGrün.ForeColor = vbBlack
labGelb.ForeColor = vbYellow

Case 51 'zurück nach rot
AmpelLichtNummer = 0
End Select

Else
Select Case AmpelLichtNummer
Case 1 'an
labGelb.ForeColor = vbYellow

Case 6 'aus
labGelb.ForeColor = vbBlack

Case 8 ’ zurück nach an
AmpelLichtNummer = 0
End Select
End If