Wir wollen einen CDPlayer proggen - klar. Aber: Wir möchten keine externen Controls und Komponenten einsetzen - auch klar. Und: Alle wichtigen Funktionen, wie Abspielen, Pause, Stoppen, nächster Titel usw. sollen vorhanden sein - Logisch! Wie? Staun Alles mit nur einer einzigen Windows-API Funktion! Ja, Sie haben richtig gelesen. Mit dem Einsatz einer einzigen Windows-API Funktion lässt sich ein vollständiger CDPlayer programmieren, mit allen wichtigen Bedienfunktionen. Apropos Bedienfunktionen: Folgende Anforderungen stellen wir an den CDPlayer:
Wie würden Sie jetzt vorgehen? Aber es geht auch ohne Control! Machen wir es nicht länger spannend ' benötigte API-Deklaration, auf der der gesamte ' CD-Player aufbaut 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 Gestaltung der Oberfläche unseres CDPlayers Bevor wir uns an das Coden machen, überlegen wir uns erst einmal, wie wir unseren CDPlayer designen möchten - sprich Oberflächengestaltung ist angesagt. Starten wir also die Visual Basic Entwicklungsumgebung und erstellen ein neues Projekt. Der Form geben wir den Namen frmPlayer. Weitere Eigenschaften der Form:
Welche Anzeige- und Bedienelemente brauchen wir?
Die Bedienknöpfe... Platzieren Sie die Schaltflächen wie folgt auf der Form und geben diesen die in der Abbildung genannten Namen (cmdPlay, cmdPause, cmdStop usw.)
Hiermit wäre das Design schon fast abgeschlossen. Neben den Schaltflächen zur Titelwahl könnte man nun zusätzlich noch eine Combo-Listbox auf die Form setzen, über der man dann zur Laufzeit ein bestimmtes Lied auswählen kann. Die Liste enthält demnach immer die Anzahl Lieder auf der CD. Zusätzlich zeigen wir in der Liste dann noch die Spieldauer der einzelnen Tracks an. Platzieren wir also direkt unterhalb des Display und der Schaltflächen eine ComboBox mit folgenden Eigenschaften:
Wir wollen aber kein eckiges Standard-Window
Wie aber soll das Fenster später vom Anwender verschoben werden können, wenn es keine Titelleiste enthält? Die Antwort liefert uns folgender Tipp:
Und damit Sie sich jetzt Tipparbeit sparen, haben wir die gesamten hier benötigten Tipps in ein BAS-Modul zusammengefasst, welches Sie sich jetzt downloaden und Ihrem Projekt hinzufügen sollten.
Hiermit wäre das Designen der Oberfläche abgeschlossen. Zur Laufzeit bekommt unser CDPlayer dann nachfolgendes "Gesicht".
Halt! Wir brauchen ja noch einen Button, um das Fenster schließen zu können. Platzieren Sie also noch schnell einen CommandButton auf die Form, nennen diesen cmdExit und tragen als Caption ebenfalls Exit ein. Code-Grundgerüst der Form Bald geht es ans Eingemachte Option Explicit Const ColorFrom = &HA56B39 Const ColorTo = &HF9DAB5 Private Sub Form_Load() ' Form verformen Dim rgn As Long ' Rechteckige Region mit runden Ecken rgn = CreateRoundRectRgn(0, 0, _ Me.Width / Screen.TwipsPerPixelX, _ Me.Height / Screen.TwipsPerPixelY, _ 20, 20) ' Region an ein Fenster verweisen. SetWindowRgn Me.hWnd, rgn, True ' Danach wird der Speicherbereich der Region ' freigegeben ...und fertig DeleteObject rgn ' Farbverlauf oben nach unten MakeGradient Me, ColorFrom, ColorTo, 1 End Sub Damit der Farbverlauf auch immer schön angezeigt wird, ist es notwendig, MakeGradient ebenfalls im Form_Resize aufzurufen: Private Sub Form_Resize() ' Farbverlauf neu zeichnen! MakeGradient Me, ColorFrom, ColorTo, 1 End Sub Da unsere Form über keine Titelleiste verfügt, und somit auch nicht über diese verschoben werden kann, benötigen wir folgenden Code. Dieser ermöglicht es uns die Form zur Laufzeit zu verschieben, indem man auf einen freien Bereich des Fensters klickt und bei gedrückter Maustaste die Form an die gewünschte Position auf dem Desktop zieht. ' Form verschieben ermöglichen Private Sub Form_MouseDown(Button As Integer, _ Shift As Integer, x As Single, Y As Single) Dim lResult As Long If Button = 1 Then Call ReleaseCapture lResult = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, _ HTCAPTION, 0&) End If End SubÜber den Exit-Button soll der CDPlayer geschlossen werden: Private Sub cmdExit_Click() ' Schließen Unload Me End End Sub Starten Sie jetzt ruhig einmal das Projekt und testen, ob die Form wie gewünscht angezeigt wird, und ob sich die Form auch verschieben lässt. CD-Informationen lesen und Display aktualisieren Aber jetzt - jetzt geht es ans Eingemachte. Wir coden die CD-Funktionen![]() Auslesen der Audio-CD Informationen ' benötigte API-Deklaration, auf der der gesamte ' CD-Player aufbaut 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 ' UDT für Track-Infos Private Type TrackInfo nPosition As Long nLength As Long End Type Private UDT_Track() As TrackInfo Private bCDPlay As Boolean Private bPause As Boolean Private iTracks As Integer Private iTrack As Integer Private lTotalLength As Long Private Enum eShowMode iShowTotal = 0 iShowTrack = 1 End Enum Ergänzen Sie das Form_Load Event wie folgt: Private Sub Form_Load() ... ' Jetzt aktuelle CD-Info auslesen CD_Init End Sub Und hier natürlich der entsprechende Code zum Ermitteln der CD-Informationen: ' CD initialisieren Private Sub CD_Init(Optional ByVal bClose As Boolean = True) Dim nResult As Long Dim I As Integer ' zunächst alles stoppen bCDPlay = False SendCommand "stop cdaudio" SendCommand "close cdaudio" ' CD-Audio öffnen und Zeitformat festlegen SendCommand "open cdaudio" SendCommand "set cdaudio time format milliseconds" ' Gesamtzeit ermitteln lTotalLength = SendCommand("status cdaudio length") ' Anzahl Tracks, sowie einzelne Track-Länge ' ermitteln (wir gehen mal von max. 100 Tracks aus) iTracks = 0 cmbTracks.Clear cmbTracks.AddItem "(Lied auswählen)" cmbTracks.ListIndex = 0 For I = 1 To 100 nResult = SendCommand("status cdaudio position track " & _ CStr(I)) ' kein Track mehr verfügbar? If nResult = 0 Then Exit For ' Track-Info ermitteln iTracks = iTracks + 1 ReDim Preserve UDT_Track(iTracks) With UDT_Track(I) .nPosition = nResult .nLength = SendCommand("status cdaudio length track " & _ CStr(I)) cmbTracks.AddItem "[" & Format$(I, "00") & "] " & _ CD_FormatTime(.nLength) End With Next I ' CD-Audio schließen If bClose Then SendCommand "close cdaudio" ' Display aktualisieren Display_Show iShowTotal End Sub Als nächstes proggen wir den Code, um das CD-Display entsprechend zu aktualisieren. Hierbei gibt es drei unterschiedliche Anzeigen:
' Display aktualisieren Private Sub Display_Show(nMode As eShowMode) Dim nResult As Long With lblDisplay If iTracks > 0 Then If nMode = iShowTotal Then ' Gesamt-Info anzeigen .Caption = "[" & Format$(iTracks, "00") & "] " & _ "<" & CD_FormatTime(lTotalLength) & ">" Else ' Track-Info anzeigen If bCDPlay Then ' bisher gespielte Zeit nResult = SendCommand("status cdaudio position") - _ UDT_Track(iTrack).nPosition .Caption = "[" & Format$(iTrack, "00") & "] " & _ "<" & CD_FormatTime(nResult) & ">" Else ' Track + Dauer .Caption = "[" & Format$(iTrack, "00") & "] " & _ "<" & CD_FormatTime(UDT_Track(iTrack).nLength) & ">" End If End If Else ' keine CD oder keine Audio-CD .Caption = "[NO DISC]" End If End With ' ComboBox aktualisieren cmbTracks.Tag = "NoAction" If iTracks > 0 And bCDPlay Then cmbTracks.ListIndex = iTrack Else cmbTracks.ListIndex = 0 End If cmbTracks.Tag = "" ' Schaltflächen aktualisieren cmdPlay.Enabled = ((iTracks > 0) And (Not bCDPlay Or bPause)) cmdPause.Enabled = (iTracks > 0 And bCDPlay And Not bPause) cmdStop.Enabled = (iTracks > 0 And bCDPlay) cmdPrev.Enabled = (iTracks > 0 And iTrack > 1) cmdRew.Enabled = (iTracks > 0 And bCDPlay) cmdFwd.Enabled = (iTracks > 0 And bCDPlay) cmdNext.Enabled = (iTracks > 0 And iTrack < iTracks) cmdEject.Enabled = True End Sub Wie Sie sehen nutzen wir hier auch gleich die Möglichkeit, die Bedienschaltflächen entsprechend der gerade laufenden Aktion zu aktualisieren. So lässt sich z.B. der "Play"-Knopf nur dann anwählen, wenn eine CD im Laufwerk liegt und kein Abspielvorgang gestartet ist. Die mciSendString-Funktion liefert uns alle Zeitangaben in Millisekunden. Im Display möchten wir aber nicht Millisekunden stehen haben, sondern Minuten:Sekunden (mm:ss). Also müssen wir die Millisekunden-Angaben entsprechend umrechnen und formatieren: ' Millisekunden nach mm:ss umrechnen Private Function CD_FormatTime(ByVal lMSec As Long) As String Dim iMin As Integer Dim iSec As Integer iSec = Int(lMSec / 1000) iMin = Int(iSec / 60) iSec = iSec - (iMin * 60) CD_FormatTime = Format$(iMin, "00") & ":" & Format$(iSec, "00") End Function Die Funktion SendCommand ist nur eine Hilfsfunktion, über der wir ein Kommando an die mciSendString API-Funktion schicken und das Ergebnis im Funktionsrückgabewert zurückbekommen: ' MCI-Kommando senden Private Function SendCommand(ByVal sCommand As String) _ As Long Dim nResult As Long Dim sReturn As String sReturn = Space$(256) nResult = mciSendString(sCommand, sReturn, _ Len(sReturn), 0&) SendCommand = Val(sReturn) End Function Legen Sie eine Audio-CD in das CDROM-Laufwerk und starten anschließend das Projekt. Das Display sollte nun die Anzahl Tracks, sowie die Gesamtspielzeit der CD anzeigen. Weiterhin ist die Combo-Listbox (cmbTracks) mit den Zeit-Informationen der einzelnen Tracks gefüllt. Fehlen jetzt nur noch die Abspiel-Funktionen. Mehr dazu gleich. Implementierung der CD-Funktionen Bevor wir uns den einzelnen Abspiel-Funktionen widmen, überlegen wir noch kurz: Das Display soll ja ständig den aktuellen Status anzeigen. Also entweder [No Disc] oder eben die entsprechenden CD-Informationen. Wird ein Track gerade abgespielt, soll im Display die aktuelle Spieldauer angezeigt werden. Demnach brauchen wir noch einen Timer, mit dem wir in kurzen Zeitabständen die Aktivitäten des CDROM-Laufwerks prüfen. Platzieren Sie also noch ein Timer-Control auf die Form und setzen die Eigenschaft Interval auf den Wert 500 (Millisekunden). Immer wenn das Timer_Event ausgelöst wird, fragen wir den aktuellen CD-Status ab: Private Sub Timer1_Timer() ' aktuellen Track ermitteln iTrack = SendCommand("status cdaudio current track") ' keine CD eingelegt If iTracks = 0 Or SendCommand("status cdaudio length") = 0 Then CD_Init Else ' aktuellen Track ermitteln If bCDPlay Then Display_Show iShowTrack Else Display_Show iShowTotal End If End If End Sub Abspielen, Pause und Stoppen Wie bereits eingangs unseres Workshops erwähnt, lassen sich alle CD-Funktionen mit nur einer einzigen API-Funktion realisieren. Hier der entsprechende Code:Private Sub cmdPlay_Click() ' Wiedergabe starten picDisplay.SetFocus If iTrack < 1 Then iTrack = 1 SendCommand "open cdaudio" SendCommand "set cdaudio time format milliseconds" SendCommand "play cdaudio" bCDPlay = True bPause = False Timer1_Timer End Sub Private Sub cmdPause_Click() ' Pause picDisplay.SetFocus SendCommand "stop cdaudio" bPause = True Timer1_Timer End Sub Private Sub cmdStop_Click() ' Wiedergabe stoppen picDisplay.SetFocus SendCommand "stop cdaudio" SendCommand "close cdaudio" bCDPlay = False bPause = False iTrack = 1 Timer1_Timer End Sub Titelwechsel und schnelles Vor-/Zurückspulen Private Sub cmdNext_Click() ' nächstes Lied picDisplay.SetFocus iTrack = iTrack + 1 SendCommand "play cdaudio from " & UDT_Track(iTrack).nPosition bCDPlay = True: bPause = False Timer1_Timer End Sub Private Sub cmdPrev_Click() ' voriges Lied picDisplay.SetFocus iTrack = iTrack - 1 SendCommand "play cdaudio from " & UDT_Track(iTrack).nPosition bCDPlay = True: bPause = False Timer1_Timer End Sub Private Sub cmdRew_Click() ' Zurückspulen Dim nPos As Long ' 3 Sekunden zurück picDisplay.SetFocus nPos = SendCommand("status cdaudio position") - 3000 If nPos < 0 Then nPos = 0 SendCommand "play cdaudio from " & nPos Timer1_Timer End Sub Private Sub cmdFwd_Click() ' Vorspulen Dim nPos As Long ' 3 Sekunden vor picDisplay.SetFocus nPos = SendCommand("status cdaudio position") + 3000 SendCommand "play cdaudio from " & nPos Timer1_Timer End Sub CD auswerfen (CDROM-Laufwerk öffnen) Private Sub cmdEject_Click() ' CD auswerfen cmdStop.Value = True SendCommand "set cdaudio door open" End Sub Titel-Direktwahl Fehlt jetzt nur noch die Direktwahl eines Titels aus der ComboBox-Liste: Private Sub cmbTracks_Click() ' Track manuell auswählen und starten With cmbTracks If .Tag <> "NoAction" And .ListIndex > 0 Then iTrack = .ListIndex If Not bCDPlay Then SendCommand "open cdaudio" SendCommand "set cdaudio time format milliseconds" End If SendCommand "play cdaudio from " & _ UDT_Track(iTrack).nPosition bCDPlay = True: bPause = False Timer1_Timer End If End With End Sub CDPlayer-Fenster schließen Wird unser CDPlayer beendet, d.h. das Fenster geschlossen, stoppen wir eine evtl. laufende CD-Wiedergabe und schließen den MCI-Device: Private Sub Form_Unload(Cancel As Integer) ' alles stoppen bCDPlay = False SendCommand "stop cdaudio" SendCommand "close cdaudio" End Sub Zusammenfassung Mit Hilfe unseres Workshops "CDPlayer - Marke Eigenbau" haben Sie jetzt nicht nur erfahren, wie sich mit Hilfe der API-Funktion mciSendString die Abspielfunktionen eines CDPlayers realisieren lassen, sondern auch, wie man eine Oberfläche designt und in welchen Schritten man bei der Programmierung eines solchen Projekts vorgeht. Hier noch mal eine kurze Zusammenfassung der mciSendString-Kommandos:
Und nun viel Spaß mit Ihrem neuen CDPlayer Dieser Workshop wurde bereits 17.388 mal aufgerufen.
Anzeige
![]() ![]() ![]() (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevISDN 1.0 ![]() Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats ![]() Dieter Otter sevTabStrip: Rechtsklick auf Reiter erkennen Eine Funktion, mit der sich prüfen lässt, auf welchen Tab-Reiter ein Mausklick erfolgte sevWizard für VB5/6 ![]() Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |