Hallo Leute, ich brauche wiedermal dringend Eure Hilfe. Ich arbeite immer noch an mein Spirometer-Projekt zur Lungenfunktions-Messung. Ich habe nun meine Differenzdruck-Sensor MPX2010DP mit den OP-Verstärker LM358N verbunnden. Als AD-Wndler habe ich ein PC-Oszilloskop von Velleman PCS10. Das Teil liefert nur 10 Samples pro Sekunde. Ich brauche aber mehr. Zwischen 40 und 80 Samples pro Sekunde. Ich versuche es jetzt mit dem FTDI232R. Der liefert mir aber nur 7 Samples pro Sekunde. Wie kriege ich da mehr raus? Als Bild habe ich das Ergebnis vom Velleman. Ich wäre Euch dankbar wenn Ihr mir weiterhelfen könnt. Hier der VB6-Code: Private Declare Function LineTo Lib "gdi32.dll" ( _ ByVal hdc As Long, _ ByVal x As Long, _ ByVal y As Long) As Long Private Declare Function MoveToEx Lib "gdi32.dll" ( _ ByVal hdc As Long, _ ByVal x As Long, _ ByVal y As Long, _ lpPoint As POITNAPI) As Long Private Type POITNAPI x As Long y As Long End Type Dim Retval As Long, Pt As POITNAPI Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Dim lngNumDevices As Long Dim strBeschreibung As String * 256 Dim strReadBuffer As String * 1024 Dim strWriteBuffer As String ' Ladebuffer damit nicht immer im Timer gesetzt werden muss' ' für eine verbesserte Rechner Unabhängigkeit Dim CLadebuffer As String Dim lngBytesWritten As Long Dim lngBytesRead As Long Dim lngTotalBytesRead As Long Dim FT_RxBytes As Long Dim FT_TxBytes As Long Dim lngevent_get_stat As Long Dim intMask As Byte ' &0FH alle Signale / Bits als output 0= all inputs Dim intMode As Byte ' &H00 reset, &H01 = async Bitbang, &H04 sync Bitbang Dim flTimedout As Boolean Dim flFatalError As Boolean Dim FtStatus As Long Dim Databyte As Byte Dim TimerIstAn As Boolean Dim FT_Trans_Size As Long Const TXD = 0 ' D0 Const RXD = 1 ' D1 Const RTS = 2 ' D2 Const CTS = 3 ' D3 Const DTR = 4 ' D4 Const DSR = 5 ' D5 Const DCD = 6 ' D6 Const RI = 7 ' D7 ' Private Sub BitBangAn() ' BitBang Mode aktivieren ' intMask muss vor Aufruf gesetzt werden ' Anzeige bereinigen LoggerList.Clear ' USB Geräte vorhanden? If FT_GetNumDevices(lngNumDevices, vbNullString, FT_LIST_BY_NUMBER_ONLY) <> FT_OK Then LoggerList.AddItem ("Fehler bei Aufruf: FT_GetNumDevices funktionierte nicht") Exit Sub End If strBeschreibung = Trim(Me.DeviceName.Text) & Chr(0) If FT_OpenEx(strBeschreibung, FT_OPEN_BY_DESCRIPTION, lngHandle) <> FT_OK Then LoggerList.AddItem "Fehler bei Aufruf: FT_OpenEx" Exit Sub Else LoggerList.AddItem "BitBang aktivieren" End If ' Baudrate setzen FtStatus = FT_SetBaudRate(lngHandle, Val(lb_baudrate.Text)) If FtStatus <> FT_OK Then LoggerList.AddItem "Fehler SetBaudRate" GoTo CloseHandle Else LoggerList.AddItem "BaudRate beträgt " & lb_baudrate.Text End If ' intMask muss vor Aufruf gesetzt werden intMode = 4 ' synchrones Bit Bang ' Bit Bang Modus setzen FtStatus = FT_SetBitMode(lngHandle, intMask, intMode) If FtStatus <> FT_OK Then LoggerList.AddItem "Fehler bei FT_SetBitMode" GoTo CloseHandle Else LoggerList.AddItem "BitBang Mode aktiviert" End If CloseHandle: If FT_Close(lngHandle) <> FT_OK Then LoggerList.AddItem "Fehler bei Aufruf: FT_Close" Exit Sub Else End If End Sub Private Sub bt_BitBangAn_Click() End Sub Private Sub bt_ad_read_Click() If TimerIstAn Then Me.bt_ad_read.Caption = "Starten" Me.Timer2.Interval = 0 TimerIstAn = False LoggerList.AddItem "A/D Daten lesen gestoppt" Else intMask = &H0 Or 2 ^ TXD Or 2 ^ RXD Call BitBangAn Me.bt_ad_read.Caption = "Stoppen" ' ein Ladebuffer, damit in Timer nicht ständig neu geladen werden muss CLadebuffer = "" For il% = 0 To Val(Me.lb_bsize.Text) - 2 CLadebuffer = CLadebuffer & Chr$(&H0) Next il LoggerList.AddItem "A/D Daten werden periodisch gelesen" Me.Timer2.Interval = 1 TimerIstAn = True End If End Sub Private Sub lb_baudrate_Click() Angaben_aktualisieren End Sub Private Sub lb_bsize_Click() Angaben_aktualisieren End Sub Private Sub Form_Load() ' Auswahl für User vervolständigen lb_bsize.AddItem "64" lb_bsize.AddItem "128" lb_bsize.AddItem "256" lb_bsize.AddItem "512" lb_bsize.AddItem "1024" lb_baudrate.AddItem "300" lb_baudrate.AddItem "600" lb_baudrate.AddItem "1200" lb_baudrate.AddItem "2400" lb_baudrate.AddItem "4800" lb_baudrate.AddItem "9600" lb_baudrate.AddItem "19200" lb_baudrate.AddItem "38400" lb_baudrate.AddItem "76800" Angaben_aktualisieren End Sub Public Function SendRead_FTDI_Bytes() As Boolean ' um einzelne Bytes im Bitbang Mode des FTDI 232R zu setzen und zu lesen ' Die Bytes sind in strWriteBuffer, die Anzahl wird übergeben ' Die Bytes sind im asynchronen Modus um ein Byte versetzt ! Dim i As Long If FT_Write(lngHandle, strWriteBuffer, Len(strWriteBuffer), lngBytesWritten) <> FT_OK Then LoggerList.AddItem "Write Failed" GoTo CloseHandle 'Else LoggerList.AddItem Len(strWriteBuffer) & " Byte geschrieben" End If 'überprüfen und warten bis Bytes geschrieben Do FtStatus = FT_GetStatus(lngHandle, FT_RxBytes, FT_TxBytes, lngevent_get_stat) If FtStatus = FT_OK Then ' Else If FtStatus = FT_IO_ERROR Then LoggerList.AddItem "Get Status IO Error" GoTo CloseHandle End If End If Loop Until FT_RxBytes = lngBytesWritten flTimedout = False flFatalError = False lngTotalBytesRead = 0 strReadBuffer = "" ' Bytes in den Lesebuffer 'strReadBuffer' lesen Do lngBytesRead = 0 ' Anzahl Bytes die zurückgegeben wurden FtStatus = FT_Read(lngHandle, strReadBuffer, FT_RxBytes, lngBytesRead) If (FtStatus = FT_OK) Or (FtStatus = FT_IO_ERROR) Then If lngBytesRead > 0 Then lngTotalBytesRead = lngTotalBytesRead + lngBytesRead Else flTimedout = True End If Else flFatalError = True End If Loop Until (lngTotalBytesRead = FT_RxBytes) Or (flTimedout = True) Or (flFatalError = True) If (flTimedout = False) And (flFatalError = False) Then flFailed = False ElseIf flTimedout = True Then LoggerList.AddItem "FT_Read timeout ftStatus = " & FtStatus Else LoggerList.AddItem "FT_Read error ftStatus = " & FtStatus End If SendRead_FTDI_Bytes = True Exit Function CloseHandle: SendRead_FTDI_Bytes = False intMode = 0 ' close the handle If FT_Close(lngHandle) <> FT_OK Then LoggerList.AddItem "Close Failed" End If End Function Private Sub Angaben_aktualisieren() Me.lb_bit.Caption = "Lesezyklus ca.:" & Str(Format((1 / (Val(Me.lb_baudrate.Text) * 16) * 1000000), "0.0")) & " µs" Me.lb_zeit.Caption = "Aufzeichnungsdauer ca.: " & Format((1 / (Val(Me.lb_baudrate.Text) * 16) 1000000 Val(Me.lb_bsize.Text)), "0") & " µs" End Sub Private Sub Timer2_Timer() ' A/D Wandler periodisch lesen strBeschreibung = Trim(Me.DeviceName.Text) & Chr(0) If FT_OpenEx(strBeschreibung, FT_OPEN_BY_DESCRIPTION, lngHandle) <> FT_OK Then LoggerList.AddItem "Fehler bei Aufruf: FT_OpenEx" Exit Sub End If strWriteBuffer = Chr$(&H1) ' Transistor an TXD hochohmig, C wird angsam entladen SendRead_FTDI_Bytes ' strWriteBuffer = Chr$(&H3) ' C entladen über FET an RXD SendRead_FTDI_Bytes ' strWriteBuffer = strWriteBuffer & CLadebuffer 'Sleep 100 ' stabilere Ergebnisse SendRead_FTDI_Bytes ' Stelle im ReadBuffer ermitteln For il = 1 To Len(strReadBuffer) If ((Asc(Mid(strReadBuffer, il, 1)) And 2 ^ DSR) / 2 ^ DSR) = 0 Then ' strWriteBuffer = strWriteBuffer & " " Me.lb_Anzahl.Caption = Str(il) List1.AddItem Str(Time) + " " + Format(il * 2.5 / Val(Me.lb_2_5_Volt.Text), "0.000") Exit For End If Next il If il >= Len(strWriteBuffer) Then Me.lb_Anzahl.Caption = ">>>" Me.lb_volt.Caption = "< >" Else ' Anzeigen aufbereiten Me.lb_volt.Caption = Format(il * 2.5 / Val(Me.lb_2_5_Volt.Text), "0.000") & " V" Me.V_val.Top = 5000 - Int(il * 2.5 / Val(Me.lb_2_5_Volt.Text) * 1000) Me.V_val.Height = 5000 - Me.V_val.Top 'List1.AddItem Time + " " + Str(Me.lb_volt.Caption) 'Retval = MoveToEx(Picture1.hdc, il + 70, 5000 - Me.V_val.Top + 30, Pt) 'Startpunkt 'Retval = LineTo(Picture1.hdc, il + 70, 5000 - Me.V_val.Top + 30) End If CloseHandle: If FT_Close(lngHandle) <> FT_OK Then LoggerList.AddItem "Fehler bei Aufruf: FT_Close" Exit Sub Else End If ADTest_Fehler_ende: Exit Sub ADTest_Fehler: MsgBox Err.Description Resume ADTest_Fehler_ende End Sub
>Als AD-Wndler habe ich ein PC-Oszilloskop von Velleman PCS10. Das Teil >liefert nur 10 Samples pro Sekunde. Laut Beschreibung sollte das 100S/s können. >und 80 Samples pro Sekunde. Ich versuche es jetzt mit dem FTDI232R. Der >liefert mir aber nur 7 Samples pro Sekunde. Wie kriege ich da mehr raus? Mit was für einer Schaltung?
Das stimmt schon. Laut Hersteller sollte der 100 S/sek. liefern. Macht der aber nicht. Mehr als 20 S/sek. geht nicht. Hier der Orginal VB-Code von Velleman. Gibt's auch zum downloaden bei Velleman. Ich habe noch zusätzlich die Anzeige des Systemtimers in der ListBox integriert. Da sieht man es genau das es nicht mehr als 20 Samplews sind. Option Explicit 'Declare use of the DLL 'K8047D.DLL interface 'GENERAL PROCEDURES Private Declare Sub StartDevice Lib "k8047d.dll" () Private Declare Sub StopDevice Lib "k8047d.dll" () 'INPUT PROCEDURE Private Declare Sub ReadData Lib "k8047d.dll" (Array_Pointer As Long) 'OUTPUT PROCEDURE Private Declare Sub SetGain Lib "k8047d.dll" (ByVal Channel_no As Long, ByVal Gain As Long) Private Declare Sub LEDon Lib "k8047d.dll" () Private Declare Sub LEDoff Lib "k8047d.dll" () 'Declare variables Dim DataBuffer(0 To 7) As Long Private Sub Check1_Click() If Check1.Value = 1 Then LEDon Else LEDoff End Sub Private Sub Form_Load() StartDevice End Sub Private Sub Form_Terminate() StopDevice End Sub Private Sub Command1_Click() Dim i As Integer Dim s As String Dim m As Integer For m = 1 To 100 ReadData DataBuffer(0) s = "" For i = 0 To 5 s = Str(Time) + " " + s + Str(DataBuffer(i)) + Chr(9) Next i List1.AddItem s Next m End Sub Private Sub Option1_Click(Index As Integer) SetGain 1, Index End Sub Private Sub Option2_Click(Index As Integer) SetGain 2, Index End Sub Private Sub Option3_Click(Index As Integer) SetGain 3, Index End Sub Private Sub Option4_Click(Index As Integer) SetGain 4, Index End Sub
Bitte melde dich an um einen Beitrag zu schreiben. Anmeldung ist kostenlos und dauert nur eine Minute.
Bestehender Account
Schon ein Account bei Google/GoogleMail? Keine Anmeldung erforderlich!
Mit Google-Account einloggen
Mit Google-Account einloggen
Noch kein Account? Hier anmelden.