home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / deleti1r / audiopla.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-27  |  37.9 KB  |  1,108 lines
  1. VERSION 5.00
  2. Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  5. Begin VB.Form frmAudioPlayer 
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "Audio player"
  8.    ClientHeight    =   4140
  9.    ClientLeft      =   2040
  10.    ClientTop       =   1755
  11.    ClientWidth     =   4590
  12.    LinkMode        =   1  'Source
  13.    LinkTopic       =   "Form2"
  14.    LockControls    =   -1  'True
  15.    MaxButton       =   0   'False
  16.    MDIChild        =   -1  'True
  17.    ScaleHeight     =   4140
  18.    ScaleWidth      =   4590
  19.    Begin VB.PictureBox picFrame 
  20.       AutoSize        =   -1  'True
  21.       Height          =   3375
  22.       Left            =   90
  23.       Picture         =   "AudioPlayer.frx":0000
  24.       ScaleHeight     =   3315
  25.       ScaleWidth      =   4395
  26.       TabIndex        =   6
  27.       Top             =   720
  28.       Width           =   4455
  29.       Begin VB.PictureBox picVolume 
  30.          BackColor       =   &H00C0C0C0&
  31.          Height          =   405
  32.          Index           =   0
  33.          Left            =   660
  34.          ScaleHeight     =   345
  35.          ScaleWidth      =   255
  36.          TabIndex        =   12
  37.          Top             =   2160
  38.          Width           =   315
  39.          Begin VB.CommandButton cmdVolDec 
  40.             BackColor       =   &H00C0C0C0&
  41.             Caption         =   "-"
  42.             BeginProperty Font 
  43.                Name            =   "MS Sans Serif"
  44.                Size            =   9.75
  45.                Charset         =   0
  46.                Weight          =   700
  47.                Underline       =   0   'False
  48.                Italic          =   0   'False
  49.                Strikethrough   =   0   'False
  50.             EndProperty
  51.             Height          =   330
  52.             Left            =   0
  53.             Style           =   1  'Graphical
  54.             TabIndex        =   13
  55.             Top             =   0
  56.             Width           =   255
  57.          End
  58.       End
  59.       Begin VB.PictureBox picVolume 
  60.          BackColor       =   &H00808080&
  61.          Height          =   405
  62.          Index           =   1
  63.          Left            =   1020
  64.          ScaleHeight     =   345
  65.          ScaleWidth      =   255
  66.          TabIndex        =   10
  67.          Top             =   2160
  68.          Width           =   315
  69.          Begin VB.CommandButton cmdVolInc 
  70.             BackColor       =   &H00C0C0C0&
  71.             Caption         =   "+"
  72.             BeginProperty Font 
  73.                Name            =   "MS Sans Serif"
  74.                Size            =   9.75
  75.                Charset         =   0
  76.                Weight          =   700
  77.                Underline       =   0   'False
  78.                Italic          =   0   'False
  79.                Strikethrough   =   0   'False
  80.             EndProperty
  81.             Height          =   345
  82.             Left            =   0
  83.             Style           =   1  'Graphical
  84.             TabIndex        =   11
  85.             Top             =   0
  86.             Width           =   255
  87.          End
  88.       End
  89.       Begin VB.ComboBox cboTrack 
  90.          BackColor       =   &H00C0C0C0&
  91.          BeginProperty Font 
  92.             Name            =   "MS Sans Serif"
  93.             Size            =   8.25
  94.             Charset         =   0
  95.             Weight          =   700
  96.             Underline       =   0   'False
  97.             Italic          =   0   'False
  98.             Strikethrough   =   0   'False
  99.          EndProperty
  100.          ForeColor       =   &H80000007&
  101.          Height          =   315
  102.          Left            =   150
  103.          TabIndex        =   9
  104.          Text            =   "Combo1"
  105.          Top             =   1380
  106.          Width           =   645
  107.       End
  108.       Begin VB.TextBox txtTimeRun 
  109.          Alignment       =   2  'Center
  110.          BackColor       =   &H80000001&
  111.          Enabled         =   0   'False
  112.          BeginProperty Font 
  113.             Name            =   "MS Sans Serif"
  114.             Size            =   9.75
  115.             Charset         =   0
  116.             Weight          =   700
  117.             Underline       =   0   'False
  118.             Italic          =   0   'False
  119.             Strikethrough   =   0   'False
  120.          EndProperty
  121.          ForeColor       =   &H80000003&
  122.          Height          =   345
  123.          Left            =   2970
  124.          TabIndex        =   8
  125.          Text            =   "txtTimeRun"
  126.          Top             =   930
  127.          Width           =   1275
  128.       End
  129.       Begin VB.CommandButton cmdCDLoad 
  130.          BackColor       =   &H00C0C0C0&
  131.          Caption         =   "~"
  132.          BeginProperty Font 
  133.             Name            =   "MS Sans Serif"
  134.             Size            =   13.5
  135.             Charset         =   0
  136.             Weight          =   700
  137.             Underline       =   0   'False
  138.             Italic          =   0   'False
  139.             Strikethrough   =   0   'False
  140.          EndProperty
  141.          Height          =   345
  142.          Left            =   3810
  143.          Style           =   1  'Graphical
  144.          TabIndex        =   7
  145.          ToolTipText     =   "Load CD"
  146.          Top             =   390
  147.          Width           =   495
  148.       End
  149.       Begin MSComctlLib.ProgressBar prgVolume 
  150.          Height          =   195
  151.          Left            =   1440
  152.          TabIndex        =   14
  153.          Top             =   2280
  154.          Width           =   2745
  155.          _ExtentX        =   4842
  156.          _ExtentY        =   344
  157.          _Version        =   393216
  158.          BorderStyle     =   1
  159.          Appearance      =   0
  160.       End
  161.       Begin MCI.MMControl mmControl1 
  162.          Height          =   375
  163.          Left            =   30
  164.          TabIndex        =   15
  165.          Top             =   360
  166.          Width           =   4290
  167.          _ExtentX        =   7567
  168.          _ExtentY        =   661
  169.          _Version        =   393216
  170.          DeviceType      =   ""
  171.          FileName        =   ""
  172.       End
  173.       Begin VB.Line Line1 
  174.          X1              =   1440
  175.          X2              =   4170
  176.          Y1              =   2190
  177.          Y2              =   2190
  178.       End
  179.       Begin VB.Line Line2 
  180.          X1              =   1440
  181.          X2              =   4170
  182.          Y1              =   2550
  183.          Y2              =   2550
  184.       End
  185.       Begin VB.Label lblTotalTrack 
  186.          BackColor       =   &H00C0C0C0&
  187.          Caption         =   "of total tracks:"
  188.          BeginProperty Font 
  189.             Name            =   "MS Sans Serif"
  190.             Size            =   8.25
  191.             Charset         =   0
  192.             Weight          =   700
  193.             Underline       =   0   'False
  194.             Italic          =   0   'False
  195.             Strikethrough   =   0   'False
  196.          EndProperty
  197.          ForeColor       =   &H80000007&
  198.          Height          =   255
  199.          Left            =   960
  200.          TabIndex        =   18
  201.          Top             =   1410
  202.          Width           =   1965
  203.       End
  204.       Begin VB.Label lblDuration 
  205.          BackColor       =   &H00C0C0C0&
  206.          Caption         =   "Duration:"
  207.          BeginProperty Font 
  208.             Name            =   "MS Sans Serif"
  209.             Size            =   8.25
  210.             Charset         =   0
  211.             Weight          =   700
  212.             Underline       =   0   'False
  213.             Italic          =   0   'False
  214.             Strikethrough   =   0   'False
  215.          EndProperty
  216.          ForeColor       =   &H80000007&
  217.          Height          =   255
  218.          Left            =   150
  219.          TabIndex        =   17
  220.          Top             =   990
  221.          Width           =   825
  222.       End
  223.       Begin VB.Label lblDurationValue 
  224.          BackColor       =   &H00C0C0C0&
  225.          Caption         =   "lblDurationValue"
  226.          BeginProperty Font 
  227.             Name            =   "MS Sans Serif"
  228.             Size            =   8.25
  229.             Charset         =   0
  230.             Weight          =   700
  231.             Underline       =   0   'False
  232.             Italic          =   0   'False
  233.             Strikethrough   =   0   'False
  234.          EndProperty
  235.          ForeColor       =   &H80000007&
  236.          Height          =   285
  237.          Left            =   1020
  238.          TabIndex        =   16
  239.          Top             =   990
  240.          Width           =   1215
  241.       End
  242.    End
  243.    Begin VB.CommandButton cmdStop 
  244.       Height          =   345
  245.       Left            =   3690
  246.       Picture         =   "AudioPlayer.frx":2F7F2
  247.       Style           =   1  'Graphical
  248.       TabIndex        =   4
  249.       ToolTipText     =   "Stop"
  250.       Top             =   180
  251.       Width           =   375
  252.    End
  253.    Begin VB.CommandButton cmdExit 
  254.       Height          =   345
  255.       Left            =   4080
  256.       Picture         =   "AudioPlayer.frx":2FB74
  257.       Style           =   1  'Graphical
  258.       TabIndex        =   3
  259.       ToolTipText     =   "Exit"
  260.       Top             =   180
  261.       Width           =   375
  262.    End
  263.    Begin VB.CommandButton cmdDeviceCDPlayer 
  264.       Height          =   345
  265.       Left            =   2520
  266.       Picture         =   "AudioPlayer.frx":3036E
  267.       Style           =   1  'Graphical
  268.       TabIndex        =   2
  269.       ToolTipText     =   "CD Player"
  270.       Top             =   180
  271.       Width           =   375
  272.    End
  273.    Begin VB.CommandButton cmdDeviceWave 
  274.       Height          =   345
  275.       Left            =   2910
  276.       Picture         =   "AudioPlayer.frx":304B8
  277.       Style           =   1  'Graphical
  278.       TabIndex        =   1
  279.       ToolTipText     =   "Wave"
  280.       Top             =   180
  281.       Width           =   375
  282.    End
  283.    Begin VB.CommandButton cmdDeviceMidi 
  284.       Height          =   345
  285.       Left            =   3300
  286.       Picture         =   "AudioPlayer.frx":30CB2
  287.       Style           =   1  'Graphical
  288.       TabIndex        =   0
  289.       ToolTipText     =   "Midi"
  290.       Top             =   180
  291.       Width           =   375
  292.    End
  293.    Begin MSComDlg.CommonDialog CommonDialog1 
  294.       Left            =   1710
  295.       Top             =   120
  296.       _ExtentX        =   847
  297.       _ExtentY        =   847
  298.       _Version        =   393216
  299.       CancelError     =   -1  'True
  300.       DialogTitle     =   "HCL Applications"
  301.       FromPage        =   1
  302.       Max             =   1000
  303.       Min             =   1
  304.       ToPage          =   1
  305.    End
  306.    Begin VB.Label lblDevice 
  307.       Caption         =   "lblDevice"
  308.       BeginProperty Font 
  309.          Name            =   "MS Sans Serif"
  310.          Size            =   8.25
  311.          Charset         =   0
  312.          Weight          =   700
  313.          Underline       =   0   'False
  314.          Italic          =   0   'False
  315.          Strikethrough   =   0   'False
  316.       EndProperty
  317.       Height          =   345
  318.       Left            =   120
  319.       TabIndex        =   5
  320.       Top             =   210
  321.       Width           =   1485
  322.    End
  323. Attribute VB_Name = "frmAudioPlayer"
  324. Attribute VB_GlobalNameSpace = False
  325. Attribute VB_Creatable = False
  326. Attribute VB_PredeclaredId = True
  327. Attribute VB_Exposed = False
  328. ' AudioPlayer.frm
  329. ' By Herman Liu
  330. ' An audio player with all essential functions; these include
  331. ' (1) adjustment of sound volumes of CD and WAVE; (2) direct
  332. ' selection of any CD track to play; (3) plays CD/WAVE/MIDI.
  333. ' --------------------------------------------
  334. ' Note carefully: MDIChild=True for this form, i.e. this form
  335. ' should be loaded from MDI. This arrangement is to ensure
  336. ' free switch from CD to Wave/Midi, and vice versa, in the
  337. ' same play session without exiting (see comment in
  338. ' mmControl1_StopClick()
  339. ' --------------------------------------------
  340. ' APIs and type declarations are for user to adjust sound volume
  341. Private Const conCDInterval = 1000
  342. Private Const MMSYSERR_NOERROR = 0
  343. Private Const MAXPNAMELEN = 32
  344. Private Const MIXER_LONG_NAME_CHARS = 64
  345. Private Const MIXER_SHORT_NAME_CHARS = 16
  346. Private Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
  347. Private Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
  348. Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
  349. Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
  350. Private Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000&
  351.       
  352. Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = _
  353.                (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
  354.                      
  355. Private Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE = _
  356.                (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3)
  357.       
  358. Private Const MIXERLINE_COMPONENTTYPE_SRC_LINE = _
  359.                (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2)
  360.       
  361. Private Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
  362. Private Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
  363. Private Const MIXERCONTROL_CONTROLTYPE_FADER = _
  364.     (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)
  365.       
  366. Private Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)
  367.       
  368. Private Declare Function mixerClose Lib "WINMM.DLL" (ByVal hmx As Long) As Long
  369.          
  370. Private Declare Function mixerGetLineControls Lib "WINMM.DLL" _
  371.     Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, _
  372.     pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
  373.                      
  374. Private Declare Function mixerGetLineInfo Lib "WINMM.DLL" Alias "mixerGetLineInfoA" _
  375.     (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
  376.                      
  377. Private Declare Function mixerOpen Lib "WINMM.DLL" (phmx As Long, _
  378.     ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, _
  379.     ByVal fdwOpen As Long) As Long
  380.                      
  381. Private Declare Function mixerSetControlDetails Lib "WINMM.DLL" _
  382.     (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, _
  383.     ByVal fdwDetails As Long) As Long
  384.                      
  385. Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" _
  386.     (struct As Any, ByVal ptr As Long, ByVal cb As Long)
  387.                      
  388. Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" _
  389.     (ByVal ptr As Long, struct As Any, ByVal cb As Long)
  390.                      
  391. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
  392.     ByVal dwBytes As Long) As Long
  393.                      
  394. Private Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long
  395.                      
  396. Private Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
  397.       
  398. Private Declare Function waveOutGetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, _
  399.      lpdwVolume As Long) As Long
  400.      
  401. Private Declare Function waveOutSetVolume Lib "WINMM.DLL" (ByVal uDeviceID As Long, _
  402.      ByVal dwVolume As Long) As Long
  403.       
  404. Private Type MIXERCAPS
  405.      wMid As Integer                   '  manufacturer id
  406.      wPid As Integer                   '  product id
  407.      vDriverVersion As Long            '  version of the driver
  408.      szPname As String * MAXPNAMELEN   '  product name
  409.      fdwSupport As Long                '  misc. support bits
  410.      cDestinations As Long             '  count of destinations
  411. End Type
  412.       
  413. Private Type MIXERCONTROL
  414.      cbStruct As Long           '  size in Byte of MIXERCONTROL
  415.      dwControlID As Long        '  unique control id for mixer device
  416.      dwControlType As Long      '  MIXERCONTROL_CONTROLTYPE_xxx
  417.      fdwControl As Long         '  MIXERCONTROL_CONTROLF_xxx
  418.      cMultipleItems As Long     '  if MIXERCONTROL_CONTROLF_MULTIPLE set
  419.      szShortName As String * MIXER_SHORT_NAME_CHARS  ' short name of control
  420.      szName As String * MIXER_LONG_NAME_CHARS        ' long name of control
  421.      lMinimum As Long           '  Minimum value
  422.      lMaximum As Long           '  Maximum value
  423.      reserved(10) As Long       '  reserved structure space
  424. End Type
  425.       
  426. Private Type MIXERCONTROLDETAILS
  427.      cbStruct As Long       '  size in Byte of MIXERCONTROLDETAILS
  428.      dwControlID As Long    '  control id to get/set details on
  429.      cChannels As Long      '  number of channels in paDetails array
  430.      item As Long           '  hwndOwner or cMultipleItems
  431.      cbDetails As Long      '  size of _one_ details_XX struct
  432.      paDetails As Long      '  pointer to array of details_XX structs
  433. End Type
  434.       
  435. Private Type MIXERCONTROLDETAILS_UNSIGNED
  436.      dwValue As Long        '  value of the control
  437. End Type
  438.       
  439. Private Type MIXERLINE
  440.      cbStruct As Long               '  size of MIXERLINE structure
  441.      dwDestination As Long          '  zero based destination index
  442.      dwSource As Long               '  zero based source index (if source)
  443.      dwLineID As Long               '  unique line id for mixer device
  444.      fdwLine As Long                '  state/information about line
  445.      dwUser As Long                 '  driver specific information
  446.      dwComponentType As Long        '  component type line connects to
  447.      cChannels As Long              '  number of channels line supports
  448.      cConnections As Long           '  number of connections (possible)
  449.      cControls As Long              '  number of controls at this line
  450.      szShortName As String * MIXER_SHORT_NAME_CHARS
  451.      szName As String * MIXER_LONG_NAME_CHARS
  452.      dwType As Long
  453.      dwDeviceID As Long
  454.      wMid  As Integer
  455.      wPid As Integer
  456.      vDriverVersion As Long
  457.      szPname As String * MAXPNAMELEN
  458. End Type
  459.       
  460. Private Type MIXERLINECONTROLS
  461.      cbStruct As Long       '  size in Byte of MIXERLINECONTROLS
  462.      dwLineID As Long       '  line id (from MIXERLINE.dwLineID)
  463.                             '  MIXER_GETLINECONTROLSF_ONEBYID or
  464.      dwControl As Long      '  MIXER_GETLINECONTROLSF_ONEBYTYPE
  465.      cControls As Long      '  count of controls pmxctrl points to
  466.      cbmxctrl As Long       '  size in Byte of _one_ MIXERCONTROL
  467.      pamxctrl As Long       '  pointer to first MIXERCONTROL array
  468. End Type
  469. Private Const conMCIErrInvalidDeviceID = 30257
  470. Private Const conMCIErrDeviceOpen = 30263
  471. Private Const conMCIErrCannotLoadDriver = 30266
  472. Private Const conMCIErrUnsupportedFunction = 30274
  473. Private Const conMCIErrInvalidFile = 30304
  474. Private Const conWAVEInterval = 50
  475. Private Const conWAVEIntervalPlus = 55
  476. Private Type VOLSETTINGTYPE
  477.     LeftVol As Integer
  478.     RightVol As Integer
  479. End Type
  480. Private Type VOLTYPE
  481.     mWaveVol As Long
  482. End Type
  483. Const VolStepVal = 5000
  484. Const NegStepVal = 7500
  485. Dim mCD As Boolean
  486. Dim mWave As Boolean
  487. Dim mMidi As Boolean
  488. Dim mTracks As Integer
  489. Dim hmixer As Long
  490. Dim volCtrl As MIXERCONTROL    ' waveout volume control
  491. Dim micCtrl As MIXERCONTROL    ' microphone volume control
  492. Dim rc As Long
  493. Dim OK As Boolean
  494. Dim VolSetting As VOLSETTINGTYPE
  495. Dim mVol As VOLTYPE
  496. Dim LeftVol As Double, RightVol As Double
  497. Dim mindex As String
  498. Dim id As Long, mWaveVol As Long
  499. Dim currTrack As Integer        ' current track No.
  500. Dim gmixervolume As Long
  501. Dim gcdg As Object
  502. Private Sub Form_Load()
  503.      mmControl1.Notify = False
  504.      mmControl1.Wait = False
  505.      mCD = False: mWave = False:  mMidi = False
  506.      ButtonsOn True
  507.      prgVolume.Max = 100
  508.         ' Tentatively set a reasonable starting volume level first
  509.      gmixervolume = 30000
  510.      Set gcdg = CommonDialog1
  511.      Me.Move 0, 0
  512.      CD_SetVolume hmixer, volCtrl, gmixervolume
  513. End Sub
  514. Private Sub cmdStop_Click()
  515.      If mCD = False And mWave = False And mMidi = False Then
  516.          Exit Sub
  517.      End If
  518.      mmControl1_StopClick (0)
  519. End Sub
  520. Private Sub cmdExit_Click()
  521.      On Error Resume Next
  522.      mmControl1.Command = "pause"
  523.      mmControl1.UpdateInterval = 0
  524.      mmControl1.To = mmControl1.Start
  525.      mmControl1.Command = "Seek"
  526.      mmControl1.Command = "close"
  527.      Unload Me
  528. End Sub
  529. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  530.      On Error Resume Next
  531.      mmControl1.Command = "pause"
  532.      mmControl1.UpdateInterval = 0
  533.      mmControl1.To = mmControl1.Start
  534.      mmControl1.Command = "Seek"
  535.      mmControl1.Command = "close"
  536. End Sub
  537. Private Sub ButtonsOn(Onoff As Boolean)
  538.     ' If the device is open, close it.
  539.     If Not mmControl1.Mode = vbMCIModeNotOpen Then
  540.         mmControl1.Command = "Close"
  541.     End If
  542.     cmdCDLoad.Visible = False    ' Till if cmdCD is chosen
  543.     cboTrack.Clear
  544.     cboTrack.Enabled = False
  545.     txtTimeRun.Visible = False
  546.     If Onoff Then
  547.          mmControl1.Visible = False
  548.          
  549.          cmdDeviceCDPlayer.Enabled = True
  550.          cmdDeviceWave.Enabled = True
  551.          cmdDeviceMidi.Enabled = True
  552.          
  553.          lblDevice.Caption = ""
  554.          
  555.            ' Volume
  556.          Line1.Visible = False
  557.          Line2.Visible = False
  558.          prgVolume.Visible = False
  559.          picVolume(0).Visible = False
  560.          picVolume(1).Visible = False
  561.          cmdVolInc.Visible = False
  562.          cmdVolDec.Visible = False
  563.          
  564.          lblTotalTrack.Visible = False
  565.          cboTrack.Visible = False
  566.          
  567.          lblDuration.Visible = False
  568.          lblDurationValue.Visible = False
  569.          
  570.     Else
  571.          mmControl1.Visible = True
  572.          
  573.          cmdDeviceCDPlayer.Enabled = False
  574.          cmdDeviceWave.Enabled = False
  575.          cmdDeviceMidi.Enabled = False
  576.          
  577.          lblDuration.Visible = True
  578.          lblDurationValue.Caption = ""
  579.          lblDurationValue.Visible = True
  580.          
  581.          If mCD Then
  582.              lblTotalTrack.Caption = "of total tracks:"
  583.              lblTotalTrack.Visible = True
  584.              cboTrack.Visible = True
  585.              
  586.              Line1.Visible = True
  587.              Line2.Visible = True
  588.              picVolume(0).Visible = True
  589.              picVolume(1).Visible = True
  590.              cmdVolInc.Caption = "+"
  591.              cmdVolDec.Caption = "-"
  592.              cmdVolInc.Visible = True
  593.              cmdVolDec.Visible = True
  594.              prgVolume.Visible = True
  595.              ShowCDVolume
  596.          ElseIf mWave Then
  597.              picVolume(0).Visible = True
  598.              picVolume(1).Visible = True
  599.              cmdVolInc.Caption = ">"
  600.              cmdVolDec.Caption = "<"
  601.              cmdVolInc.Visible = True
  602.              cmdVolDec.Visible = True
  603.          End If
  604.     End If
  605. End Sub
  606. Private Sub ShowCDVolume()
  607.     prgVolume.Value = gmixervolume / volCtrl.lMaximum * prgVolume.Max
  608. End Sub
  609. Private Sub cmdDeviceCDPlayer_Click()
  610.     mCD = True
  611.     mWave = False
  612.     mMidi = False
  613.     lblDevice.Caption = "CD Player"
  614.     GoPlay1
  615. End Sub
  616. Private Sub cmdDeviceWave_Click()
  617.     mCD = False
  618.     mWave = True
  619.     mMidi = False
  620.     lblDevice.Caption = "WaveAudio"
  621.     GoPlay2
  622. End Sub
  623. Private Sub cmdDeviceMidi_Click()
  624.     mCD = False
  625.     mWave = False
  626.     mMidi = True
  627.     lblDevice.Caption = "Sequencer"
  628.     GoPlay2
  629. End Sub
  630. Private Sub GoPlay1()
  631.     If CDOpenMixer Then
  632.         ButtonsOn False
  633.         cmdCDLoad.Visible = True         ' Now let user see this button
  634.     End If
  635. End Sub
  636.    ' Triggered by user clicking cmdCDLoad
  637. Private Sub cmdCDLoad_Click()
  638.     ' Open the CD device -- the disc must already be in the drive.
  639.     On Error GoTo MCIerrhandler
  640.     With mmControl1
  641.          .DeviceType = "CDAudio"
  642.          .UpdateInterval = 0
  643.     End With
  644.     cmdCDLoad.Visible = False      ' User will see this again if eject CD
  645.     mmControl1.TimeFormat = vbMCIFormatTmsf
  646.     mmControl1.Command = "Open"
  647.     mmControl1.Command = "pause"
  648.     mTracks = mmControl1.Tracks
  649.     mmControl1.To = mmControl1.Start
  650.     mmControl1.Command = "Seek"
  651.     DoEvents
  652.       ' Fill list of track Nos.
  653.     Dim i As Integer
  654.     cboTrack.Clear
  655.     For i = 1 To mTracks
  656.          cboTrack.AddItem i
  657.     Next i
  658.     cboTrack.Text = cboTrack.List(0)
  659.     DispTrackDuration
  660.     mmControl1_PrevClick (0)       ' Ensure move to very start
  661.         
  662.     lblTotalTrack.Caption = "of total tracks: " & Str(mTracks)
  663.     cboTrack.Enabled = True
  664.     txtTimeRun.Text = "[0]  00:00"
  665.     txtTimeRun.Visible = True
  666.     Exit Sub
  667. MCIerrhandler:
  668.     ShowMCIerr
  669. End Sub
  670. Private Sub cbotrack_click()
  671.        ' Set cboTrack value first
  672.     cboTrack.ListIndex = Val(cboTrack.Text) - 1
  673.     DispTrackDuration
  674.     mmControl1.Command = "pause"
  675.     mmControl1.TimeFormat = mciFormatTmsf
  676.     mmControl1.UpdateInterval = conCDInterval
  677.     mmControl1.To = Str$(cboTrack.ListIndex + 1)
  678.     mmControl1.Command = "Seek"
  679.     currTrack = cboTrack.ListIndex + 1
  680.     mmControl1.Track = Str$(currTrack)
  681.     txtTimeRun.Text = "[0]  00:00"
  682.       ' Once in play, disallow cboTrack, until cmdCDLoad is clicked again
  683.     cboTrack.Enabled = False
  684.     mmControl1.Command = "Play"
  685. End Sub
  686. Private Sub DispTrackDuration()
  687.     On Error Resume Next
  688.     If mCD Then
  689.          mmControl1.TimeFormat = mciFormatMilliseconds
  690.           ' Set track before calling to get tracklength
  691.          If Val(mmControl1.Track) <= 1 Then
  692.              mmControl1.Track = "1"
  693.          End If
  694.          mmControl1.Track = cboTrack.Text
  695.          lblDurationValue.Caption = ConvertMMSec(mmControl1.TrackLength)
  696.          mmControl1.TimeFormat = mciFormatTmsf
  697.     End If
  698. End Sub
  699. Private Sub CDUpdateTimeRun()
  700.     mmControl1.TimeFormat = mciFormatMilliseconds
  701.     txtTimeRun.Text = "[" & Str$(currTrack) & "]" & Space(2) & ConvertMMSec(mmControl1.Position - mmControl1.TrackPosition)
  702.     mmControl1.TimeFormat = mciFormatTmsf
  703. End Sub
  704. Private Sub WAVEUpdateTimeRun()
  705.     txtTimeRun.Text = Space(4) & ConvertMMSec(mmControl1.Position)
  706. End Sub
  707. Private Sub mmControl1_PlayClick(Cancel As Integer)
  708.      ' Set the number of milliseconds between successive StatusUpdate events.
  709.     If mCD Then
  710.          txtTimeRun.Text = "[0]  00:00"
  711.          If Val(mmControl1.Track) <= 1 Then
  712.              mmControl1.Track = "1"
  713.          End If
  714.          cboTrack.Text = cboTrack.List(Val(mmControl1.Track) - 1)
  715.          currTrack = Val(cboTrack.Text)
  716.          DispTrackDuration
  717.          mmControl1.UpdateInterval = conCDInterval
  718.            ' Once in play, disallow cboTrack, until cmdCDLoad is clicked again
  719.          cboTrack.Enabled = False
  720.     Else
  721.          mmControl1.UpdateInterval = conWAVEInterval
  722.     End If
  723.     mmControl1.Command = "play"
  724. End Sub
  725. Private Sub mmControl1_PrevClick(Cancel As Integer)
  726.     mmControl1.UpdateInterval = 0
  727.     mmControl1.Command = "Prev"
  728. End Sub
  729. Private Sub mmControl1_EjectClick(Cancel As Integer)
  730.     On Error GoTo MCIerrhandler
  731.       ' Since user has ejected CD, may use LoadCD button again
  732.     cmdCDLoad.Visible = True
  733.     mmControl1.UpdateInterval = 0
  734.     mmControl1.Command = "Eject"
  735.     mmControl1.Command = "Close"
  736.     On Error GoTo 0
  737.     Exit Sub
  738. MCIerrhandler:
  739.     ShowMCIerr
  740. End Sub
  741. Private Sub mmControl1_NextCompleted(ErrorCode As Long)
  742.     If mCD Then
  743.         cboTrack.Text = cboTrack.List(mmControl1.Track - 1)
  744.         DispTrackDuration
  745.         txtTimeRun.Text = "[0]  00:00"
  746.     End If
  747.     mmControl1.UpdateInterval = conCDInterval
  748. End Sub
  749. Private Sub mmControl1_PauseClick(Cancel As Integer)
  750.     mmControl1.UpdateInterval = 0
  751. End Sub
  752. Private Sub mmControl1_PrevCompleted(ErrorCode As Long)
  753.     If mCD Then
  754.         cboTrack.Text = cboTrack.List(mmControl1.Track - 1)
  755.         DispTrackDuration
  756.         txtTimeRun.Text = "[0]  00:00"
  757.     Else
  758.         mmControl1.To = mmControl1.Start
  759.         mmControl1.Command = "Seek"
  760.         txtTimeRun.Text = Space(4) & "00:00"
  761.     End If
  762.     mmControl1.UpdateInterval = conCDInterval
  763. End Sub
  764. Private Sub mmControl1_StopClick(Cancel As Integer)
  765.     On Error Resume Next
  766.     mmControl1.UpdateInterval = 0
  767.     If mCD Then
  768.          lblDurationValue.Caption = ""
  769.          cboTrack.Text = cboTrack.List(0)
  770.          txtTimeRun.Visible = False
  771.          mmControl1.Command = "pause"
  772.          mmControl1.To = mmControl1.Start
  773.          mmControl1.Command = "Seek"
  774.          mmControl1.Command = "close"
  775.     Else
  776.          mmControl1.Command = "CLOSE"
  777.          Unload Me
  778.     End If
  779.     ButtonsOn True
  780.     mCD = False: mWave = False:  mMidi = False
  781. End Sub
  782. Private Sub MMControl1_StatusUpdate()
  783.     If mCD Then
  784.         '--------------------------------------------------
  785.         ' Can't not rely on the value of "mmcontrol1.track";
  786.         ' it simply wouldn't update.
  787.         '--------------------------------------------------
  788.         Dim tmp
  789.         tmp = mmControl1.Position And &HFF
  790.           ' Set the track number to the current track.
  791.         If tmp <> currTrack Then
  792.             cboTrack.Text = cboTrack.List(tmp - 1)
  793.             currTrack = Val(cboTrack.Text)
  794.             DispTrackDuration
  795.         End If
  796.         CDUpdateTimeRun
  797.     Else
  798.         WAVEUpdateTimeRun
  799.     End If
  800. End Sub
  801. Private Sub GoPlay2()
  802.     On Error GoTo MCIerrhandler
  803.     ButtonsOn False
  804.     mmControl1.UpdateInterval = 0
  805.     With gcdg
  806.          .CancelError = True
  807.          Select Case lblDevice.Caption
  808.              Case "WaveAudio"
  809.                  .DialogTitle = "WaveAudio"
  810.                  .Filter = "(*.wav)|*.wav"
  811.              Case "Sequencer"
  812.                  .DialogTitle = "Sequencer"
  813.                  .Filter = "(*.mid)|*.mid"
  814.          End Select
  815.          .FilterIndex = 1
  816.          .Flags = vbOFNReadOnly Or vbOFNFileMustExist
  817.          .FileName = ""
  818.     End With
  819.     gcdg.Flags = cdlOFNFileMustExi
  820.     gcdg.ShowOpen
  821.     Select Case UCase(lblDevice.Caption)
  822.         Case "WAVEAUDIO"
  823.             mmControl1.DeviceType = "WaveAudio"
  824.         Case "SEQUENCER"
  825.             mmControl1.DeviceType = "Sequencer"
  826.     End Select
  827.          
  828.     With mmControl1
  829.         .FileName = gcdg.FileName
  830.         .Command = "Open"
  831.         .UpdateInterval = conCDInterval
  832.         .TimeFormat = vbMCIFormatMilliseconds
  833.     End With
  834.     On Error GoTo 0
  835.     lblDurationValue.Caption = ConvertMMSec(mmControl1.Length)
  836.     txtTimeRun.Text = Space(4) & "00:00"
  837.     txtTimeRun.Visible = True
  838.      
  839.     Exit Sub
  840. MCIerrhandler:
  841.     ButtonsOn True
  842.     If Err.Number <> 32755 Then
  843.          ShowMCIerr
  844.     End If
  845. End Sub
  846. Private Sub cmdVolDec_Click()
  847.     If mCD Then
  848.         CD_DecVolumeProc
  849.     ElseIf mWave Then
  850.         WAVE_DecVolumeProc
  851.     End If
  852. End Sub
  853. Private Sub cmdVolInc_Click()
  854.     If mCD Then
  855.         CD_IncVolumeProc
  856.     ElseIf mWave Then
  857.         WAVE_IncVolumeProc
  858.     End If
  859. End Sub
  860. Private Function CDOpenMixer() As Boolean
  861.     CDOpenMixer = True
  862.       ' Open the mixer with deviceID 0.
  863.     rc = mixerOpen(hmixer, 0, 0, 0, 0)
  864.     If ((MMSYSERR_NOERROR <> rc)) Then
  865.         MsgBox "Couldn't open the mixer."
  866.         CDOpenMixer = False
  867.         Exit Function
  868.     End If
  869.              
  870.       ' Get the waveout volume control
  871.     OK = CD_GetVolume(hmixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, _
  872.               MIXERCONTROL_CONTROLTYPE_VOLUME, volCtrl)
  873.         ' Get the microphone volume control
  874.     OK = CD_GetVolume(hmixer, MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, _
  875.              MIXERCONTROL_CONTROLTYPE_VOLUME, micCtrl)
  876.  End Function
  877.       
  878.       
  879.       
  880.  Private Sub CD_DecVolumeProc()
  881.      On Error Resume Next
  882.      Dim cdvol As Long
  883.      cdvol = gmixervolume - VolStepVal
  884.      If cdvol < volCtrl.lMinimum Then
  885.          cdvol = volCtrl.lMinimum
  886.      End If
  887.      CD_SetVolume hmixer, volCtrl, cdvol
  888.      gmixervolume = cdvol
  889.      ShowCDVolume
  890.  End Sub
  891.       
  892.       
  893.       
  894.  Private Sub CD_IncVolumeProc()
  895.      On Error Resume Next
  896.      Dim cdvol As Long
  897.      cdvol = gmixervolume + VolStepVal
  898.      If cdvol > volCtrl.lMaximum Then
  899.          cdvol = volCtrl.lMaximum
  900.      End If
  901.      CD_SetVolume hmixer, volCtrl, cdvol
  902.      gmixervolume = cdvol
  903.      ShowCDVolume
  904.  End Sub
  905. Private Sub WAVE_DecVolumeProc()
  906.     On Error Resume Next
  907.     If mindex = "1" Then
  908.         Exit Sub
  909.     End If
  910.     id = -0
  911.     Dim i As Long
  912.     i = waveOutGetVolume(id, mWaveVol)
  913.     mVol.mWaveVol = mWaveVol
  914.     LSet VolSetting = mVol
  915.     LeftVol = VolSetting.LeftVol: RightVol = VolSetting.RightVol
  916.     LeftVol = LeftVol - &HFFF
  917.     RightVol = RightVol - &HFFF
  918.     If LeftVol < -32768 Then LeftVol = 65535 + LeftVol
  919.     If RightVol < -32768 Then RightVol = 65535 + RightVol
  920.     VolSetting.LeftVol = LeftVol
  921.     VolSetting.RightVol = RightVol
  922.     LSet mVol = VolSetting
  923.     mWaveVol = mVol.mWaveVol
  924.     i = waveOutSetVolume(id, mWaveVol)
  925.     WAVE_GetVolume
  926. End Sub
  927. Private Sub WAVE_IncVolumeProc()
  928.     On Error Resume Next
  929.     If mindex = "10" Then
  930.         Exit Sub
  931.     End If
  932.     id = -0
  933.     Dim i As Long
  934.     i = waveOutGetVolume(id, mWaveVol)
  935.     mVol.mWaveVol = mWaveVol
  936.     LSet VolSetting = mVol
  937.     LeftVol = VolSetting.LeftVol: RightVol = VolSetting.RightVol
  938.     LeftVol = LeftVol + &HFFF
  939.     RightVol = RightVol + &HFFF
  940.     If LeftVol > 32767 Then LeftVol = LeftVol - 65536
  941.     If RightVol > 32767 Then RightVol = RightVol - 65536
  942.     VolSetting.LeftVol = LeftVol
  943.     VolSetting.RightVol = RightVol
  944.     LSet mVol = VolSetting
  945.     mWaveVol = mVol.mWaveVol
  946.     i = waveOutSetVolume(id, mWaveVol)
  947.     WAVE_GetVolume
  948. End Sub
  949. Function WAVE_GetVolume() As Boolean
  950.     On Error Resume Next
  951.     WAVE_GetVolume = True
  952.     id = -0
  953.     Dim i As Long
  954.     i = waveOutGetVolume(id, mWaveVol)
  955.     If i <> 0 Then
  956.         MsgBox "Couldn't get wave volume."
  957.         WAVE_GetVolume = False
  958.         Exit Function
  959.     End If
  960.     mVol.mWaveVol = mWaveVol
  961.     LSet VolSetting = mVol
  962.     LeftVol = VolSetting.LeftVol: RightVol = VolSetting.RightVol
  963.     LeftVol = LeftVol - &HFFF
  964.     RightVol = RightVol - &HFFF
  965.     If LeftVol < -32768 Then LeftVol = 65535 + LeftVol
  966.     If RightVol < -32768 Then RightVol = 65535 + RightVol
  967.     VolSetting.LeftVol = LeftVol
  968.     VolSetting.RightVol = RightVol
  969.     LSet mVol = VolSetting
  970.     mWaveVol = mVol.mWaveVol
  971.     Dim mSign As String
  972.     mSign = Left(LeftVol, 1)
  973.     If mSign = "-" Then
  974.         GoTo NegVal
  975.     End If
  976.     mindex = CStr(LeftVol / VolStepVal)
  977.     If Val(mindex) < 1 Then mindex = "1"
  978.     If Val(mindex) > 6 Then mindex = "6"
  979.     Exit Function
  980. NegVal:
  981.     mindex = CStr((LeftVol * -1) / NegStepVal)
  982.     If Val(mindex) < 7 Then mindex = "7"
  983.     If Val(mindex) > 10 Then mindex = "10"
  984. End Function
  985. Private Sub ShowMCIerr()
  986.     Dim msg As String
  987.     Select Case Err
  988.         Case conMCIErrCannotLoadDriver
  989.             msg = "Error load media device driver."
  990.         Case conMCIErrDeviceOpen
  991.             msg = "The device is not open or is not known."
  992.         Case conMCIErrInvalidDeviceID
  993.             msg = "Invalid device id."
  994.         Case conMCIErrInvalidDeviceID
  995.             msg = "Invalid filename."
  996.         Case conMCIErrUnsupportedFunction
  997.             msg = "Action not available for this device."
  998.         Case Else
  999.             msg = "Unknown error (" + Str$(Err) + ")."
  1000.     End Select
  1001.     MsgBox msg, 48, conMCIAppTIitle
  1002. End Sub
  1003. Private Function ConvertMMSec(ByVal TimeIn As Long) As String
  1004.     Dim intH As Integer, intM As Integer, intS As Integer
  1005.     Dim tmp As Long
  1006.     Dim strTime As String
  1007.     tmp = TimeIn / 1000
  1008.     intH = Int(tmp / 3600)
  1009.     tmp = tmp Mod 3600
  1010.     intM = Int(tmp / 60)
  1011.     tmp = tmp Mod 60
  1012.     intS = tmp
  1013.     If intH > 0 Then
  1014.         strTime = Trim(Str(intH)) & ":"
  1015.     Else
  1016.         strTime = ""
  1017.     End If
  1018.     If intM >= 10 Then
  1019.         strTime = strTime & Trim(Str(intM))
  1020.     ElseIf intM > 0 Then
  1021.         strTime = strTime & "0" & Trim(Str(intM))
  1022.     Else
  1023.         strTime = strTime & "00"
  1024.     End If
  1025.     strTime = strTime & ":"
  1026.     If intS >= 10 Then
  1027.         strTime = strTime & Trim(Str(intS))
  1028.     ElseIf intS > 0 Then
  1029.         strTime = strTime & "0" & Trim(Str(intS))
  1030.     Else
  1031.         strTime = strTime & "00"
  1032.     End If
  1033.     ConvertMMSec = strTime
  1034. End Function
  1035. Private Function CD_GetVolume(ByVal hmixer As Long, ByVal componentType As Long, _
  1036.         ByVal ctrlType As Long, ByRef mxc As MIXERCONTROL) As Boolean
  1037.                               
  1038.     Dim mxlc As MIXERLINECONTROLS
  1039.     Dim mxl As MIXERLINE
  1040.     Dim hmem As Long
  1041.     Dim rc As Long
  1042.              
  1043.     mxl.cbStruct = Len(mxl)
  1044.     mxl.dwComponentType = componentType
  1045.       
  1046.     rc = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)
  1047.          
  1048.     If (MMSYSERR_NOERROR = rc) Then
  1049.          mxlc.cbStruct = Len(mxlc)
  1050.          mxlc.dwLineID = mxl.dwLineID
  1051.          mxlc.dwControl = ctrlType
  1052.          mxlc.cControls = 1
  1053.          mxlc.cbmxctrl = Len(mxc)
  1054.             
  1055.             ' Allocate a buffer for the control
  1056.          hmem = GlobalAlloc(&H40, Len(mxc))
  1057.          mxlc.pamxctrl = GlobalLock(hmem)
  1058.          mxc.cbStruct = Len(mxc)
  1059.              
  1060.          rc = mixerGetLineControls(hmixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE)
  1061.                   
  1062.          If (MMSYSERR_NOERROR = rc) Then
  1063.               CD_GetVolume = True
  1064.                  
  1065.                  ' Copy the control into the destination structure
  1066.               CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
  1067.          Else
  1068.               CD_GetVolume = False
  1069.          End If
  1070.          GlobalFree (hmem)
  1071.          Exit Function
  1072.      End If
  1073.      CD_GetVolume = False
  1074. End Function
  1075.       
  1076.       
  1077.       
  1078. Private Function CD_SetVolume(ByVal hmixer As Long, mxc As MIXERCONTROL, _
  1079.           ByVal volume As Long) As Boolean
  1080.                               
  1081.      Dim mxcd As MIXERCONTROLDETAILS
  1082.      Dim vol As MIXERCONTROLDETAILS_UNSIGNED
  1083.       
  1084.      mxcd.item = 0
  1085.      mxcd.dwControlID = mxc.dwControlID
  1086.      mxcd.cbStruct = Len(mxcd)
  1087.      mxcd.cbDetails = Len(vol)
  1088.          
  1089.        ' Allocate a buffer for the control value buffer
  1090.      hmem = GlobalAlloc(&H40, Len(vol))
  1091.      mxcd.paDetails = GlobalLock(hmem)
  1092.      mxcd.cChannels = 1
  1093.      vol.dwValue = volume
  1094.          
  1095.        ' Copy the data into the control value buffer
  1096.      CopyPtrFromStruct mxcd.paDetails, vol, Len(vol)
  1097.          
  1098.        ' Set the control value
  1099.      rc = mixerSetControlDetails(hmixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE)
  1100.          
  1101.      GlobalFree (hmem)
  1102.      If (MMSYSERR_NOERROR = rc) Then
  1103.           CD_SetVolume = True
  1104.      Else
  1105.           CD_SetVolume = False
  1106.      End If
  1107. End Function
  1108.