Hur går man till väga om man vill att tex. "slider1" ska fungera som en volymkontroll som typ den i winamp ... så att den bara sänker å höjjer ljudet från mitt tilltänkta prog?
tack på förhand

Hej
Slider är en väldigt lätt kontroll.

Ställ in Slider1.Max till det siffervärde som ditt ljudprogram
vill ha vid full volym, Förmodar att Slider1.Min skall vara 0

Sen fångar du aktuellt värde enl nedan

Private Sub Slider1_Change()
Slider1.SelLength = Slider1.Value
Label1.Caption = Slider1.Value
End Sub

mvh
Sven

hmm .. det blir knas
error där ----> Slider1.SelLength = Slider1.Value

Hej
Remma den raden och se vad som händer.
Vad säger Error felet.
Exemplet fungerar utmärkt på min Dator

Sven

Hej
Oki var tvungen att kolla en gång till.

För att mitt exempel skall fungera måste du sätta
Egenskapen SelectRange = True i Slider1 Property lista

Sven

hmmmm ... själva slidern funkar nu, men.... ljudet sänks ju inte
jag e kass på VB, fattar 0 ...

Hej
Förmodligen måste man skicka ett siffervärde till ljudprogramet.

Du måste ta reda på vad ljudprogrammet vill ha för siffervärde
för max volym. Du måste visa lite kod så man kan se vad
du vill åstadkomma.

mvh
Sven

Jag har en knapp (cammand1) och en slider (slider1) och en label (label1)... jag vill att slidern ska fungera som en volymkontroll....pliiiz help me....så här ser koden ut :

<code>
Option Explicit

Private Const SND_SYNC As Long = &H0 'play synchronously (default)
Private Const SND_ASYNC As Long = &H1 'play asynchronously
Private Const SND_NODEFAULT As Long = &H2 'silence not default, if sound not found
Private Const SND_MEMORY As Long = &H4 'lpszSoundName points to a memory file
Private Const SND_LOOP As Long = &H8 'loop the sound until next sndPlaySound
Private Const SND_NOSTOP As Long = &H10 'don't stop any currently playing sound
Private Const SND_PURGE As Long = &H40 'purge non-static events for task
Private Const SND_APPLICATION As Long = &H80 'look for application specific association
Private Const SND_NOWAIT As Long = &H2000 'don't wait if the driver is busy
Private Const SND_RESOURCE As Long = &H40004 'name is a resource name or atom
Private Const SND_ALIAS As Long = &H10000 'name is a WIN.INI [sounds] entry
Private Const SND_FILENAME As Long = &H20000 'name is a file name
Private Const SND_ALIAS_ID As Long = &H110000 'name is a WIN.INI [sounds] entry identifier

Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long

'knapp 1
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Högerklick
If Button And vbRightButton Then
PopupMenu mnuFiler1 ' Högerklick öppnar en liten meny där det bara finns "Hämta wav-fil (MnuHämta1_click)"
End If
End Sub

Private Sub MnuHämta1_Click()
CommonDialog1.Filter = "Wav filer (*.wav)|*.wav"
CommonDialog1.FilterIndex = 1
CommonDialog1.ShowOpen
'Do Until Len(CommonDialog1.FileName)
' MsgBox "Du Måste Lägga In En Wav-Fil...", vbOKOnly, "Hämta Fil"
' CommonDialog1.ShowOpen
'Loop
Command1.Caption = CommonDialog1.FileName
End Sub

Private Sub Command1_Click()
If Len(Command1.Caption) Then
PlaySound Command1.Caption, 0&, SND_FILENAME Or SND_ASYNC Or SND_NODEFAULT
Else
MsgBox "Du Måste Lägga In En Wav-Fil...", vbOKOnly, "Hämta Fil"
End If
End Sub


Private Sub Slider1_Change()
Slider1.Max = 100
Slider1.Min = 0
Slider1.SelLength = Slider1.Value
Label1.Caption = Slider1.Value
End Sub
</code>

Du kan prova:
<code>
Option Explicit

Private Const SND_SYNC As Long = &H0 'play synchronously (default)
Private Const SND_ASYNC As Long = &H1 'play asynchronously
Private Const SND_NODEFAULT As Long = &H2 'silence not default, if sound not found
Private Const SND_MEMORY As Long = &H4 'lpszSoundName points to a memory file
Private Const SND_LOOP As Long = &H8 'loop the sound until next sndPlaySound
Private Const SND_NOSTOP As Long = &H10 'don't stop any currently playing sound
Private Const SND_PURGE As Long = &H40 'purge non-static events for task
Private Const SND_APPLICATION As Long = &H80 'look for application specific association
Private Const SND_NOWAIT As Long = &H2000 'don't wait if the driver is busy
Private Const SND_RESOURCE As Long = &H40004 'name is a resource name or atom
Private Const SND_ALIAS As Long = &H10000 'name is a WIN.INI [sounds] entry
Private Const SND_FILENAME As Long = &H20000 'name is a file name
Private Const SND_ALIAS_ID As Long = &H110000 'name is a WIN.INI [sounds] entry identifier

Private Const MMSYSERR_BASE As Long = 0
Private Const MMSYSERR_NOERROR As Long = 0
Private Const MMSYSERR_INVALHANDLE As Long = (MMSYSERR_BASE + 5)
Private Const MMSYSERR_NODRIVER As Long = (MMSYSERR_BASE + 6)
Private Const MMSYSERR_NOMEM As Long = (MMSYSERR_BASE + 7)
Private Const MMSYSERR_NOTSUPPORTED As Long = (MMSYSERR_BASE + 8)

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long

Private Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long

Private Sub Form_Load()
Dim lngVolume As Long
Select Case waveOutGetVolume(0&, lngVolume)
Case MMSYSERR_NOERROR
Slider1.Value = ((lngVolume And &HFFFF&) * Slider1.Max) / &HFFFF&
Slider1.Enabled = True
Case MMSYSERR_INVALHANDLE
MsgBox "Specified device handle is invalid."
Slider1.Enabled = False
Case MMSYSERR_NODRIVER
MsgBox "No device driver is present."
Slider1.Enabled = False
Case MMSYSERR_NOMEM
MsgBox "Unable to allocate or lock memory."
Slider1.Enabled = False
Case MMSYSERR_NOTSUPPORTED
MsgBox "Function isn't supported."
Slider1.Enabled = False
Case Else
MsgBox "Unknown Result"
Slider1.Enabled = False
End Select
End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Högerklick
If Button And vbRightButton Then
PopupMenu mnuFiler1 ' Högerklick öppnar en liten meny där det bara finns "Hämta wav-fil (MnuHämta1_click)"
End If
End Sub

Private Sub MnuHämta1_Click()
CommonDialog1.Filter = "Wav filer (*.wav)|*.wav"
CommonDialog1.FilterIndex = 1
CommonDialog1.ShowOpen
Command1.Caption = CommonDialog1.FileName
End Sub

Private Sub Command1_Click()
If Len(Command1.Caption) Then
PlaySound Command1.Caption, 0&, SND_FILENAME Or SND_ASYNC Or SND_NODEFAULT
Else
MsgBox "Du Måste Lägga In En Wav-Fil...", vbOKOnly, "Hämta Fil"
End If
End Sub



Private Sub Slider1_Change()
Dim lngVolume As Long
lngVolume = ((Slider1.Value * &HFFFF&) / Slider1.Max) And &HFFFF
CopyMemory ByVal VarPtr(lngVolume) + 2, lngVolume, 2
waveOutSetVolume 0&, lngVolume
Label1.Caption = Slider1.Value
End Sub
</code>

hmmm
det blir runtime-error 6
owerflow

Hjälper om du säger vilken rad felet upstår på.

Har i vilket vall skipat CopyMemmory:

<code>
Option Explicit

Private Const SND_SYNC As Long = &H0 'play synchronously (default)
Private Const SND_ASYNC As Long = &H1 'play asynchronously
Private Const SND_NODEFAULT As Long = &H2 'silence not default, if sound not found
Private Const SND_MEMORY As Long = &H4 'lpszSoundName points to a memory file
Private Const SND_LOOP As Long = &H8 'loop the sound until next sndPlaySound
Private Const SND_NOSTOP As Long = &H10 'don't stop any currently playing sound
Private Const SND_PURGE As Long = &H40 'purge non-static events for task
Private Const SND_APPLICATION As Long = &H80 'look for application specific association
Private Const SND_NOWAIT As Long = &H2000 'don't wait if the driver is busy
Private Const SND_RESOURCE As Long = &H40004 'name is a resource name or atom
Private Const SND_ALIAS As Long = &H10000 'name is a WIN.INI [sounds] entry
Private Const SND_FILENAME As Long = &H20000 'name is a file name
Private Const SND_ALIAS_ID As Long = &H110000 'name is a WIN.INI [sounds] entry identifier

Private Const MMSYSERR_BASE As Long = 0
Private Const MMSYSERR_NOERROR As Long = 0
Private Const MMSYSERR_INVALHANDLE As Long = (MMSYSERR_BASE + 5)
Private Const MMSYSERR_NODRIVER As Long = (MMSYSERR_BASE + 6)
Private Const MMSYSERR_NOMEM As Long = (MMSYSERR_BASE + 7)
Private Const MMSYSERR_NOTSUPPORTED As Long = (MMSYSERR_BASE + 8)

Private Type Data1
Value1 As Long
End Type
Private Type Data2
Value1 As Integer
Value2 As Integer
End Type

Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long

Private Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long

Private Sub Form_Load()
Dim lngVolume As Long
Select Case waveOutGetVolume(0&, lngVolume)
Case MMSYSERR_NOERROR
Slider1.Value = ((lngVolume And &HFFFF&) * Slider1.Max) / &HFFFF&
Slider1.Enabled = True
Case MMSYSERR_INVALHANDLE
MsgBox "Specified device handle is invalid."
Slider1.Enabled = False
Case MMSYSERR_NODRIVER
MsgBox "No device driver is present."
Slider1.Enabled = False
Case MMSYSERR_NOMEM
MsgBox "Unable to allocate or lock memory."
Slider1.Enabled = False
Case MMSYSERR_NOTSUPPORTED
MsgBox "Function isn't supported."
Slider1.Enabled = False
Case Else
MsgBox "Unknown Result"
Slider1.Enabled = False
End Select
End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Högerklick
If Button And vbRightButton Then
PopupMenu mnuFiler1 ' Högerklick öppnar en liten meny där det bara finns "Hämta wav-fil (MnuHämta1_click)"
End If
End Sub

Private Sub MnuHämta1_Click()
CommonDialog1.Filter = "Wav filer (*.wav)|*.wav"
CommonDialog1.FilterIndex = 1
CommonDialog1.ShowOpen
Command1.Caption = CommonDialog1.FileName
End Sub

Private Sub Command1_Click()
If Len(Command1.Caption) Then
PlaySound Command1.Caption, 0&, SND_FILENAME Or SND_ASYNC Or SND_NODEFAULT
Else
MsgBox "Du Måste Lägga In En Wav-Fil...", vbOKOnly, "Hämta Fil"
End If
End Sub



Private Sub Slider1_Change()
Dim Data1 As Data1
Dim Data2 As Data2

Data1.Value1 = ((Slider1.Value * &HFFFF&) / Slider1.Max)
LSet Data2 = Data1
Data2.Value2 = Data2.Value1
LSet Data1 = Data2

waveOutSetVolume 0&, Data1.Value1
Label1.Caption = Slider1.Value
End Sub
</code>

det är här det blir overflow
Data1.Value1 = ((Slider1.Value * &HFFFF&) / Slider1.Max)

Gisar på att du har 0 som max värde. Byt i så fall alla max mot min.

ahh ... tackskaruha