WinFuture-Forum.de: Lautstärke mit dem Media Control - WinFuture-Forum.de

Zum Inhalt wechseln

Nachrichten zum Thema: Entwicklung
Seite 1 von 1

Lautstärke mit dem Media Control


#1 Mitglied ist offline   tecONE 

  • Gruppe: aktive Mitglieder
  • Beiträge: 739
  • Beigetreten: 06. Januar 02
  • Reputation: 1
  • Geschlecht:Männlich
  • Wohnort:Freiburg

geschrieben 14. Juli 2002 - 16:30

Ich will mit nem VB Programm die Lautstärke des Systems verändern....
Die MP3's werden mit dem windows media comtrol abgespielt.
0

Anzeige



#2 Mitglied ist offline   DASKAjA 

  • Gruppe: Mitglieder
  • Beiträge: 5
  • Beigetreten: 12. Juli 02
  • Reputation: 0

geschrieben 14. Juli 2002 - 17:37

Na dann mach mal :rolleyes:

SCNR
0

#3 Mitglied ist offline   mo 

  • Gruppe: aktive Mitglieder
  • Beiträge: 1.796
  • Beigetreten: 17. Juni 02
  • Reputation: 0
  • Wohnort:Ulm / BaWü

  geschrieben 15. Juli 2002 - 19:38

VB ist wäh ...
I'm mó. mo's good twin.
0

#4 Mitglied ist offline   tecONE 

  • Gruppe: aktive Mitglieder
  • Beiträge: 739
  • Beigetreten: 06. Januar 02
  • Reputation: 1
  • Geschlecht:Männlich
  • Wohnort:Freiburg

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....

0

#5 Mitglied ist offline   HackZero 

  • Gruppe: aktive Mitglieder
  • Beiträge: 903
  • Beigetreten: 07. Januar 02
  • Reputation: 0

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 :D

Jedenfalls ist das recht kompliziert, denn du musst zuerst den entsprechenden Mixer öffnen, dann den Regler öffnen, die Value setzen und beides wieder schliessen ;)
0

#6 Mitglied ist offline   HackZero 

  • Gruppe: aktive Mitglieder
  • Beiträge: 903
  • Beigetreten: 07. Januar 02
  • Reputation: 0

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 :D

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 ...!
0

#7 Mitglied ist offline   tecONE 

  • Gruppe: aktive Mitglieder
  • Beiträge: 739
  • Beigetreten: 06. Januar 02
  • Reputation: 1
  • Geschlecht:Männlich
  • Wohnort:Freiburg

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

0

#8 Mitglied ist offline   tecONE 

  • Gruppe: aktive Mitglieder
  • Beiträge: 739
  • Beigetreten: 06. Januar 02
  • Reputation: 1
  • Geschlecht:Männlich
  • Wohnort:Freiburg

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

'**********************************************
**********************************

0

#9 Mitglied ist offline   HackZero 

  • Gruppe: aktive Mitglieder
  • Beiträge: 903
  • Beigetreten: 07. Januar 02
  • Reputation: 0

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 :D
0

#10 Mitglied ist offline   DASKAjA 

  • Gruppe: Mitglieder
  • Beiträge: 5
  • Beigetreten: 12. Juli 02
  • Reputation: 0

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.
0

#11 Mitglied ist offline   HackZero 

  • Gruppe: aktive Mitglieder
  • Beiträge: 903
  • Beigetreten: 07. Januar 02
  • Reputation: 0

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 :D
0

Thema verteilen:


Seite 1 von 1

1 Besucher lesen dieses Thema
Mitglieder: 0, Gäste: 1, unsichtbare Mitglieder: 0