Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

How to use DirectSound

Posted on 1999-08-03
9
Medium Priority
?
774 Views
Last Modified: 2012-05-04
How to use DirectSound in VB5/6?
0
Comment
Question by:wiltonk
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 2
  • 2
  • +1
9 Comments
 
LVL 6

Accepted Solution

by:
setiawan earned 400 total points
ID: 1529168
save as audioplayer.frm
VERSION 5.00
Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmAudioPlayer
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Audio player"
   ClientHeight    =   3300
   ClientLeft      =   2040
   ClientTop       =   1755
   ClientWidth     =   4965
   LinkMode        =   1  'Source
   LinkTopic       =   "Form2"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   3300
   ScaleWidth      =   4965
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   2460
      Top             =   1920
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      DialogTitle     =   "HCL Applications"
      FromPage        =   1
      Max             =   1000
      Min             =   1
      ToPage          =   1
   End
   Begin VB.CommandButton cmdExit
      Caption         =   "Exit"
      Height          =   405
      Left            =   3840
      TabIndex        =   14
      Top             =   150
      Width           =   825
   End
   Begin VB.CommandButton cmdWave
      BackColor       =   &H00C0FFFF&
      Caption         =   "Wave"
      Height          =   405
      Left            =   1410
      Style           =   1  'Graphical
      TabIndex        =   13
      Top             =   150
      Width           =   795
   End
   Begin VB.CommandButton cmdMidi
      BackColor       =   &H00FFFFC0&
      Caption         =   "Midi"
      Height          =   405
      Left            =   2220
      Style           =   1  'Graphical
      TabIndex        =   12
      Top             =   150
      Width           =   795
   End
   Begin VB.CommandButton cmdCD
      BackColor       =   &H00C0FFC0&
      Caption         =   "CD"
      Height          =   405
      Left            =   600
      Style           =   1  'Graphical
      TabIndex        =   11
      Top             =   150
      Width           =   795
   End
   Begin VB.CommandButton cmdToggleClock
      BackColor       =   &H00C0FFC0&
      Height          =   405
      Left            =   270
      Style           =   1  'Graphical
      TabIndex        =   10
      ToolTipText     =   "CD clock on/off"
      Top             =   150
      Width           =   315
   End
   Begin VB.Frame FraDevice
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2205
      Left            =   240
      TabIndex        =   1
      Top             =   840
      Width           =   4485
      Begin VB.CommandButton cmdVolDec
         Caption         =   "-"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   330
         Left            =   900
         TabIndex        =   17
         Top             =   330
         Width           =   255
      End
      Begin VB.TextBox txtTimeRun
         Alignment       =   2  'Center
         BackColor       =   &H80000001&
         Enabled         =   0   'False
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000003&
         Height          =   345
         Left            =   3090
         TabIndex        =   4
         Text            =   "txtTimeRun"
         Top             =   1170
         Width           =   1245
      End
      Begin VB.ComboBox cboTrack
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         Left            =   180
         TabIndex        =   3
         Text            =   "Combo1"
         Top             =   870
         Width           =   645
      End
      Begin VB.CommandButton cmdCDLoad
         BackColor       =   &H00C0FFC0&
         Caption         =   "~"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   13.5
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   345
         Left            =   3870
         Style           =   1  'Graphical
         TabIndex        =   2
         ToolTipText     =   "Load CD"
         Top             =   1710
         Width           =   525
      End
      Begin MCI.MMControl mmControl1
         Height          =   375
         Left            =   120
         TabIndex        =   5
         ToolTipText     =   "1 Prev/2 Next/3 Play/4 Pause/5 Back/6 Step/7 Stop/8 Record/9 Toggle eject"
         Top             =   1680
         Width           =   4290
         _ExtentX        =   7567
         _ExtentY        =   661
         _Version        =   393216
         BorderStyle     =   0
         DeviceType      =   ""
         FileName        =   ""
      End
      Begin MSComctlLib.ProgressBar prgVolume
         Height          =   390
         Left            =   1530
         TabIndex        =   16
         Top             =   300
         Width           =   2835
         _ExtentX        =   5001
         _ExtentY        =   688
         _Version        =   393216
         BorderStyle     =   1
         Appearance      =   1
      End
      Begin VB.PictureBox picVolume
         Height          =   375
         Index           =   1
         Left            =   1200
         ScaleHeight     =   315
         ScaleWidth      =   255
         TabIndex        =   19
         Top             =   300
         Width           =   315
         Begin VB.CommandButton cmdVolInc
            Caption         =   "+"
            BeginProperty Font
               Name            =   "MS Sans Serif"
               Size            =   9.75
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   315
            Left            =   0
            TabIndex        =   20
            Top             =   0
            Width           =   255
         End
      End
      Begin VB.PictureBox picVolume
         Height          =   375
         Index           =   0
         Left            =   870
         ScaleHeight     =   315
         ScaleWidth      =   255
         TabIndex        =   18
         Top             =   300
         Width           =   315
      End
      Begin VB.Label lblVolume
         Caption         =   "Volume:"
         Height          =   285
         Left            =   210
         TabIndex        =   9
         Top             =   420
         Width           =   585
      End
      Begin VB.Label lblDurationValue
         Caption         =   "lblDurationValue"
         Height          =   285
         Left            =   1080
         TabIndex        =   8
         Top             =   1320
         Width           =   495
      End
      Begin VB.Label lblDuration
         BackColor       =   &H00C0C0C0&
         Caption         =   "Duration:"
         Height          =   255
         Left            =   210
         TabIndex        =   7
         Top             =   1320
         Width           =   705
      End
      Begin VB.Label lblTotalTrack
         BackColor       =   &H00C0C0C0&
         Caption         =   "of total tracks:"
         Height          =   255
         Left            =   900
         TabIndex        =   6
         Top             =   930
         Width           =   1275
      End
   End
   Begin VB.CommandButton cmdStop
      Caption         =   "Stop"
      Height          =   405
      Left            =   3030
      TabIndex        =   0
      Top             =   150
      Width           =   795
   End
   Begin VB.Label Label1
      BorderStyle     =   1  'Fixed Single
      Height          =   465
      Left            =   240
      TabIndex        =   15
      Top             =   120
      Width           =   4455
   End
End
Attribute VB_Name = "frmAudioPlayer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' AudioPlayer.frm
'
' By Herman Liu
'
' An audio player with all essential functions; these include
' (1) adjustment of sound volumes of CD and WAVE; (2) direct
' selection of any CD track to play; (3) plays CD/WAVE/MIDI.
'
' For those who are frustrated for failing to a find a volume
' control for CD player on the sites and don't know how to
' make one, this source code shall definitely help).
'
' --------------------------------------------
' Note carefully: MDIChild=True for this form, i.e. this form
' should be loaded from MDI. This arrangement is to ensure
' free switch from CD to Wave/Midi, and vice versa, in the
' same play session without exiting (see comment in
' mmControl1_StopClick()
' --------------------------------------------
'
' APIs and type declarations are for user to adjust sound volume
Private Const conCDInterval = 1000
Private Const MMSYSERR_NOERROR = 0
Private Const MAXPNAMELEN = 32
Private Const MIXER_LONG_NAME_CHARS = 64
Private Const MIXER_SHORT_NAME_CHARS = 16
Private Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Private Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Private Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000&
     
Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = _
               (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
                     
Private Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE = _
               (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3)
     
Private Const MIXERLINE_COMPONENTTYPE_SRC_LINE = _
               (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2)
     
Private Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
Private Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
 
Private Const MIXERCONTROL_CONTROLTYPE_FADER = _
    (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)
     
Private Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)
     
Private Declare Function mixerClose Lib "WINMM.DLL" (ByVal hmx As Long) As Long
         
Private Declare Function mixerGetLineControls Lib "WINMM.DLL" _
    Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, _
    pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
                     
Private Declare Function mixerGetLineInfo Lib "WINMM.DLL" Alias "mixerGetLineInfoA" _
    (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
                     
Private Declare Function mixerOpen Lib "WINMM.DLL" (phmx As Long, _
    ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, _
    ByVal fdwOpen As Long) As Long
                     
Private Declare Function mixerSetControlDetails Lib "WINMM.DLL" _
    (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, _
    ByVal fdwDetails As Long) As Long
                     
Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" _
    (struct As Any, ByVal ptr As Long, ByVal cb As Long)
                     
Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" _
    (ByVal ptr As Long, struct As Any, ByVal cb As Long)
                     
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
    ByVal dwBytes As Long) As Long
                     
Private Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
                     
Private Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
     
Private Declare Function waveOutGetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, _
     lpdwVolume As Long) As Long
     
Private Declare Function waveOutSetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, _
     ByVal dwVolume As Long) As Long

     
Private Type MIXERCAPS
     wMid As Integer                   '  manufacturer id
     wPid As Integer                   '  product id
     vDriverVersion As Long            '  version of the driver
     szPname As String * MAXPNAMELEN   '  product name
     fdwSupport As Long                '  misc. support bits
     cDestinations As Long             '  count of destinations
End Type
     
Private Type MIXERCONTROL
     cbStruct As Long           '  size in Byte of MIXERCONTROL
     dwControlID As Long        '  unique control id for mixer device
     dwControlType As Long      '  MIXERCONTROL_CONTROLTYPE_xxx
     fdwControl As Long         '  MIXERCONTROL_CONTROLF_xxx
     cMultipleItems As Long     '  if MIXERCONTROL_CONTROLF_MULTIPLE set
     szShortName As String * MIXER_SHORT_NAME_CHARS  ' short name of control
     szName As String * MIXER_LONG_NAME_CHARS        ' long name of control
     lMinimum As Long           '  Minimum value
     lMaximum As Long           '  Maximum value
     reserved(10) As Long       '  reserved structure space
End Type
     
Private Type MIXERCONTROLDETAILS
     cbStruct As Long       '  size in Byte of MIXERCONTROLDETAILS
     dwControlID As Long    '  control id to get/set details on
     cChannels As Long      '  number of channels in paDetails array
     item As Long           '  hwndOwner or cMultipleItems
     cbDetails As Long      '  size of _one_ details_XX struct
     paDetails As Long      '  pointer to array of details_XX structs
End Type
     
Private Type MIXERCONTROLDETAILS_UNSIGNED
     dwValue As Long        '  value of the control
End Type
     
Private Type MIXERLINE
     cbStruct As Long               '  size of MIXERLINE structure
     dwDestination As Long          '  zero based destination index
     dwSource As Long               '  zero based source index (if source)
     dwLineID As Long               '  unique line id for mixer device
     fdwLine As Long                '  state/information about line
     dwUser As Long                 '  driver specific information
     dwComponentType As Long        '  component type line connects to
     cChannels As Long              '  number of channels line supports
     cConnections As Long           '  number of connections (possible)
     cControls As Long              '  number of controls at this line
     szShortName As String * MIXER_SHORT_NAME_CHARS
     szName As String * MIXER_LONG_NAME_CHARS
     dwType As Long
     dwDeviceID As Long
     wMid  As Integer
     wPid As Integer
     vDriverVersion As Long
     szPname As String * MAXPNAMELEN
End Type
     
Private Type MIXERLINECONTROLS
     cbStruct As Long       '  size in Byte of MIXERLINECONTROLS
     dwLineID As Long       '  line id (from MIXERLINE.dwLineID)
                            '  MIXER_GETLINECONTROLSF_ONEBYID or
     dwControl As Long      '  MIXER_GETLINECONTROLSF_ONEBYTYPE
     cControls As Long      '  count of controls pmxctrl points to
     cbmxctrl As Long       '  size in Byte of _one_ MIXERCONTROL
     pamxctrl As Long       '  pointer to first MIXERCONTROL array
End Type

Private Const conMCIErrInvalidDeviceID = 30257
Private Const conMCIErrDeviceOpen = 30263
Private Const conMCIErrCannotLoadDriver = 30266
Private Const conMCIErrUnsupportedFunction = 30274
Private Const conMCIErrInvalidFile = 30304

Private Const conWAVEInterval = 50
Private Const conWAVEIntervalPlus = 55

Private Type VOLSETTINGTYPE
    LeftVol As Integer
    RightVol As Integer
End Type

Private Type VOLTYPE
    mWaveVol As Long
End Type

Const VolStelVal = 5000
Const NegStepVal = 7500

Dim mCD As Boolean
Dim mWave As Boolean
Dim mMidi As Boolean
Dim mTracks As Integer
Dim hmixer As Long
Dim volCtrl As MIXERCONTROL    ' waveout volume control
Dim micCtrl As MIXERCONTROL    ' microphone volume control
Dim rc As Long
Dim OK As Boolean
Dim VolSetting As VOLSETTINGTYPE
Dim mVol As VOLTYPE
Dim LeftVol As Double, RightVol As Double
Dim mindex As String
Dim id As Long, mWaveVol As Long
Dim currTrack As Integer        ' current track No.
Dim TimeDispFlag As Boolean     'User chooses to show clock

Dim gmixervolume As Long
Dim gfso As FileSystemObject
Dim gcdg As Object



Private Sub Form_Load()
     mmControl1.Notify = False
     mmControl1.Wait = False
     mCD = False: mWave = False:  mMidi = False
     TimeDispFlag = True
     ButtonsOn True
        ' Tentatively set a reasonable starting volume level first
     gmixervolume = 30000
     Set gcdg = CommonDialog1
     Set gfso = New FileSystemObject
     Me.Move 0, 0
     CD_SetVolume hmixer, volCtrl, gmixervolume
End Sub



Private Sub cmdStop_Click()
     If mCD = False And mWave = False And mMidi = False Then
         Exit Sub
     End If
     mmControl1_StopClick (0)
End Sub



Private Sub cmdExit_Click()
     On Error Resume Next
     mmControl1.Command = "pause"
     mmControl1.UpdateInterval = 0
     mmControl1.To = mmControl1.Start
     mmControl1.Command = "Seek"
     mmControl1.Command = "close"
     Unload Me
End Sub



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
     On Error Resume Next
     mmControl1.Command = "pause"
     mmControl1.UpdateInterval = 0
     mmControl1.To = mmControl1.Start
     mmControl1.Command = "Seek"
     mmControl1.Command = "close"
End Sub



Private Sub ButtonsOn(Onoff As Boolean)
    If Not mmControl1.Mode = vbMCIModeNotOpen Then
        mmControl1.Command = "Close"
    End If

    cmdCDLoad.Visible = False    ' Till if cmdCD is chosen
    cboTrack.Clear
    cboTrack.Enabled = False
    txtTimeRun.Visible = False
    If Onoff Then
         mmControl1.Visible = False
         
         cmdToggleClock.Enabled = True
         cmdCD.Enabled = True
         cmdWave.Enabled = True
         cmdMidi.Enabled = True
         
           ' Volume
         lblVolume.Visible = False
         prgVolume.Visible = False
         picVolume(0).Visible = False
         picVolume(1).Visible = False
         cmdVolInc.Visible = False
         cmdVolDec.Visible = False
         
         FraDevice.Caption = ""
         lblTotalTrack.Visible = False
         cboTrack.Visible = False
         
         lblDuration.Visible = False
         lblDurationValue.Visible = False
         
    Else
         mmControl1.Visible = True
         
         cmdToggleClock.Enabled = False
         cmdCD.Enabled = False
         cmdWave.Enabled = False
         cmdMidi.Enabled = False
         
         lblDuration.Visible = True
         lblDurationValue.Caption = ""
         lblDurationValue.Visible = True
         
         If mCD Then
             lblTotalTrack.Caption = "of total tracks:"
             lblTotalTrack.Visible = True
             cboTrack.Visible = True
             lblVolume.Visible = True
             picVolume(0).Visible = True
             picVolume(1).Visible = True
             cmdVolInc.Caption = "+"
             cmdVolDec.Caption = "-"
             cmdVolInc.Visible = True
             cmdVolDec.Visible = True
               ' Unless user "+" or "-", display remains
             prgVolume.Visible = True
             ShowCDVolume
         ElseIf mWave Then
             lblVolume.Visible = True
             picVolume(0).Visible = True
             picVolume(1).Visible = True
             cmdVolInc.Caption = ">"
             cmdVolDec.Caption = "<"
             cmdVolInc.Visible = True
             cmdVolDec.Visible = True
         End If
    End If
End Sub



Private Sub ShowCDVolume()
    prgVolume.Value = gmixervolume / volCtrl.lMaximum * prgVolume.Max
End Sub



Private Sub cmdCD_Click()
    mCD = True
    mWave = False
    mMidi = False
    FraDevice.Caption = "CD Player"
    GoPlay1
End Sub



Private Sub cmdWave_Click()
    mCD = False
    mWave = True
    mMidi = False
    FraDevice.Caption = "WaveAudio"
    GoPlay2
End Sub




Private Sub cmdMidi_Click()
    mCD = False
    mWave = False
    mMidi = True
    FraDevice.Caption = "Sequencer"
    GoPlay2
End Sub




Private Sub cmdToggleClock_Click()
    TimeDispFlag = Not TimeDispFlag
    If TimeDispFlag Then
        cmdToggleClock.BackColor = &HC0FFC0
    Else
        cmdToggleClock.BackColor = &H8000000F
    End If
End Sub


Private Sub GoPlay1()
    If CDOpenMixer Then
        ButtonsOn False
        cmdCDLoad.Visible = True         ' Now let user see this button
    End If
End Sub



   ' Triggered by user clicking cmdCDLoad
Private Sub cmdCDLoad_Click()
    On Error GoTo MCIerrhandler
   
    With mmControl1
         .DeviceType = "CDAudio"
         .UpdateInterval = 0
    End With
   
    cmdCDLoad.Visible = False      ' User will see this again if eject CD
   
    mmControl1.TimeFormat = vbMCIFormatTmsf
   
    mmControl1.Command = "Open"
    mmControl1.Command = "pause"
    mTracks = mmControl1.Tracks
   
    mmControl1.To = mmControl1.Start
    mmControl1.Command = "Seek"
    DoEvents
      ' Fill list of track Nos.
    Dim i As Integer
    cboTrack.Clear
    For i = 1 To mTracks
         cboTrack.AddItem i
    Next i
    cboTrack.Text = cboTrack.List(0)
    DispTrackDuration
    mmControl1_PrevClick (0)         ' Ensure move to very start
       
    lblTotalTrack.Caption = "of total tracks: " & Str(mTracks)
   
    cboTrack.Enabled = True
    If TimeDispFlag Then
         txtTimeRun.Text = "[0]  00:00"
         txtTimeRun.Visible = True
    End If
   
    Exit Sub

MCIerrhandler:
    ShowMCIerr
End Sub



Private Sub cbotrack_click()
    cboTrack.ListIndex = Val(cboTrack.Text) - 1
    DispTrackDuration

    mmControl1.Command = "pause"
    mmControl1.TimeFormat = mciFormatTmsf
    mmControl1.UpdateInterval = conCDInterval
   
    mmControl1.To = Str$(cboTrack.ListIndex + 1)
    mmControl1.Command = "Seek"
   
    currTrack = cboTrack.ListIndex + 1
    mmControl1.Track = Str$(currTrack)
   
    txtTimeRun.Text = "[0]  00:00"
   
      ' Once in play, disallow cboTrack, until cmdCDLoad is clicked again
    cboTrack.Enabled = False
    mmControl1.Command = "Play"
End Sub




Private Sub DispTrackDuration()
    On Error Resume Next
    If mCD Then
         mmControl1.TimeFormat = mciFormatMilliseconds
         If Val(mmControl1.Track) <= 1 Then
             mmControl1.Track = "1"
         End If
         mmControl1.Track = cboTrack.Text
         lblDurationValue.Caption = ConvertMMSec(mmControl1.TrackLength)
         mmControl1.TimeFormat = mciFormatTmsf
    End If
End Sub
   


Private Sub CDUpdateTimeRun()
    mmControl1.TimeFormat = mciFormatMilliseconds
    txtTimeRun.Text = "[" & Str$(currTrack) & "]" & Space(2) & ConvertMMSec(mmControl1.Position - mmControl1.TrackPosition)
    mmControl1.TimeFormat = mciFormatTmsf
End Sub



Private Sub WAVEUpdateTimeRun()
    txtTimeRun.Text = Space(4) & ConvertMMSec(mmControl1.Position)
End Sub



Private Sub mmControl1_PlayClick(Cancel As Integer)
    If mCD Then
         txtTimeRun.Text = "[0]  00:00"
         If Val(mmControl1.Track) <= 1 Then
             mmControl1.Track = "1"
         End If
         cboTrack.Text = cboTrack.List(Val(mmControl1.Track) - 1)
         currTrack = Val(cboTrack.Text)
         DispTrackDuration
         mmControl1.UpdateInterval = conCDInterval
         cboTrack.Enabled = False
    Else
         mmControl1.UpdateInterval = conWAVEInterval
    End If
    mmControl1.Command = "play"
End Sub




Private Sub mmControl1_PrevClick(Cancel As Integer)
    mmControl1.UpdateInterval = 0
    mmControl1.Command = "Prev"
End Sub



Private Sub mmControl1_EjectClick(Cancel As Integer)
    On Error GoTo MCIerrhandler
      ' Since user has ejected CD, may use LoadCD button again
    cmdCDLoad.Visible = True
   
    mmControl1.UpdateInterval = 0
    mmControl1.Command = "Eject"
    mmControl1.Command = "Close"
    On Error GoTo 0
    Exit Sub
   
MCIerrhandler:
    ShowMCIerr
End Sub



Private Sub mmControl1_NextCompleted(ErrorCode As Long)
    If mCD Then
        cboTrack.Text = cboTrack.List(mmControl1.Track - 1)
        DispTrackDuration
        txtTimeRun.Text = "[0]  00:00"
    End If
    mmControl1.UpdateInterval = conCDInterval
End Sub



Private Sub mmControl1_PauseClick(Cancel As Integer)
    mmControl1.UpdateInterval = 0
End Sub



Private Sub mmControl1_PrevCompleted(ErrorCode As Long)
    If mCD Then
        cboTrack.Text = cboTrack.List(mmControl1.Track - 1)
        DispTrackDuration
        txtTimeRun.Text = "[0]  00:00"
    Else
        mmControl1.To = mmControl1.Start
        mmControl1.Command = "Seek"
        txtTimeRun.Text = Space(4) & "00:00"
    End If
    mmControl1.UpdateInterval = conCDInterval
End Sub



Private Sub mmControl1_StopClick(Cancel As Integer)
      ' If play "CD" first, no problem for subsequent play of Wave/Midi in
      ' the same session.  However, if play Wave/Midi first, then mmControl
      ' will no longer be valid if next play is for CD in the same session.
      ' Hence, if Wave/Midi, unload the form (if form MDIChild=True, then
      ' after the unload, form will still be reloaded automatically)
    On Error Resume Next
    mmControl1.UpdateInterval = 0
    If mCD Then
         lblDurationValue.Caption = ""
         cboTrack.Text = cboTrack.List(0)
         txtTimeRun.Visible = False
         mmControl1.Command = "pause"
         mmControl1.To = mmControl1.Start
         mmControl1.Command = "Seek"
         mmControl1.Command = "close"
    Else
         mmControl1.Command = "close"
         ' ----------------
         ' Note carefully: If frmAudioPlayer MDIChild=False, then open following line
         ' ----------------
         Unload Me
    End If
    ButtonsOn True
    mCD = False: mWave = False:  mMidi = False
End Sub




Private Sub MMControl1_StatusUpdate()
    If mCD Then
        '--------------------------------------------------
        ' Can't not rely on the value of "mmcontrol1.track";
        ' it simply wouldn't update.  Monitor the current
        ' track value with "mmcontrol1.Position AND &HFF"
        ' instead.
        '--------------------------------------------------
        Dim tmp
        tmp = mmControl1.Position And &HFF
          ' Set the track number to the current track.
        If tmp <> currTrack Then
            cboTrack.Text = cboTrack.List(tmp - 1)
            currTrack = Val(cboTrack.Text)
            DispTrackDuration
        End If
        If TimeDispFlag = True Then
            CDUpdateTimeRun
        End If
    Else
        If TimeDispFlag = True Then
            WAVEUpdateTimeRun
        End If
    End If
End Sub



Private Sub GoPlay2()
    On Error GoTo MCIerrhandler
    ButtonsOn False
    mmControl1.UpdateInterval = 0
    With gcdg
         .CancelError = True
         Select Case FraDevice.Caption
             Case "WaveAudio"
                 .DialogTitle = "WaveAudio"
                 .Filter = "(*.wav)|*.wav"
             Case "Sequencer"
                 .DialogTitle = "Sequencer"
                 .Filter = "(*.mid)|*.mid"
         End Select
         
         .FilterIndex = 1
         .Flags = vbOFNReadOnly Or vbOFNFileMustExist
         .FileName = ""
    End With
   
FileNameRetry:
    gcdg.ShowOpen
   
    If Not gfso.FileExists(gcdg.FileName) Then
        GoTo FileNameRetry
    End If
   
    Select Case UCase(FraDevice.Caption)
        Case "WAVEAUDIO"
            mmControl1.DeviceType = "WaveAudio"
        Case "SEQUENCER"
            mmControl1.DeviceType = "Sequencer"
    End Select
         
    With mmControl1
        .FileName = gcdg.FileName
        .Command = "Open"
        .UpdateInterval = conCDInterval
        .TimeFormat = vbMCIFormatMilliseconds
    End With
   
    On Error GoTo 0
   
    lblDurationValue.Caption = ConvertMMSec(mmControl1.Length)
   
    If TimeDispFlag Then
         txtTimeRun.Text = Space(4) & "00:00"
         txtTimeRun.Visible = True
    End If
     
    Exit Sub

MCIerrhandler:
    ButtonsOn True
    If Err.Number <> 32755 Then
         ShowMCIerr
    End If
End Sub



Private Sub cmdVolDec_Click()
    If mCD Then
        CD_DecVolumeProc
    ElseIf mWave Then
        WAVE_DecVolumeProc
    End If
End Sub
   

Private Sub cmdVolInc_Click()
    If mCD Then
        CD_IncVolumeProc
    ElseIf mWave Then
        WAVE_IncVolumeProc
    End If
End Sub


Private Function CDOpenMixer() As Boolean
    CDOpenMixer = True
      ' Open the mixer with deviceID 0.
    rc = mixerOpen(hmixer, 0, 0, 0, 0)
    If ((MMSYSERR_NOERROR <> rc)) Then
        MsgBox "Couldn't open the mixer."
        CDOpenMixer = False
        Exit Function
    End If
             
      ' Get the waveout volume control
    OK = CD_GetVolume(hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
              MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)
    If (OK = True) Then
        ' If the function successfully gets the volume control,
        ' the maximum and minimum values are specified by
        ' lMaximum and lMinimum
        Label1.Caption = volCtrl.lMinimum & " to " & volCtrl.lMaximum
    End If
           
        ' Get the microphone volume control
    OK = CD_GetVolume(hmixer, MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, _
             MIXERCONTROL_CONTROLTYPE_VOLUME, micCtrl)
 End Function
     
     
 Private Sub CD_DecVolumeProc()
     On Error Resume Next
     Dim cdvol As Long
     cdvol = gmixervolume - VolStepVal
     If cdvol < volCtrl.lMinimum Then
         cdvol = volCtrl.lMinimum
     End If
     CD_SetVolume hmixer, volCtrl, cdvol
     gmixervolume = cdvol
     ShowCDVolume
 End Sub
     
     
     
 Private Sub CD_IncVolumeProc()
     On Error Resume Next
     Dim cdvol As Long
     cdvol = gmixervolume + VolStepVal
     If cdvol > volCtrl.lMaximum Then
         cdvol = volCtrl.lMaximum
     End If
     CD_SetVolume hmixer, volCtrl, cdvol
     gmixervolume = cdvol
     ShowCDVolume
End Sub
 
 
 
Private Sub WAVE_DecVolumeProc()
    On Error Resume Next
    If mindex = "1" Then
        Exit Sub
    End If
    id = -0
    Dim i As Long
    i = waveOutGetVolume(id, mWaveVol)
    mVol.mWaveVol = mWaveVol
    LSet VolSetting = mVol
    LeftVol = VolSetting.LeftVol: RightVol = VolSetting.RightVol
    LeftVol = LeftVol - &HFFF
    RightVol = RightVol - &HFFF
    If LeftVol < -32768 Then LeftVol = 65535 + LeftVol
    If RightVol < -32768 Then RightVol = 65535 + RightVol
    VolSetting.LeftVol = LeftVol
    VolSetting.RightVol = RightVol
    LSet mVol = VolSetting
    mWaveVol = mVol.mWaveVol
    i = waveOutSetVolume(id, mWaveVol)
    WAVE_GetVolume
End Sub



Private Sub WAVE_IncVolumeProc()
    On Error Resume Next
    If mindex = "10" Then
        Exit Sub
    End If
    id = -0
    Dim i As Long
    i = waveOutGetVolume(id, mWaveVol)
    mVol.mWaveVol = mWaveVol
    LSet VolSetting = mVol
    LeftVol = VolSetting.LeftVol: RightVol = VolSetting.RightVol
    LeftVol = LeftVol + &HFFF
    RightVol = RightVol + &HFFF
    If LeftVol > 32767 Then LeftVol = LeftVol - 65536
    If RightVol > 32767 Then RightVol = RightVol - 65536
    VolSetting.LeftVol = LeftVol
    VolSetting.RightVol = RightVol
    LSet mVol = VolSetting
    mWaveVol = mVol.mWaveVol
    i = waveOutSetVolume(id, mWaveVol)
    WAVE_GetVolume
End Sub


Function WAVE_GetVolume() As Boolean
    On Error Resume Next
    WAVE_GetVolume = True
    id = -0
    Dim i As Long
    i = waveOutGetVolume(id, mWaveVol)
    If i <> 0 Then
        MsgBox "Couldn't get wave volume."
        WAVE_GetVolume = False
        Exit Function
    End If
    mVol.mWaveVol = mWaveVol
    LSet VolSetting = mVol
    LeftVol = VolSetting.LeftVol: RightVol = VolSetting.RightVol
    LeftVol = LeftVol - &HFFF
    RightVol = RightVol - &HFFF
    If LeftVol < -32768 Then LeftVol = 65535 + LeftVol
    If RightVol < -32768 Then RightVol = 65535 + RightVol
    VolSetting.LeftVol = LeftVol
    VolSetting.RightVol = RightVol
    LSet mVol = VolSetting
    mWaveVol = mVol.mWaveVol
    Dim mSign As String
    mSign = Left(LeftVol, 1)
   
    If mSign = "-" Then
        GoTo NegVal
    End If

    mindex = CStr(LeftVol / VolStepVal)
    If Val(mindex) < 1 Then mindex = "1"
    If Val(mindex) > 6 Then mindex = "6"
    Exit Function
   
NegVal:
    mindex = CStr((LeftVol * -1) / NegStepVal)
    If Val(mindex) < 7 Then mindex = "7"
    If Val(mindex) > 10 Then mindex = "10"
End Function


Private Sub ShowMCIerr()
    Dim msg As String
    Select Case Err
        Case conMCIErrCannotLoadDriver
            msg = "Error load media device driver."
        Case conMCIErrDeviceOpen
            msg = "The device is not open or is not known."
        Case conMCIErrInvalidDeviceID
            msg = "Invalid device id."
        Case conMCIErrInvalidDeviceID
            msg = "Invalid filename."
        Case conMCIErrUnsupportedFunction
            msg = "Action not available for this device."
        Case Else
            msg = "Unknown error (" + Str$(Err) + ")."
    End Select

    MsgBox msg, 48, conMCIAppTIitle
End Sub



Private Function ConvertMMSec(ByVal TimeIn As Long) As String
    Dim intH As Integer, intM As Integer, intS As Integer
    Dim tmp As Long
    Dim strTime As String
    tmp = TimeIn / 1000
    intH = Int(tmp / 3600)
    tmp = tmp Mod 3600
    intM = Int(tmp / 60)
    tmp = tmp Mod 60
    intS = tmp
    If intH > 0 Then
        strTime = Trim(Str(intH)) & ":"
    Else
        strTime = ""
    End If
    If intM >= 10 Then
        strTime = strTime & Trim(Str(intM))
    ElseIf intM > 0 Then
        strTime = strTime & "0" & Trim(Str(intM))
    Else
        strTime = strTime & "00"
    End If
    strTime = strTime & ":"
    If intS >= 10 Then
        strTime = strTime & Trim(Str(intS))
    ElseIf intS > 0 Then
        strTime = strTime & "0" & Trim(Str(intS))
    Else
        strTime = strTime & "00"
    End If
    ConvertMMSec = strTime
End Function


   
Private Function CD_GetVolume(ByVal hmixer As Long, ByVal componentType As Long, _
        ByVal ctrlType As Long, ByRef mxc As MIXERCONTROL) As Boolean
                             
    Dim mxlc As MIXERLINECONTROLS
    Dim mxl As MIXERLINE
    Dim hmem As Long
    Dim rc As Long
             
    mxl.cbStruct = Len(mxl)
    mxl.dwComponentType = componentType
     
    rc = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)
         
    If (MMSYSERR_NOERROR = rc) Then
         mxlc.cbStruct = Len(mxlc)
         mxlc.dwLineID = mxl.dwLineID
         mxlc.dwControl = ctrlType
         mxlc.cControls = 1
         mxlc.cbmxctrl = Len(mxc)
           
            ' Allocate a buffer for the control
         hmem = GlobalAlloc(&H40, Len(mxc))
         mxlc.pamxctrl = GlobalLock(hmem)
         mxc.cbStruct = Len(mxc)
             
             ' Get the control
         rc = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)
                 
         If (MMSYSERR_NOERROR = rc) Then
              CD_GetVolume = True
                 
                 ' Copy the control into the destination structure
              CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
         Else
              CD_GetVolume = False
         End If
         GlobalFree (hmem)
         Exit Function
     End If
 
     CD_GetVolume = False
End Function
     
     
     
Private Function CD_SetVolume(ByVal hmixer As Long, mxc As MIXERCONTROL, _
          ByVal volume As Long) As Boolean
                             
     Dim mxcd As MIXERCONTROLDETAILS
     Dim vol As MIXERCONTROLDETAILS_UNSIGNED
     
     mxcd.item = 0
     mxcd.dwControlID = mxc.dwControlID
     mxcd.cbStruct = Len(mxcd)
     mxcd.cbDetails = Len(vol)
         
       ' Allocate a buffer for the control value buffer
     hmem = GlobalAlloc(&H40, Len(vol))
     mxcd.paDetails = GlobalLock(hmem)
     mxcd.cChannels = 1
     vol.dwValue = volume
         
       ' Copy the data into the control value buffer
     CopyPtrFromStruct mxcd.paDetails, vol, Len(vol)
         
       ' Set the control value
     rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
         
     GlobalFree (hmem)
     If (MMSYSERR_NOERROR = rc) Then
          CD_SetVolume = True
     Else
          CD_SetVolume = False
     End If
End Function

save as frame.frm
VERSION 5.00
Begin VB.MDIForm frmFrame
   BackColor       =   &H8000000C&
   ClientHeight    =   3675
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   5295
   LinkTopic       =   "MDIForm1"
   StartUpPosition =   3  'Windows Default
   Begin VB.Menu mnuFile
      Caption         =   "File"
      Begin VB.Menu mnuAudio
         Caption         =   "Audio player"
      End
      Begin VB.Menu mnnExit
         Caption         =   "Exit"
      End
   End
End
Attribute VB_Name = "frmFrame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Frame.frm

Option Explicit



Private Sub MDIForm_Load()
    Me.WindowState = 2
    frmAudioPlayer.Show
End Sub



Private Sub mnuAudio_Click()
    frmAudioPlayer.Show
End Sub



Private Sub mnnExit_Click()
    End
End Sub




0
 

Author Comment

by:wiltonk
ID: 1529169
Cool! Can I use it to play mp3 files and can be mixed with multi-channel?
0
 
LVL 6

Expert Comment

by:setiawan
ID: 1529170
I'm not sure, because MCI devicetype only support
AVIVideo, CDAudio, DAT, DigitalVideo, MMMovie, Other, Overlay, Scanner, Sequencer, VCR, Videodisc, or WaveAudio.
To play MP3, try other for devicetype

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 6

Expert Comment

by:setiawan
ID: 1529171
No, It is not work to play MP3
If you want play MP3, you can use MediaPlayer instead of MCI
0
 

Author Comment

by:wiltonk
ID: 1529172
Yes. Using Media Player 6.1 is a great idea. Do you know how to play two mp3 file at the same time using Media Player?
0
 
LVL 6

Expert Comment

by:setiawan
ID: 1529173
Sorry, can't help you
I don't know how to do that

0
 

Expert Comment

by:eschoedl
ID: 6139888
Hey!

And what about DirectSound or DirectShow (DIRECTX!) ????


thanx.
0
 
LVL 1

Expert Comment

by:Moondancer
ID: 6872152
GREETINGS!

This question was awarded, but never cleared due to the JSP-500 errors of that time.  It was "stuck" against userID -1 versus the intended expert whom you awarded.  This corrects the problem and the expert will now receive these points; points verified.

Please click on your Member Profile and select "View Question History" to navigate through any open or locked questions you may have to update and finalize them.  If you are an EE Pro user, you can also choose Power Search to find all your open questions.

This is the Community Support link, if help is needed, along with the link to All Topics which reflects many TAs recently added.

http://www.experts-exchange.com/jsp/qList.jsp?ta=commspt
http://www.experts-exchange.com/jsp/zonesAll.jsp
 
Thank you,
Moondancer
Moderator @ Experts Exchange
0
 

Expert Comment

by:eschoedl
ID: 6876709
Hey! This is not DirectX ... With this you are using Windows Media Player ...
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses

715 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question