标题:这有什么问题吗-->baidu转移
只看楼主
月魔
Rank: 1
等 级:新手上路
帖 子:25
专家分:0
注 册:2006-7-24
 问题点数:0 回复次数:1 
这有什么问题吗-->baidu转移

Private Type lVolType
v As Long
End Type

Private Type VolType
LV As Integer
RV As Integer
End Type
Dim volume As Long
Dim joke As Boolean
Dim filename(10) As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim switch As Boolean
Private Declare Function CreateEllipticRgn Lib "gdi32" _
(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hWnd As Long, ByVal hrgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function auxSetVolume Lib "winmm.dll" _
(ByVal uDeviceID As Long, ByVal dwVolume 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 add_Click()
CommonDialog1.Filter = "AVI|*.avi|WAV|*.wav|MID|*.mid|MPG|*.mpg|MP3|*.mp3|所有文件|*.*"
CommonDialog1.ShowOpen
If CommonDialog1.filename <> "" Then
filename(i) = CommonDialog1.filename
List1.AddItem (filename(i))
i = i + 1
End If
End Sub

Private Sub Combo1_Change()
Select Case Combo1.Text
Case "WAV"
File1.Pattern = "*.wav"
Case "AVI"
File1.Pattern = "*.avi"
Case "MID"
File1.Pattern = "*.mid"
Case "MPG"
File1.Pattern = "*.mpg"
Case "MP3"
File1.Pattern = "*.mp3"
End Select
End Sub

Private Sub Delete_Click()
If List1.ListIndex <= 9 And List1.ListIndex >= 0 Then
k = List1.ListIndex
List1.RemoveItem (List1.ListIndex)
i = i - 1
End If
For k = k To 8
filename(k) = filename(k + 1)
If filename(k + 2) = "" Then
Exit For
End If
Next k
filename(i + 1) = ""
MC.filename = ""
Label2.Caption = "No File"
If i = 0 Then
MC.filename = ""
Label2.Caption = "No File"
MC.BackEnabled = False
MC.StepEnabled = False
MC.Command = "close"
MC.PlayEnabled = False
MC.PrevEnabled = False
MC.NextEnabled = False
End If
End Sub

Private Sub Dir1_Change()
File1.filename = Dir1.Path
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub

Private Sub Exitb_Click()
MC.Command = "close"
Unload Form1
End Sub

Private Sub File1_Click()
MC.Command = "close"
Select Case Combo1.Text
Case "AVI"
MC.DeviceType = "AVIVideo"
Case "WAV"
MC.DeviceType = "waveaudio"
Case "MID"
MC.DeviceType = "Sequencer"
Case "MPG"
MC.DeviceType = "MPEGVideo"
Case "MP3"
MC.DeviceType = "MPEGVideo"
End Select
MC.filename = Dir1.Path + "\" + File1.filename
MC.Command = "open"
MC.PlayEnabled = True
MC.PrevEnabled = True
MC.NextEnabled = True
End Sub

Private Sub Form_Load()

End Sub

Private Sub List1_Click()
MC.Command = "close"
MC.filename = filename(List1.ListIndex)
MC.Command = "open"
Combo1.Text = UCase(Mid(MC.filename, Len(MC.filename) - 2, 3))
MC.PlayEnabled = True
MC.PrevEnabled = True
MC.NextEnabled = True
If i >= 2 Then
MC.StepEnabled = True
MC.BackEnabled = True
End If
End Sub

Private Sub MC_Done(NotifyCode As Integer)
MC.Command = "close"
If List1.ListIndex = 0 Then
MC.filename = filename(i)
List1.ListIndex = i - 1
MC.Command = "open"
ElseIf List1.ListIndex >= 1 Then
MC.filename = filename(List1.ListIndex - 1)
List1.ListIndex = List1.ListIndex - 1
MC.Command = "open"
End If

End Sub

Private Sub Slider1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim lVol As lVolType, vol As VolType, LV As Double, RV As Double

'
' If Level < 0 Then
' Vol.LV = 32767 * Form1.Slider1.Value / 100
' Else
' Vol.RV = 32767 * Form1.Slider1.Value / 100
' End If
LV = Level * 65535: If LV > 32767 Then LV = LV - 65536
RV = Level * 65535: If RV > 32767 Then RV = RV - 65536
vol.LV = LV
vol.RV = RV
LSet lVol = vol
v = lVol.v

waveOutSetVolume 0, v

End Sub

Private Sub Timer1_Timer()
Label1.Left = Label1.Left + j
Label1.Top = Label1.Top + l
If Label1.Left > 8000 Or Label1.Left < 3000 Then
j = -j
End If
If Label1.Top < 1200 Or Label1.Top > 5000 Then
l = -l
End If


End Sub

搜索更多相关主题的帖子: baidu 
2006-07-26 10:58
穆扬
Rank: 1
等 级:禁止发言
帖 子:1910
专家分:0
注 册:2006-6-1
得分:0 
提示: 作者被禁止或删除 内容自动屏蔽

2006-07-26 11:23



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-80298-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.171512 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved