home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Visual Basic new SourceCode and Projects / CD-Player / Module2.bas < prev    next >
Encoding:
BASIC Source File  |  1999-10-20  |  2.9 KB  |  81 lines
  1. Attribute VB_Name = "Module2"
  2. Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal LpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
  3. Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLenght As Long, ByVal hwndCallback As Long) As Long
  4.  
  5. Private Const SND_SYNC As Long = &H0
  6. Private Const SND_ASYNC As Long = &H1
  7. Private Const SND_NODEFAULT As Long = &H2
  8. Private Const SND_LOOP As Long = &H8
  9. Private Const SND_FILENAME As Long = &H20000
  10. Private Const SND_DEFAULTPATH As String = "C:\Windows\media\"
  11.  
  12. Dim privPath As String
  13. Dim privNoDefault As Boolean
  14. Dim privAnzTracks As Integer
  15.  
  16. Option Explicit
  17. Property Get cdLength()
  18. Dim lngResult As Long
  19. Dim strBuffer As String
  20.  
  21. lngResult = mciSendString("open cdaudio", "", 0, 0)
  22. strBuffer = String$(256, vbNullChar)
  23. lngResult = mciSendString("status cdaudio number of tracks", strBuffer, Len(strBuffer), 0)
  24. privAnzTracks = Val(Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1))
  25. lngResult = mciSendString("close cd audio", "", 0, 0)
  26. cdLength = privAnzTracks
  27. End Property
  28. Public Sub playCdFull()
  29. Dim lngResult As Long
  30.  
  31. lngResult = mciSendString("open cdaudio", "", 0, 0)
  32. lngResult = mciSendString("play cdaudio", "", 0, 0)
  33. If lngResult > 0 Then
  34. ShapedForm.AXMarquee2.Text = "Keine Audio CD eingelegt"
  35. lngResult = mciSendString("stop cdaudio", "", 0, 0)
  36. lngResult = mciSendString("close cdaudio", "", 0, 0)
  37. End If
  38. End Sub
  39. Public Sub doorOpen()
  40. Dim lngResult As Long
  41. lngResult = mciSendString("open cdaudio", "", 0, 0)
  42. lngResult = mciSendString("set cdaudio door open", "", 0, 0)
  43. lngResult = mciSendString("close cdaudio", "", 0, 0)
  44. End Sub
  45. Public Sub doorClose()
  46. Dim lngResult As Long
  47. lngResult = mciSendString("open cdaudio", "", 0, 0)
  48. lngResult = mciSendString("set cdaudio door closed", "", 0, 0)
  49. lngResult = mciSendString("close cdaudio", "", 0, 0)
  50. End Sub
  51. Public Sub playCdTrack(track As Integer)
  52. Dim lngResult As Long
  53. lngResult = mciSendString("open cdaudio", "", 0, 0)
  54. lngResult = mciSendString("set cdaudio time format tmsf", "", 0, 0)
  55. If track < Module2.cdLength Then
  56.     lngResult = mciSendString("play cdaudio from " & track & " to " & track + 1, "", 0, 0)
  57. Else
  58.     lngResult = mciSendString("play cdaudio from " & track, "", 0, 0)
  59. End If
  60. lngResult = mciSendString("close cdaudio", "", 0, 0)
  61. End Sub
  62. Public Sub stopCd()
  63. Dim lngResult As Long
  64. lngResult = mciSendString("stop cdaudio", "", 0, 0)
  65. lngResult = mciSendString("close cdaudio", "", 0, 0)
  66. End Sub
  67. Public Sub playCdShuffle()
  68. Dim shuffle As Integer
  69. Randomize Timer
  70. shuffle = Int((Rnd * Module2.cdLength) + 1)
  71. playCdTrack (shuffle)
  72. End Sub
  73. Public Sub mute()
  74. Dim lngResult As Long
  75. lngResult = mciSendString("set cdaudio audio all off", "", 0, 0)
  76. End Sub
  77. Public Sub DeMute()
  78. Dim lngResult As Long
  79. lngResult = mciSendString("set cdaudio audio all on", "", 0, 0)
  80. End Sub
  81.