Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0056: Kompletten CD-Spieler mit MCIsendstring realisieren

 von 

Beschreibung 

Hier ein kleines Beispiel, wie recht einfach unter Verwendung der allseits bekannten MCIsenstring-Befehle mit VB ein CD-Spieler ohne jegliches Control zu realisieren ist. Natürlich ließe sich der hier vorgestellte Spieler noch um einige Funktionen, wie CD einziehen und auswerfen (siehe Tip 5), Repeat- und Random Funktion erweitern; sprengt nur leider den Rahmen.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

mciSendStringA (mciSendString)

Download:

Download des Beispielprojektes [3,29 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
' Es muss ein Verweis auf 'Standard OLE Types' gesetzt werden.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command1" (Index von 0 bis 9)
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command3"
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Schaltfläche "Command7"
' Steuerelement: Schaltfläche "Command5"
' Steuerelement: Schaltfläche "Command6"
' Steuerelement: Schaltfläche "Command4"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label7"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Beschriftungsfeld "Label4"
' Steuerelement: Beschriftungsfeld "Label5"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label6"

Option Explicit

Private Declare Function mciSendString Lib "winmm.dll" _
        Alias "mciSendStringA" (ByVal lpstrCommand As _
        String, ByVal lpstrReturnString As String, ByVal _
        uReturnLength As Long, ByVal hwndCallback As _
        Long) As Long

Dim LastTrack&

Private Sub Command1_Click(Index As Integer)
  Dim No$, T$, E$
    No = Trim$(CStr(Index))
    T = Label3.Caption
    If Len(T) > 1 Or T = "" Then
      E = No
    Else
      E = T & No
    End If
    If Val(E) <= LastTrack Then Label3.Caption = E
End Sub

Private Sub Command6_Click()
  Dim Track&, Position&
    Track = GetCDTrack
    If Track Then
      Track = Track - 1
      Position = GetTrackPosition(Track)
      If Position Then PlayFromPosition (Position)
    End If
End Sub

Private Sub Command7_Click()
  Dim Track&, Position&
    Track = GetCDTrack
    If Track Then
      Track = Track + 1
      Position = GetTrackPosition(Track)
      If Position Then PlayFromPosition (Position)
    End If
End Sub

Private Sub Command2_Click()
  Label3.Caption = ""
End Sub

Private Sub Command3_Click()
  Dim Track&
    Track = Val(Label3.Caption)
    If Track > 0 And Track <= LastTrack Then
      PlayFromPosition (GetTrackPosition(Track))
     Label3.Caption = ""
    Else
      Label3.Caption = "#E"
    End If
End Sub

Private Sub Command4_Click()
  PlayCD
  LastTrack = GetLastTrack
  Label4.Caption = "[ " & LastTrack & " ]"
End Sub

Private Sub Command5_Click()
  StopCD
End Sub

Private Sub Form_Load()
  StopCD
  LastTrack = GetLastTrack
  Label4.Caption = "[ " & LastTrack & " ]"
End Sub

Private Sub Form_Unload(Cancel As Integer)
  StopCD
End Sub

Private Sub Timer1_Timer()
  Dim TotalLength&, Track&, TrackStart&, Position&

    TotalLength = GetCDLength
    If TotalLength <> 0 Then
      Label1.Caption = "[ " & TimeFormat(TotalLength) & " ]"
      Track = GetCDTrack
      TrackStart = GetTrackPosition(Track)
      
      Position = GetCDPosition
      Label7.Caption = TimeFormat(Position - TrackStart)
      Label2.Caption = TimeFormat(Position)
      
      If LastTrack <> 0 Then
        Label5.Caption = "Track " & GetCDTrack
      Else
        Label5.Caption = "Track 0"
      End If
    End If
End Sub

Private Function TimeFormat(ByVal Ms&) As String
  Dim se$, mi$, st$, m As Single, h As Single
   If Ms <> 0 Then
     Ms = Ms / 1000
     h = Int(Ms / 3600)
     m = Int((Ms - h * 3600) / 60)
   End If
   
   se = CStr(Ms - h * 3600 - m * 60)
   mi = CStr(m)
   st = CStr(h)
   
   If Len(se) < 2 Then se = "0" & se
   If Len(mi) < 2 Then mi = "0" & mi
   
   TimeFormat = st & ":" & mi & ":" & se
End Function

Private Function GetLastTrack() As Long
  Dim X&, Y&
    For X = 1 To 1000
      Y = GetTrackPosition(X)
      If Y = 0 Then Exit For
    Next X
    GetLastTrack = X - 1
End Function

Private Function SendMCI(Com$)
  Dim Y&, X$, cb&
    X = Space$(128)
    Y = mciSendString(Com, X, 128, cb)
    SendMCI = Val(X)
End Function

Private Function GetCDTrack() As Long
  GetCDTrack = SendMCI("status cdaudio current track")
End Function

Private Function GetCDPosition() As Long
  GetCDPosition = SendMCI("status cdaudio position")
End Function

Private Function GetTrackPosition(Track&) As Long
  GetTrackPosition = SendMCI("status cdaudio position track " & Track)
End Function

Private Function PlayFromPosition(Position&) As Long
  PlayFromPosition = SendMCI("play cdaudio from " & Position)
End Function

Private Function GetCDLength() As Long
  GetCDLength = SendMCI("status cdaudio length")
End Function

Private Sub StopCD()
  SendMCI ("stop cdaudio")
  SendMCI ("close cdaudio")
End Sub

Private Sub PlayCD()
  SendMCI ("open cdaudio")
  SendMCI ("set cdaudio time format milliseconds")
  SendMCI ("play cdaudio")
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 15 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von xy am 06.02.2009 um 18:20

Das Funktioniert ja gar nicht.
Die deklarationen stimmen nicht. Der Code ist nicht wie angegeben für VB6. Ausserdem gibt es seit über einem jahr Vista!. Fehlt hier ein Update???? Ja!

Kommentar von Christian Lütgens am 17.06.2005 um 12:37

Hallo,
ich habe das gleiche Problem wie viele hier :
Alles läuft nur bekomme ich keinen Ton ??
Woran kann das liegen ? An Win XP SP2 ?
Media Player spielt die CD normal ab.
Bitte um Hilfe.
Thx

Kommentar von Denis am 30.03.2005 um 12:22

Hallo,
Wie kann ich die CD zu einer Pause zu coden?
Danke im Vorraus
Deis

Kommentar von Christian Dehn am 02.03.2005 um 22:17

Das Programm erkennt die CD und ließt die informationen aus, es spielt sie auch ab,aber es gibt keinen Ton

Kommentar von Gigaherz am 06.11.2003 um 16:21

Hi kann mir jemand sagen, wie ich mit der mciSendStringA zu einer bestimmten Position einer Mp3 springen kann?
Und weiß jemand wo ich einen workshop über Visualitionen herbekomme?
Danke
MfG
Gigaherz

Kommentar von luet am 26.06.2003 um 12:58

Wenn ich mehrere CD-Laufwerke habe, wie stell ich ein anderes CD-Laufwerk ein um von ihm eine Audio-CD abzuspielen?

Kommentar von genja am 30.05.2003 um 15:24

Hallo!
Kennt emand wie man mit dem Visual basic cd's brennen kann? Und wo ich darüber Infos finde? Bitte...
Achtung: ich bin ein Anfenger!!!

Kommentar von Jörg Bartoschek am 09.05.2002 um 08:18

Wenn es sich bei Michaels Frage um MP3 Titellängen handelt
dann geht das so:
Dateilänge mit lof(x)ermitteln und bei
Stereo (128)durch 16000 teilen = länge in sekunden

Kommentar von Michael Rendenbach am 09.03.2002 um 11:40

Mich würde noch brennend interessieren, wie ich die einzelnen Liederlängen herausfinden kann!

Kommentar von Maniac am 25.01.2002 um 17:59

ne, schmarrn,....
den Stop-Button nicht mit
mciSendString("stop Mp3", "", 0, 0)
sondern mit
mciSendString("close Mp3", "", 0, 0)
hab mich verschrieben...

Kommentar von Maniac am 25.01.2002 um 17:58

Hey Daniel!
Klar weiß ich wie das geht, ich hab' mir nämlich auch einen gebastelt :)
und zwar mit:
mciSendString("play Mp3", "", 0, 0)
So, wie du wahrscheinlich auch das MP3 gestartet hast, oder? Und wenn du einen "STOP"-Button hast, dann kannst du es mit
mciSendString("stop Mp3", "", 0, 0)
versuchen.
Ich hoffe, ich habe dir damit geholfen.
Selber möchte ich eigentlich nur wissen, wie man einen kleinen Lautstärkeregler programmieren kann. Mit den Tips, die auf der Seite aufgelistet sind, kann ich mir nicht helfen, da es eigentlich hauptsächlich nur um den selbstgemachten Schieberegler geht, und nicht direkt um die Lautstärke (Ich kann die Befehle dafür im Code nicht direkt rauslesen)
Bitte helft mir so schnell wie möglich
Danke
Maniac

Kommentar von Daniel Pramel am 27.03.2001 um 21:06

ähm, pause ist klar - ich meinte eigentlich: um die pause wieder aufzuheben *g*

Kommentar von Daniel Pramel am 27.03.2001 um 21:05

Ich "bastel" mir gerade einen kleinen MP3-Player. Kennt jemand eine komplette Referenz für MCISendstring? - zb. für Pause? Vielen Dank im Voraus, Daniel

Kommentar von Mario Zeller am 21.12.2000 um 21:50

Schau mal, ob du die CD im Windows CD-Player abspielen kannst. Wenn nicht, dann fehlt dir wohl ein Verbindungeskabel vom CD-ROM-Laufwerk zur SOundkarte

Kommentar von Nikki Klenk am 21.12.2000 um 15:25

Das Programm läuft soweit, das CD ROM Laufwerk springt an, die Länge der CD wird angezeigt, man kann zwischen den Titeln wechseln, doch es kommt kein Ton! Liegt es an meinen Einstellungen? Wie kann ich das Problem beseitigen?
Vielen Dank im Vorraus Nikki