音量控制 1.frm

来自「Windows API函数,希望大伙有用哦」· FRM 代码 · 共 131 行

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   1800
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5535
   LinkTopic       =   "Form1"
   ScaleHeight     =   1800
   ScaleWidth      =   5535
   StartUpPosition =   3  '窗口缺省
   Begin VB.HScrollBar HScroll2 
      Height          =   255
      Left            =   1590
      Min             =   -32768
      TabIndex        =   5
      Top             =   690
      Width           =   3735
   End
   Begin VB.HScrollBar HScroll1 
      Height          =   255
      Left            =   1590
      Min             =   -32768
      TabIndex        =   4
      Top             =   240
      Width           =   3735
   End
   Begin VB.CommandButton Command2 
      Caption         =   "各声道单独控制"
      Height          =   285
      Left            =   2730
      TabIndex        =   3
      Top             =   1290
      Width           =   1665
   End
   Begin VB.CommandButton Command1 
      Caption         =   "各声道同步控制"
      Height          =   285
      Left            =   930
      TabIndex        =   2
      Top             =   1290
      Width           =   1665
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "右声道音量："
      Height          =   180
      Left            =   300
      TabIndex        =   1
      Top             =   720
      Width           =   1080
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "左声道音量："
      Height          =   180
      Left            =   300
      TabIndex        =   0
      Top             =   270
      Width           =   1080
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function waveOutGetVolume Lib "Winmm" (ByVal wDeviceID As Integer, dwVolume As Long) As Integer
Private Declare Function waveOutSetVolume Lib "Winmm" (ByVal wDeviceID As Integer, ByVal dwVolume As Long) As Integer
  Dim LeftVol As String, RightVol As String
  Dim Vol As String, Flag As Integer
Private Sub Form_Load()
    Dim I As Long
    waveOutGetVolume 1, I
    Vol = "&H" & Right(Hex$(I), 4)
    HScroll1.Value = CLng(Vol) - 32768
    HScroll2.Value = CLng(Vol) - 32768
End Sub
Private Sub Command1_Click()
  Flag = 1
End Sub
Private Sub Command2_Click()
  Flag = 0
End Sub
Private Sub HScroll1_Change()
  Vol = HScroll1.Value + 32768
  LeftVol = Right((Hex$(Vol + 65536)), 4)
    If Flag = 1 Then
     HScroll2.Value = HScroll1.Value
     Vol = CLng("&H" & LeftVol & LeftVol)
      Else
     Vol = CLng("&H" & RightVol & LeftVol)
    End If
  waveOutSetVolume 1, Vol
End Sub
Private Sub HScroll1_Scroll()
  Vol = HScroll1.Value + 32768
  LeftVol = Right((Hex$(Vol + 65536)), 4)
    If Flag = 1 Then
     HScroll2.Value = HScroll1.Value
     Vol = CLng("&H" & LeftVol & LeftVol)
      Else
     Vol = CLng("&H" & RightVol & LeftVol)
    End If
  waveOutSetVolume 1, Vol
End Sub
Private Sub HScroll2_Change()
  Vol = HScroll2.Value + 32768
  RightVol = Right((Hex$(Vol + 65536)), 4)
    If Flag = 1 Then
     HScroll1.Value = HScroll2.Value
     Vol = CLng("&H" & RightVol & RightVol)
      Else
     Vol = CLng("&H" & RightVol & LeftVol)
    End If
  waveOutSetVolume 1, Vol
End Sub
Private Sub HScroll2_Scroll()
  Vol = HScroll2.Value + 32768
  RightVol = Right((Hex$(Vol + 65536)), 4)
    If Flag = 1 Then
     HScroll1.Value = HScroll2.Value
     Vol = CLng("&H" & RightVol & RightVol)
      Else
     Vol = CLng("&H" & RightVol & LeftVol)
    End If
  waveOutSetVolume 1, Vol
End Sub