FTDI232R Probleme mit der Abtastrate

[Peter C. (spiroboy)]

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

[holger (Gast)]

>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?

[Peter C. (spiroboy)]

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