Ich will mit nem VB Programm die Lautstärke des Systems verändern....
Die MP3's werden mit dem windows media comtrol abgespielt.
Seite 1 von 1
Lautstärke mit dem Media Control
Anzeige
#4
geschrieben 15. Juli 2002 - 20:24
öhm.... ja, aber wie man jetzt die Lautstärke verändert weiss ich immer noch nicht?!!!?!? Das war ja die Frage
Zitat
Ich will mit nem VB Programm die Lautstärke des Systems verändern....
#5
geschrieben 18. Juli 2002 - 10:59
Zitat (tecONE: Jul 15 2002, 20:24)
öhm.... ja, aber wie man jetzt die Lautstärke verändert weiss ich immer noch nicht?!!!?!? Das war ja die Frage
Irgendwo hatte ich den Code doch noch ... aber leider finde ich das File grad net, sorry
Jedenfalls ist das recht kompliziert, denn du musst zuerst den entsprechenden Mixer öffnen, dann den Regler öffnen, die Value setzen und beides wieder schliessen
#6
geschrieben 18. Juli 2002 - 11:05
Zitat (mo: Jul 15 2002, 19:38)
VB ist wäh ...
... das sagen alle, die sich ein paar VB-Einsteiger-Beispiele angeschaut haben und das 'wahre' VB gar nicht kennen
Du kannst mit VB (fast) alles machen, was MS sagen will, es geht nicht: 'echte' DLLs, Assemblercode, malloc, OLE-Interfaces, __cdecl undundund Auch die Grösse und Ausführungsgeschwindigkeit von VB-Code muss sich nicht hinter C verstecken, nur die in Tutorials gerne verwendeten Active X-Controls und unoptimierten Code machen das Ganze lahm ...!
#7
geschrieben 18. Juli 2002 - 13:14
Hab selbst ein bissl probiert und mehr ist es nicht:
'Lautstärke Dim WMin&, WMax&, WCur& '# Werte für die Gesamtlautstärke Dim MMin&, MMax&, MCur& '# Werte für die Mikrofonlautstärke Pfad = App.Path: If Right$(Pfad, 1) <> "\" Then Pfad = Pfad & "\" Set VolCls = New clsVolume '# Instanz des Klassenmoduls erstellen With Screen tpx = .TwipsPerPixelX: tpy = .TwipsPerPixelY End With halbhoch = picVolume(0).Height \ 2 '# Label1 stellt die Schieberschlitze dar With Label1(0) Oben = .Top Unten = .Top + .Height Bereich = .Height End With '# Label33 umfaßt die Sliderflächen For i = 0 To Label33.Count - 1 With Label33(i) .Top = Oben .Height = Bereich .Width = picVolume(0).Width .Left = picVolume(i).Left End With Next '# Rechteck des Schiebers ermitteln '# und speichern für das Zeichnen With sliderect '# Schieber .Left = 0 .Top = 0 .Right = picVolume(0).Width \ tpx .Bottom = picVolume(0).Height \ tpy End With '# Aktuelle Werte für den Mixer ermitteln With VolCls WMin = .MinWaveVolume WMax = .MaxWaveVolume MMin = .MinMicVolume MMax = .MaxMicVolume WCur = .WaveVolume MCur = .MicroVolume End With WFaktor = (WMax - WMin) / Bereich MFaktor = (MMax - MMin) / Bereich '# Festlegung der Sprünge LargeChange = Bereich \ 10 SmallChange = Bereich \ 100 '# Positionieren der Schieber anhand der aktuellen Werte picVolume(0).Top = Unten - halbhoch - (WCur \ WFaktor) picVolume(1).Top = Unten - halbhoch - (MCur \ MFaktor) '# Scala erzeugen (wichtig: BackStyle = Transparent, '# sonst Flimmern beim Bewegen der Schieber!) Dim Labeltop& Labeltop = Label22(0).Top For i = 1 To 10 Load Label22(i) With Label22(i) .Top = Labeltop + (Bereich \ 10) * i .Caption = Trim$(100 - 10 * i) .Visible = True End With Next End Sub Private Sub Form_Paint() For i = 0 To picVolume.Count - 1 Call DrawEdge(picVolume(i).hdc, sliderect, EDGE_RAISED, BF_RECT) Next End Sub '********************************************** ********************************** Private Sub Form_Unload(Cancel As Integer) '# Aufräumungsarbeiten 'Set VolCls = Nothing 'Set frmVolume = Nothing End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim Value& With ActivePic Select Case KeyCode Case 33: Value = .Top - LargeChange: If Value >= Oben - halbhoch Then .Top = Value Case 34: Value = .Top + LargeChange: If Value <= Unten - halbhoch Then .Top = Value Case 35: .Top = Unten - halbhoch Case 36: .Top = Oben - halbhoch Case 38: Value = .Top - SmallChange: If Value >= Oben - halbhoch Then .Top = Value Case 40: Value = .Top + SmallChange: If Value <= Unten - halbhoch Then .Top = Value Case Else End Select Call MakeValue(.Top) End With End Sub Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case 33 To 40: If ActivePic.Index = 0 Then PlaySound End Select End Sub Private Sub Image1_Click() Command5_Click End Sub Private Sub Image10_Click(Index As Integer) If Modus = 0 Then Image10(0).Picture = Image10(2).Picture Modus = 1 Exit Sub End If If Modus = 1 Then Image10(0).Picture = Image10(1).Picture Modus = 0 Exit Sub End If End Sub
#8
geschrieben 18. Juli 2002 - 13:14
ach ja, und ein kleines Klassenmodul gehört noch dazu:
'********************************************** ********************************** ' ++ Klassenmodul zur Lautstärkeeinstellung für Mikrofon und Gesamtlautstärke ++ ' + Ursprünglicher Autor: Unbekannt. Modifiziert und erweitert von J. Thümmler + '********************************************** ********************************** Option Explicit '********************************************** ********************************** 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_GETCONTROLDETAILSF_LISTTEXT& = &H1& Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2& Private Const MIXER_OBJECTF_WAVEOUT& = &H10000000 Private Const MIXER_SETCONTROLDETAILSF_VALUE = &H0& 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 Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000& Private Const MIXERLINE_COMPONENTTYPE_SRC_DIGITAL& = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 1) Private Const MIXERLINE_COMPONENTTYPE_SRC_LINE = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2) Private Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3) Private Const MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC& = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 5) Private Const MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT& = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 8) Private Const MIXERLINE_COMPONENTTYPE_SRC_AUXILIARY& = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 9) Private Const MIXERLINE_COMPONENTTYPE_SRC_ANALOG& = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 10) Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0& Private Const MIXERLINE_COMPONENTTYPE_DST_DIGITAL& = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 1) Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4) Private Const MIXERLINE_COMPONENTTYPE_DST_WAVEIN& = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 7) Private Const MIXERLINE_COMPONENTTYPE_DST_VOICEIN& = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 8) '********************************************** ********************************** 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 Private 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 pamxctrl points to cbmxctrl As Long ' size in Byte of _one_ MIXERCONTROL pamxctrl As Long ' pointer to first MIXERCONTROL array End Type '********************************************** ********************************** Private Declare Function mixerClose& Lib "winmm.dll" (ByVal hmx&) Private Declare Function mixerGetControlDetails& Lib "winmm.dll" Alias "mixerGetControlDetailsA" _ (ByVal hmxobj&, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails&) Private Declare Function mixerGetDevCaps& Lib "winmm.dll" Alias "mixerGetDevCapsA" (ByVal uMxId&, _ ByVal pmxcaps As MIXERCAPS, ByVal cbmxcaps&) Private Declare Function mixerGetID& Lib "winmm.dll" (ByVal hmxobj&, pumxID&, ByVal fdwId&) Private Declare Function mixerGetLineControls& Lib "winmm.dll" Alias "mixerGetLineControlsA" _ (ByVal hmxobj&, pmxlc As MIXERLINECONTROLS, ByVal fdwControls&) Private Declare Function mixerGetLineInfo& Lib "winmm.dll" Alias "mixerGetLineInfoA" _ (ByVal hmxobj&, pmxl As MIXERLINE, ByVal fdwInfo&) Private Declare Function mixerGetNumDevs& Lib "winmm.dll" () Private Declare Function mixerMessage& Lib "winmm.dll" (ByVal hmx&, ByVal uMsg&, _ ByVal dwParam1&, ByVal dwParam2&) Private Declare Function mixerOpen& Lib "winmm.dll" (phmx&, ByVal uMxId&, _ ByVal dwCallback&, ByVal dwInstance&, ByVal fdwOpen&) Private Declare Function mixerSetControlDetails& Lib "winmm.dll" (ByVal hmxobj&, _ pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails&) Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" _ (struct As Any, ByVal ptr&, ByVal cb&) Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" _ (ByVal ptr&, struct As Any, ByVal cb&) Private Declare Function GlobalAlloc& Lib "kernel32" (ByVal wFlags&, ByVal dwBytes&) Private Declare Function GlobalLock& Lib "kernel32" (ByVal hmem&) Private Declare Function GlobalFree& Lib "kernel32" (ByVal hmem&) '********************************************** ********************************** Dim hMixer& ' mixer handle Dim volCtrl As MIXERCONTROL ' waveout volume control Dim micCtrl As MIXERCONTROL ' microphone volume control Dim bOK As Boolean ' boolean return code Dim MinWaveVol&, MaxWaveVol& ' Min/Maxwerte für WaveControl Dim MinMicVol&, MaxMicVol& ' Min/Maxwerte für MicroControl Dim mxl As MIXERLINE Dim mxc As MIXERCONTROL Dim mxcd As MIXERCONTROLDETAILS Dim mxlc As MIXERLINECONTROLS Dim Vol As MIXERCONTROLDETAILS_UNSIGNED Dim hmem& ' Memory handle Dim rc& ' return code '********************************************** ********************************** '********************************************** ********************************** '# Hier folgt die "Schnittstelle" des Klassenmoduls nach außen '********************************************** ********************************** Public Property Get MinWaveVolume&() '# Minimalwert der Lautstärkeeinstellung MinWaveVolume = MinWaveVol End Property '********************************************** ********************************** Public Property Get MaxWaveVolume&() '# Maximalwert der Lautstärkeeinstellung MaxWaveVolume = MaxWaveVol End Property '********************************************** ********************************** Public Property Get MinMicVolume&() '# Minimalwert der Mikrofonlautstärke MinMicVolume = MinMicVol End Property '********************************************** ********************************** Public Property Get MaxMicVolume&() '# Maximalwert der Mikrofonlautstärke MaxMicVolume = MaxMicVol End Property '********************************************** ********************************** Public Property Get WaveVolume&() '# Aktuelle Lautstärkeeinstellung WaveVolume = GetVolume(volCtrl) End Property '********************************************** ********************************** Public Property Get MicroVolume&() '# Aktuelle Mikrofonlautstärke MicroVolume = GetVolume(micCtrl) End Property '********************************************** ********************************** Public Property Let WaveVolume(ByVal NewVolume&) '# Einstellung Gesamtlautstärke If NewVolume < MinWaveVol Then NewVolume = MinWaveVol If NewVolume > MaxWaveVol Then NewVolume = MaxWaveVol Call SetVolume(volCtrl, NewVolume) End Property '********************************************** ********************************** Public Property Let MicroVolume(ByVal NewVolume&) '# Einstellung Mikro-Lautstärke If NewVolume < MinMicVol Then NewVolume = MinMicVol If NewVolume > MaxMicVol Then NewVolume = MaxMicVol Call SetVolume(micCtrl, NewVolume) End Property '********************************************** ********************************** '********************************************** ********************************** ' Hier werden die Grundparameter abgefragt bzw. gesetzt Private Sub Class_Initialize() '--------------------------------------------------------------------- ' Open the mixer with deviceID 0. rc = mixerOpen(hMixer, 0, 0, 0, 0) If ((rc <> MMSYSERR_NOERROR)) Then MsgBox "Es wurde kein Mixer gefunden!" Exit Sub End If '--------------------------------------------------------------------- ' Get the waveout volume control (Gesamtlautstärke) bOK = GetVolumeControl(hMixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, volCtrl) If bOK Then ' If the Function successfully gets the volume control, the maximum ' and minimum values are specified by lMaximum and lMinimum With volCtrl MinWaveVol = .lMinimum MaxWaveVol = .lMaximum End With End If '--------------------------------------------------------------------- ' Get the microphone volume control bOK = GetVolumeControl(hMixer, MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE, micCtrl) If bOK Then With micCtrl MinMicVol = .lMinimum MaxMicVol = .lMaximum End With End If '--------------------------------------------------------------------- '# Auf die gleiche Weise lassen sich noch weitere Geräte öffnen; '# mögliche Typen (nicht vollständig!) siehe unter den Konstanten '# MIXERLINE_COMPONENTTYPE_SRC_XXX und '# MIXERLINE_COMPONENTTYPE_DST_XXX '--------------------------------------------------------------------- End Sub '********************************************** ********************************** ' This Function attempts to obtain a mixer control. Returns True if successful. Private Function GetVolumeControl(ByVal hMixer&, ByVal componentType&, _ mxc As MIXERCONTROL) As Boolean Const ctrlType& = MIXERCONTROL_CONTROLTYPE_VOLUME '# Nur Lautstärkeregler suchen mxl.cbStruct = Len(mxl) mxl.dwComponentType = componentType ' Obtain a line corresponding to the component type rc = mixerGetLineInfo(hMixer, mxl, MIXER_GETLINEINFOF_COMPONENTTYPE) If (MMSYSERR_NOERROR = rc) Then With mxlc .cbStruct = Len(mxlc) .dwLineID = mxl.dwLineID .dwControl = ctrlType .cControls = 1 .cbmxctrl = Len(mxc) ' Allocate a buffer for the control hmem = GlobalAlloc(&H40, Len(mxc)) .pamxctrl = GlobalLock(hmem) mxc.cbStruct = Len(mxc) End With ' Get the control rc = mixerGetLineControls(hMixer, mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE) If (MMSYSERR_NOERROR = rc) Then GetVolumeControl = True ' Copy the control into the destination structure CopyStructFromPtr mxc, mxlc.pamxctrl, Len(mxc) Else GetVolumeControl = False End If Call GlobalFree(hmem) Exit Function End If GetVolumeControl = False End Function '********************************************** ********************************** 'This Function sets the value for a volume control. Returns True if successful Private Function SetVolume(mxctl As MIXERCONTROL, ByVal volume&) As Boolean mxc = mxctl Call PrepareStruct ' Copy the data into the control value buffer Vol.dwValue = volume CopyPtrFromStruct mxcd.paDetails, Vol, Len(Vol) ' Set the control value rc = mixerSetControlDetails(hMixer, mxcd, MIXER_SETCONTROLDETAILSF_VALUE) GlobalFree (hmem) If (rc = MMSYSERR_NOERROR) Then SetVolume = True Else SetVolume = False End If End Function '********************************************** ********************************** '# Diese Funktion gibt den aktuell eingestellten Volume-Wert '# für das an die Funktion übergebene MixerControl zurück Private Function GetVolume&(mxctl As MIXERCONTROL) mxc = mxctl Call PrepareStruct ' Get the control value rc = mixerGetControlDetails(hMixer, mxcd, MIXER_GETCONTROLDETAILSF_VALUE) ' Copy the data from control value buffer CopyStructFromPtr Vol, mxcd.paDetails, Len(Vol) Call GlobalFree(hmem) If (rc = MMSYSERR_NOERROR) Then GetVolume = Vol.dwValue '# Aktuell eingestellter Wert Else GetVolume = 0 End If End Function '********************************************** ********************************** Private Sub PrepareStruct() '# Initialisieren der MIXERCONTROLDETAILS-Struktur Vol.dwValue = 0 With mxcd .item = 0 .dwControlID = mxc.dwControlID .cbStruct = Len(mxcd) .cbDetails = Len(Vol) ' Allocate a buffer for the control value buffer hmem = GlobalAlloc(&H40, Len(Vol)) .paDetails = GlobalLock(hmem) .cChannels = 1 End With End Sub '********************************************** ********************************** Private Sub Class_Terminate() Call mixerClose(hMixer) End Sub '********************************************** **********************************
#9
geschrieben 19. Juli 2002 - 14:36
Nun noch den Mixer subclassen und bei Änderungen automatisch den Regler ändern, und du hast die Lautstärkeregelung nachprogrammiert
#10
geschrieben 20. Juli 2002 - 15:53
Ich mag VB eigentlich nur wegen seiner Syntax nicht. Und dank .NET kann ichs mir ja aussuchen, also kein Stress. Ich fühl mich mit C# puddelwohl. Von der Codelänge nimmt sich das ja auch kaum was, ich finds nur strucktuierter.
#11
geschrieben 20. Juli 2002 - 23:08
C# ist von der Sytnax her ja ganz nett, aber ... schau dir mal den RAM-Hunger der Runtime (ca. 12 MB!) sowie die Geschwindigkeit (VBScript auf einem P-200 is schneller) an - das ist der Grund, warum ich .NET einfach nicht mag, weder C# noch VB.NET, hier muss MS eindeutig noch ein SP rausbringen
Thema verteilen:
Seite 1 von 1