Re: Problem with winmm.dll under Win2000/XP



Hello,

here is the code, hat runs VERY WELL inWindows 95 & Windows 98:

Code Module1.bas:
--------------------
Option Explicit

Public RetVal As Long 'Return-Code (API)
Public hmixer As Long ' Mixer-Handle

Public Const GMEM_FIXED = &H0 ' Zeiger auf den Speicher für die Funktion
GlobalAlloc
Public Const DEVICEID = 0
Public Const MMSYSERR_NOERROR = 0
Public Const MAXPNAMELEN = 32
Public Const MIXER_LONG_NAME_CHARS = 64
Public Const MIXER_SHORT_NAME_CHARS = 16
Public Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Public Const MIXER_GETCONTROLDETAILSF_VALUE = &H0&
Public Const MIXER_GETCONTROLDETAILSF_LISTTEXT& = &H1&
Public Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Public Const MIXER_OBJECTF_WAVEOUT& = &H10000000
Public Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Public Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
Public Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
Public Const MIXERCONTROL_CONTROLTYPE_FADER = (MIXERCONTROL_CT_CLASS_FADER
Or MIXERCONTROL_CT_UNITS_UNSIGNED)
Public Const MIXERCONTROL_CONTROLTYPE_VOLUME =
(MIXERCONTROL_CONTROLTYPE_FADER + 1)
'--------------------------------------------------------------------------------
Public Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000&
Public Const MIXERLINE_COMPONENTTYPE_SRC_UNDEFINED =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 0)
Public Const MIXERLINE_COMPONENTTYPE_SRC_DIGITAL =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 1)
Public Const MIXERLINE_COMPONENTTYPE_SRC_LINE =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2)
Public Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3)
Public Const MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 4)
Public Const MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 5)
Public Const MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 6)
Public Const MIXERLINE_COMPONENTTYPE_SRC_PCSPEAKER =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 7)
Public Const MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 8)
Public Const MIXERLINE_COMPONENTTYPE_SRC_AUXILIARY =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 9)
Public Const MIXERLINE_COMPONENTTYPE_SRC_ANALOG =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 10)
Public Const MIXERLINE_COMPONENTTYPE_SRC_LAST =
(MIXERLINE_COMPONENTTYPE_SRC_FIRST + 10)

Public Const MIXERLINE_COMPONENTTYPE_DST_FIRST& = &H0&
Public Const MIXERLINE_COMPONENTTYPE_DST_UNDEFINED =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 0)
Public Const MIXERLINE_COMPONENTTYPE_DST_DIGITAL =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 1)
Public Const MIXERLINE_COMPONENTTYPE_DST_LINE =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 2)
Public Const MIXERLINE_COMPONENTTYPE_DST_MONITOR =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 3)
Public Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
Public Const MIXERLINE_COMPONENTTYPE_DST_HEADPHONES =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 5)
Public Const MIXERLINE_COMPONENTTYPE_DST_TELEPHONE =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 6)
Public Const MIXERLINE_COMPONENTTYPE_DST_WAVEIN =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 7)
Public Const MIXERLINE_COMPONENTTYPE_DST_VOICEIN =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 8)
Public Const MIXERLINE_COMPONENTTYPE_DST_LAST =
(MIXERLINE_COMPONENTTYPE_DST_FIRST + 8)

Public Const MIXERCONTROL_CT_UNITS_SIGNED = &H20000
Public Const MIXERCONTROL_CT_CLASS_METER = &H10000000
Public Const MIXERCONTROL_CT_SC_METER_POLLED = &H0&
Public Const MIXERCONTROL_CONTROLTYPE_SIGNEDMETER =
(MIXERCONTROL_CT_CLASS_METER Or MIXERCONTROL_CT_SC_METER_POLLED Or
MIXERCONTROL_CT_UNITS_SIGNED)
Public Const MIXERCONTROL_CONTROLTYPE_PEAKMETER =
(MIXERCONTROL_CONTROLTYPE_SIGNEDMETER + 1)

'********************************************************************************
Public 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
'--------------------------------------------------------------------------------

Public Type MIXERCONTROL
cbStruct As Long
dwControlID As Long
dwControlType As Long
fdwControl As Long
cMultipleItems As Long
szShortName As String * MIXER_SHORT_NAME_CHARS
szName As String * MIXER_LONG_NAME_CHARS
' Union 'Bounds' = 6 DWORD-Werte maximal
lMinimum As Long ' bzw. dwMinimum bzw. ReservedA(0)
lMaximum As Long ' bzw. dwMaximum bzw. ReservedA(1)
ReservedA(4) As Long ' 4 verbleibende DWORD-Wert
' Union 'Metrics' = 6 DWORD-Werte maximal
cSteps As Long ' bzw. lCustomData bzw. ReservedB(0)
ReservedB(5) As Long ' 5 verbleibende DWORD-Wert
End Type

Public 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
'--------------------------------------------------------------------------------
Public Type MIXERCONTROLDETAILS_UNSIGNED
dwValue As Long ' value of the control
End Type
'--------------------------------------------------------------------------------
Public 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 Public 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
'--------------------------------------------------------------------------------

Public 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 pamxctrl points
to
cbmxctrl As Long ' size in Byte of _one_ MIXERCONTROL
pamxctrl As Long ' pointer to first MIXERCONTROL array
End Type

Declare Function mixerGetControlDetails Lib "winmm.dll" Alias
"mixerGetControlDetailsA" (ByVal hmxobj As Long, pmxcd As
MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Declare Function mixerGetLineControls Lib "winmm.dll" Alias
"mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS,
ByVal fdwControls As Long) As Long
Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA"
(ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
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

Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal
dwBytes As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hmem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hmem As Long) As Long

Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct
As Any, ByVal ptr As Long, ByVal cb As Long)

Function GetControl(ByVal hmixer As Long, ByVal componentType As Long, ByVal
ctrlType As Long, ByRef mxc As MIXERCONTROL) As Boolean
' Die Function prüft ob ein Mixer-Control existiert und gibt bei
erfolgreicher Abfrage True zurück.

Dim mxlc As MIXERLINECONTROLS
Dim mxl As MIXERLINE
Dim hmem As Long
Dim RetVal As Long

mxl.cbStruct = Len(mxl)
mxl.dwComponentType = componentType

RetVal = mixerGetLineInfo(hmixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE)

If MMSYSERR_NOERROR = RetVal Then
mxlc.cbStruct = Len(mxlc)
mxlc.dwLineID = mxl.dwLineID
mxlc.dwControl = ctrlType
mxlc.cControls = mxl.cControls
mxlc.cbmxctrl = Len(mxc)

' Speicher reservieren
mxlc.pamxctrl = VarPtr(mxc)

' Mixercontrol holen
RetVal = mixerGetLineControls(hmixer, mxlc,
MIXER_GETLINECONTROLSF_ONEBYTYPE)

' Here returns Errorcode 1025 in Windows 2000 & Windows XP ( NOT so in
Windows 95/98)


If MMSYSERR_NOERROR = RetVal Then
GetControl = True

' Das Control in die Deklarationsstruktur kopieren
CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc)
Else
GetControl = False
End If

Exit Function
End If

GetControl = False

End Function

-----------------------------------
Code Form1.frm:
-----------------------------------
Option Explicit

Dim outputVolCtrl As MIXERCONTROL ' Master-Lautstärke des Mixers

Dim mxcd As MIXERCONTROLDETAILS ' Mixer-Informationen
Dim volume As Long ' Lautstärkewert
Dim volHmem As Long ' Zeiger(Handle) auf den
Lautstärkespeicher

Dim PicX As Long
Dim PicY As Long
Dim NewX As Long
Dim NewY As Long
Dim OldX As Long
Dim OldY As Long
Dim Start As Boolean

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim rc As Boolean
On Error GoTo mixerr

' Soundkarten-Mixers Mixermit der Geräte-ID öffnen (DEVICEID)
RetVal = mixerOpen(hmixer, DEVICEID, 0, 0, 0)

If MMSYSERR_NOERROR <> RetVal Then
MsgBox "Der Soundkarten-Mixer ist nicht bereit oder vorhanden.",
vbOKOnly
Exit Sub
End If

' Mixer-Lautstärke holen
rc = GetControl(hmixer, MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT,
MIXERCONTROL_CONTROLTYPE_PEAKMETER, outputVolCtrl)

If rc = True Then
ProgressBar1.Min = 0
ProgressBar1.Max = outputVolCtrl.lMaximum
Else
ProgressBar1.Enabled = False
MsgBox "System-Mixer kann nicht geöffnet werden, oder ist nicht
vorhanden."
End If

' Mixer initialisieren
mxcd.cbStruct = Len(mxcd)
volHmem = GlobalAlloc(&H0, Len(volume)) ' Puffer für die
Lauststärkeeinheit reservieren
mxcd.paDetails = GlobalLock(volHmem)
mxcd.cbDetails = Len(volume)
mxcd.cChannels = 1

'Zeichen-Variablen
PicY = 2100 '(Maximal Größe der PictureBox)
NewY = 2100
Start = False

mixerr:
If Err.Number <> 0 Then
MsgBox Str$(Err.Number) & " " & Err.Description, "Form_Load"
End If
End Sub

Private Sub Timer1_Timer()
On Error Resume Next

Dim LngVol As Long

' Die aktuelle Lautstärke holen
If ProgressBar1.Enabled = True Then
mxcd.dwControlID = outputVolCtrl.dwControlID
mxcd.item = outputVolCtrl.cMultipleItems
RetVal = mixerGetControlDetails(hmixer, mxcd,
MIXER_GETCONTROLDETAILSF_VALUE)
CopyStructFromPtr volume, mxcd.paDetails, Len(volume)

If volume < 0 Then volume = -volume
ProgressBar1.Value = volume
LngVol = Int(ProgressBar1.Value * (100 / ProgressBar1.Max))

PicY = 2100 - (2100 * (LngVol / 100))

If (PicX + 30) < 3730 Then 'ist der ZeichenStift noch in der PictureBox
'Schrittweite des Zeichenstifts
PicX = PicX + 30
Else 'andernfalls löschen und neu beginnen
Pic1.Cls
PicX = 0
Start = False
End If

'Zeichen wenn kein Audiosignal
Pic1.Circle (PicX, PicY), 1, RGB(64, 255, 64)

OldX = NewX
OldY = NewY
NewX = PicX
NewY = PicY

If Start = True Then 'ist ein Audiosignal vorhanden
'grafische Spielerei ;-)
Select Case Pic1.CurrentY
Case Is < 350 'rot
Pic1.Line (OldX, OldY)-(NewX, NewY), RGB(255, 64, 64)
Case 351 To 1000 ' gelb
Pic1.Line (OldX, OldY)-(NewX, NewY), RGB(255, 255, 0)
Case Else 'grün
Pic1.Line (OldX, OldY)-(NewX, NewY), RGB(64, 255, 64)
End Select
Else
Start = True
End If

End If

End Sub
Private Sub Form_Unload(Cancel As Integer)
' Reservierten Speicher wieder freigeben
GlobalFree volHmem
End
End Sub

Detlev Schubert
- Microsoft Visual Basic MVP -
www.vb-fun.de


.



Relevant Pages

  • Re: Problem with winmm.dll under Win2000/XP
    ... > Public Type MIXERCONTROL ... > Declare Function mixerGetControlDetails Lib "winmm.dll" Alias ... > Dim mxlc As MIXERLINECONTROLS ... > Private Sub Command1_Click ...
    (microsoft.public.vb.winapi)
  • Lines..... got me baffled
    ... Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As ... Public Type POINTAPI ... Public Const EM_GETFIRSTVISIBLELINE = &HCE ... Dim iLine As Long, cLine As Long, vLine As Long ...
    (microsoft.public.vb.general.discussion)
  • Disk Imaging Utility
    ... works with disk volumes. ... Public Const GENERIC_WRITE = &H40000000 ... Public Type CREATE_DISK_GPT ... Dim cd As CREATE_DISK ...
    (comp.lang.basic.visual.misc)
  • Re: HTMLhelp closing when dialog box closes
    ... Public Const HH_GET_WIN_HANDLE As Long = &H6 ... Public Declare Function GetDesktopWindow _ ... Private Declare Function HtmlHelp Lib "hhctrl.ocx" _ ... Dim lngDummy As Long ...
    (microsoft.public.vc.language)
  • Any good Form Resizing code?
    ... Option Compare Database 'Use database order for string comparisons ... Public Const glrcMDIClientClass = "MDICLIENT" ... Dim strName As String ... sglFactorY As Single) ...
    (comp.databases.ms-access)