可以命令方式控制系統音量

sanyu

1. Attribute VB_Name = "Module1"
   
2. ' Mixer Code provided by GivenRandy
   
3. ' He kewl.
   
4. ' The dos console stuff provided by gridrun [TNC]
   
5. ' He kewl.
   
6. ' I did command line parsing stuff. :)
   
7. 
   
8. Dim hMixer As Long
   
9. Dim VolCtrl As MIXERCONTROL
   
10. Dim hMem As Long
    
11. Dim Mxlc As MIXERLINECONTROLS
    
12. Dim Mxl As MIXERLINE
    
13. Dim Mxcd As MIXERCONTROLDETAILS
    
14. Dim Vol As MIXERCONTROLDETAILS_UNSIGNED
    
15. Const MMSYSERR_NOERROR = 0
    
16. Const MAXPNAMELEN = 32
    
17. Const MIXER_LONG_NAME_CHARS = 64
    
18. Const MIXER_SHORT_NAME_CHARS = 16
    
19. Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
    
20. Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
    
21. Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
    
22. Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
    
23. Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
    
24. Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
    
25. Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
    
26. Const MIXERCONTROL_CONTROLTYPE_FADER = (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)
    
27. Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)
    
28. Private Type MIXERCONTROLDETAILS
    
29.    cbStruct    As Long
    
30.    dwControlID As Long
    
31.    cChannels   As Long
    
32.    item        As Long
    
33.    cbDetails   As Long
    
34.    paDetails   As Long
    
35. End Type
    
36. Private Type MIXERCONTROLDETAILS_UNSIGNED
    
37.    dwValue As Long
    
38. End Type
    
39. Private Type MIXERCONTROL
    
40.    cbStruct       As Long
    
41.    dwControlID    As Long
    
42.    dwControlType  As Long
    
43.    fdwControl     As Long
    
44.    cMultipleItems As Long
    
45.    szShortName    As String * MIXER_SHORT_NAME_CHARS
    
46.    szName         As String * MIXER_LONG_NAME_CHARS
    
47.    lMinimum       As Long
    
48.    lMaximum       As Long
    
49.    reserved(10)   As Long
    
50. End Type
    
51. Private Type MIXERLINECONTROLS
    
52.    cbStruct  As Long
    
53.    dwLineID  As Long
    
54.    dwControl As Long
    
55.    cControls As Long
    
56.    cbmxctrl  As Long
    
57.    pamxctrl  As Long
    
58. End Type
    
59. Private Type MIXERLINE
    
60.    cbStruct        As Long
    
61.    dwDestination   As Long
    
62.    dwSource        As Long
    
63.    dwLineID        As Long
    
64.    fdwLine         As Long
    
65.    dwUser          As Long
    
66.    dwComponentType As Long
    
67.    cChannels       As Long
    
68.    cConnections    As Long
    
69.    cControls       As Long
    
70.    szShortName     As String * MIXER_SHORT_NAME_CHARS
    
71.    szName          As String * MIXER_LONG_NAME_CHARS
    
72.    dwType          As Long
    
73.    dwDeviceID      As Long
    
74.    wMid            As Integer
    
75.    wPid            As Integer
    
76.    vDriverVersion  As Long
    
77.    szPname         As String * MAXPNAMELEN
    
78. End Type
    
79. Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
    
80. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    
81. Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    
82. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
    
83. Private Declare Sub CopyPtrFromStruct Lib "kernel32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)
    
84. Private Declare Sub CopyStructFromPtr Lib "kernel32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
    
85. Private 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
    
86. Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hmxobj As Long, pmxcd As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
    
87. Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hmxobj As Long, pmxl As MIXERLINE, ByVal fdwInfo As Long) As Long
    
88. Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias "mixerGetLineControlsA" (ByVal hmxobj As Long, pmxlc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
    
89. Sub Main()
    
90.    ConAcquire
    
91.    
    
92.    If Command$ = "" Or InStr(1, Command$, "/?") > 0 Then
    
93.    ConPrint "To use just type in " & App.EXEName & " n"
    
94.    ConPrint "n is a number between 0 and 100"
    
95.    'MsgBox "hey"
    
96.    End
    
97.    End If
    
98.    
    
99.    Dim Newvolume As Long
    
100.    
     
101.    Newvolume = CLng(Command$)
     
102.    
     
103.    If (mixerOpen(hMixer, 0, 0, 0, 0) <> MMSYSERR_NOERROR) Then
     
104.        ConPrint "Could not open the mixer. Type /? for help."
     
105.        ConPrint "Sorry no fix for this...."
     
106.     '   MsgBox "hey"
     
107.        Exit Sub
     
108.    End If
     
109.    Dim Max As Long
     
110.    Dim Min As Long
     
111.    
     
112.    
     
113.    If (fGetVolumeControl(hMixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_VOLUME, VolCtrl)) Then
     
114.        Max = VolCtrl.lMinimum
     
115.        Min = VolCtrl.lMaximum \ 2
     
116.             
     
117.    End If
     
118.    mciSendString "open cdaudio", 0, 0, hWnd
     
119.    
     
120.    fSetVolumeControl hMixer, VolCtrl, CLng(Min * Newvolume / 100 * 2)
     
121.    mciSendString "close all", 0, 0, hWnd
     
122.     ConPrint
     
123.     ConPrint "Volume Set to " & Newvolume & "%"
     
124. 'ConRelease
     
125. End
     
126. End Sub
     
127. Private Sub Form_Unload(Cancel As Integer)
     
128. End Sub
     
129. Private Sub VScroll1_Change()
     
130.    fSetVolumeControl hMixer, VolCtrl, CLng(VScroll1.Value) * 2
     
131. End Sub
     
132. Private Sub VScroll1_Scroll()
     
133.    fSetVolumeControl hMixer, VolCtrl, CLng(VScroll1.Value) * 2
     
134. End Sub
     
135. Private Sub fSetVolumeControl(ByVal hMixer As Long, Mxc As MIXERCONTROL, ByVal Volume As Long)
     
136.    Mxcd.item = 0
     
137.    Mxcd.dwControlID = Mxc.dwControlID
     
138.    Mxcd.cbStruct = Len(Mxcd)
     
139.    Mxcd.cbDetails = Len(Vol)
     
140.    hMem = GlobalAlloc(&H40, Len(Vol))
     
141.    Mxcd.paDetails = GlobalLock(hMem)
     
142.    Mxcd.cChannels = 1
     
143.    Vol.dwValue = Volume
     
144.    CopyPtrFromStruct Mxcd.paDetails, Vol, Len(Vol)
     
145.    mixerSetControlDetails hMixer, Mxcd, MIXER_SETCONTROLDETAILSF_VALUE
     
146.    Call GlobalFree(hMem)
     
147. End Sub
     
148. Private Function fGetVolumeControl(ByVal hMixer As Long, ByVal componentType As Long, ByVal ctrlType As Long, ByRef Mxc As MIXERCONTROL) As Boolean
     
149.    Mxl.cbStruct = Len(Mxl)
     
150.    Mxl.dwComponentType = componentType
     
151.    If (mixerGetLineInfo(hMixer, Mxl, MIXER_GETLINEINFOF_COMPONENTTYPE) = MMSYSERR_NOERROR) Then
     
152.        Mxlc.cbStruct = Len(Mxlc)
     
153.        Mxlc.dwLineID = Mxl.dwLineID
     
154.        Mxlc.dwControl = ctrlType
     
155.        Mxlc.cControls = 1
     
156.        Mxlc.cbmxctrl = Len(Mxc)
     
157.        hMem = GlobalAlloc(&H40, Len(Mxc))
     
158.        Mxlc.pamxctrl = GlobalLock(hMem)
     
159.        Mxc.cbStruct = Len(Mxc)
     
160.        If (mixerGetLineControls(hMixer, Mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE) = MMSYSERR_NOERROR) Then
     
161.            fGetVolumeControl = True
     
162.            Call CopyStructFromPtr(Mxc, Mxlc.pamxctrl, Len(Mxc))
     
163.        Else
     
164.            fGetVolumeControl = False
     
165.        End If
     
166.        Call GlobalFree(hMem)
     
167.        Exit Function
     
168.    End If
     
169.    fGetVolumeControl = False
     
170. End Function

複製代碼

...

瀏覽完整內容，請先 註冊 或 登入會員