frmvolume.frm

大量优秀的vb编程

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmVolume 
   BackColor       =   &H00E0E0E0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "调节系统音量"
   ClientHeight    =   2856
   ClientLeft      =   5796
   ClientTop       =   2256
   ClientWidth     =   2664
   ForeColor       =   &H8000000D&
   Icon            =   "frmVolume.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2856
   ScaleWidth      =   2664
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame2 
      BackColor       =   &H80000011&
      Caption         =   "调节音量"
      ForeColor       =   &H00FFFFFF&
      Height          =   2175
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   2415
      Begin MSComDlg.CommonDialog CommonDialog1 
         Left            =   2400
         Top             =   2160
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
      End
      Begin VB.VScrollBar vsVolume 
         Height          =   1455
         Left            =   600
         TabIndex        =   0
         Top             =   600
         Width           =   255
      End
      Begin VB.VScrollBar vsMic 
         Height          =   1455
         Left            =   1560
         TabIndex        =   1
         Top             =   600
         Width           =   255
      End
      Begin VB.Label Label3 
         Alignment       =   2  'Center
         AutoSize        =   -1  'True
         BackColor       =   &H80000010&
         Caption         =   "麦克风音量"
         ForeColor       =   &H00FFFFFF&
         Height          =   192
         Left            =   1284
         TabIndex        =   4
         Top             =   360
         Width           =   804
      End
      Begin VB.Label Label2 
         Alignment       =   2  'Center
         AutoSize        =   -1  'True
         BackColor       =   &H80000010&
         Caption         =   "输出音量"
         ForeColor       =   &H00FFFFFF&
         Height          =   192
         Left            =   384
         TabIndex        =   3
         Top             =   360
         Width           =   624
      End
   End
   Begin VB.Label lblQuit 
      Alignment       =   2  'Center
      BackColor       =   &H80000010&
      Caption         =   "退出程序"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   252
      Left            =   1680
      MouseIcon       =   "frmVolume.frx":27A2
      MousePointer    =   99  'Custom
      TabIndex        =   7
      Top             =   2520
      Width           =   732
   End
   Begin VB.Label lblStop 
      Alignment       =   2  'Center
      BackColor       =   &H80000010&
      Caption         =   "停止播放"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   252
      Left            =   840
      MouseIcon       =   "frmVolume.frx":2AAC
      MousePointer    =   99  'Custom
      TabIndex        =   6
      Top             =   2520
      Width           =   732
   End
   Begin VB.Label lblPlay 
      Alignment       =   2  'Center
      BackColor       =   &H80000010&
      Caption         =   "播放"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   120
      MouseIcon       =   "frmVolume.frx":2DB6
      MousePointer    =   99  'Custom
      TabIndex        =   5
      Top             =   2520
      Width           =   615
   End
End
Attribute VB_Name = "frmVolume"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const MMSYSERR_NOERROR = 0
Const SND_ASYNC = &H1
Const SND_NODEFAULT = &H2
Const SND_PURGE = &H40
Const SND_FILENAME = &H20000
Dim MyVolume As clsVolume
'
'Play a wave file.
Private Declare Function PlaySound Lib "winmm.dll" _
    Alias "PlaySoundA" (ByVal lpszName As String, _
    ByVal hModule As Long, ByVal dwFlags As Long) As Long

Private Sub Form_Load()

Set MyVolume = New clsVolume

MyVolume.meOpenMixer

If MyVolume.prMixerErr = MMSYSERR_NOERROR Then
    With vsVolume
        .Max = MyVolume.prSpeakerMinVolume
        .Min = MyVolume.prSpeakerMaxVolume \ 2
        .SmallChange = 1000
        .LargeChange = 1000
    End With
    With vsMic
        .Max = MyVolume.prMicMinVolume
        .Min = MyVolume.prMicMaxVolume \ 2
        .SmallChange = 1000
        .LargeChange = 1000
        .Enabled = True
    End With
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set MyVolume = Nothing
Set frmVolume = Nothing
End Sub


Private Sub LblQuit_Click()
Unload Me
End Sub

Private Sub lblPlay_Click()
Dim l          As Long
Dim lFlags     As Long
Dim sSoundName As String
'
'Open a wavefile and initialize the form.
'
On Error GoTo lblPlayError
With CommonDialog1
    .FileName = "*.wav"
    .DefaultExt = "wav"
    .Filter = "Wav (*.wav)"
    .FilterIndex = 1
    .Flags = cdlOFNPathMustExist Or cdlOFNFileMustExist
    .DialogTitle = "Select a Wave File"
    .CancelError = True
    .ShowOpen
    sSoundName = .FileName
End With

lFlags = SND_ASYNC Or SND_NODEFAULT Or SND_FILENAME
l = PlaySound(sSoundName, 0, lFlags)

lblPlayError:
End Sub

Private Sub lblStop_Click()
'dss
'Dim l As Long
'
'l = PlaySound("", 0, SND_PURGE)

Dim l          As Long
Dim lFlags     As Long

lFlags = SND_ASYNC Or SND_NODEFAULT Or SND_FILENAME
l = PlaySound("", 0, lFlags)
End Sub

Private Sub vsMic_Change()
Dim lVol As Long

lVol = CLng(vsMic.Value) * 2
MyVolume.prMicVolume = lVol
'Call fSetVolumeControl(hmixer, micCtrl, lVol)
End Sub
Private Sub vsMic_Scroll()
Dim lVol As Long

lVol = CLng(vsMic.Value) * 2
MyVolume.prMicVolume = lVol
'Call fSetVolumeControl(hmixer, micCtrl, lVol)
End Sub
Private Sub vsVolume_Change()
Dim lVol As Long

lVol = CLng(vsVolume.Value) * 2
MyVolume.prSpeakerVolume = lVol
'Call fSetVolumeControl(hmixer, volCtrl, lVol)
End Sub
Private Sub vsVolume_Scroll()
Dim lVol As Long

lVol = CLng(vsVolume.Value) * 2
MyVolume.prSpeakerVolume = lVol
'Call fSetVolumeControl(hmixer, volCtrl, lVol)
End Sub