急求:VB能不能有背景音乐

Posted 2023-05-17

怎么加 (代码)???

楼上的废话太多，都是copy的。 其实太简单了。
1.右键单击vb左边的工具栏 选择部件。
2.出来的对话框添加 windows media player 在最后面。（如果没有，按浏览，在windows下面的system32目录 里面有个wmp.dll 就是了）
3.按确定，把多出来的控件画到窗体上面
4.改属性。里面的url可以填硬盘的文件，也可以填网络上的。
5.如果不想让控件显示出来 改Visible属性，为false
6.如果不想用物理路径直接指定音乐文件。可以在form的load事件添加代码
WindowsMediaPlayer1.url = app.path & "\music.mp3"
这样子音乐文件就是你的程序同目录下的music.mp3 参考技术A 其实不难。这问题我答了N遍...或许提问之前先搜索已解决的问题。

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

Private Sub Form_Load()
mciSendString "open C:\birthday.mid alias mc", 0, 0, 0
mciSendString "play mc", 0, 0, 0
End Sub 参考技术B '打开一个Form 将下面代码全部粘贴进去就好啦, 不用添加任何控件.

'CBM666 为了记念母亲的伟大而特别设计

Option Explicit
DefLng A-Z 'define Long type as default declaration of variables.
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
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long '-下载文件
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc, ByVal X, ByVal Y) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function GetNearestColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Const SRCPAINT = &HEE0086 'dest = source OR dest
Private Const SRCERASE = &H440328 'dest = source AND (NOT dest )
Private Const SRCAND = &H8800C6 'dest = source AND dest
Private Const SRCCOPY = &HCC0020 'dest = source
Private Const SRCINVERT = &H660046 'dest = source XOR dest
Dim xx1() As Single, yy1() As Single
Dim Vxx1() As Single, Vyy1() As Single
Dim oldcolor() As Long
Dim StopSnow As Boolean, clearpic As Boolean
Dim VxMisnowpcs!, VxMaxx1!, VyMisnowpcs!, VyMaxx1!
Dim VxAddMin!, VxAddMax!, VyAddMin!, VyAddMax!
Dim hdcSnow&, HwndSnow&, snowpcs&, colorno&, songname$
Dim W%, H%, i%, j%, twid%, thigh%, playyn As Boolean
Dim vx!, vy!, X!, Y!, r!, jx
Private WithEvents Timer1 As Timer
Private WithEvents Timer2 As Timer
Private WithEvents Label1 As Label
Private WithEvents Label2 As Label
Private Sub Form_Load()
Set Timer1 = Controls.Add("vb.timer", "timer1")
Set Timer2 = Controls.Add("vb.timer", "timer2")
Timer1.Interval = 10
Timer2.Interval = 500
Set Label1 = Controls.Add("vb.label", "Label1")
Set Label2 = Controls.Add("vb.label", "Label2")
Me.WindowState = 2
Me.BackColor = QBColor(0)
Me.BorderStyle = 0: Me.Caption = "": Me.ScaleMode = 3
Me.Width = Screen.Width: Me.Height = Screen.Height: Me.Move 0, 0
Me.Show: DoEvents
Label1.Visible = True
Label1.Caption = "←雪往左飘, →雪往右飘, ↑雪往上飘, ↓雪往下飘,Home 风大了,End 风小了,鼠标右键雪停了或再下雪"
Label1.AutoSize = True
Label1.BackStyle = 0
Label1.Font = "楷体_GB2312"
Label1.FontSize = 16
Label1.ForeColor = QBColor(10)
Label1.Move 5, 20 '(Me.Width - Label1.Width) \ 15 \ 2, 20

Label2.Visible = True
Label2.Caption = "游 子 吟"
Label2.AutoSize = True
Label2.BackStyle = 0
Label2.Font = "楷体_GB2312"
Label2.FontSize = 48
Label2.ForeColor = QBColor(10)
Label2.Move (Me.Width - Label2.Width * 15) \ 2 \ 15, (Me.Height - Label2.Height * 15) \ 2 \ 15
snowpcs = 800

twid = Me.ScaleWidth - 1: thigh = Me.ScaleHeight - 1
Call SetSpeed '设定速度
HwndSnow = Me.hwnd
hdcSnow = GetDC(HwndSnow)
Call startsnow '开始下雪
Me.KeyPreview = True
End Sub

Private Sub Form_Activate()
songname = "c:\traveler.mp3"
If Dir(songname) = "" Then Call dlmusic '下载音乐
Timer2.Enabled = True
End Sub

'timer1.interval=1--100,vx= -5--+5 , vy=-5--+5, r=0--5
Sub SetSpeed()
VxAddMin = -0.1: VxAddMax = 0.1
VyAddMin = -0.1: VyAddMax = 0.1
vx = 2 'HScroll1(1).Value / 2
vy = 2 'HScroll1(2).Value / 2
r = 2.5 'HScroll1(3).Value / 4
VxMisnowpcs = vx - r / 2: VxMaxx1 = vx + r / 2
VyMisnowpcs = vy - r / 2: VyMaxx1 = vy + r / 2
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then '左键退出,右键停止下雪
Unload Me
Else '2
If StopSnow = False Then Call startsnow
StopSnow = Not StopSnow
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
DeleteUsedSnowDC
mciSendString "stop " & songname, vbNullString, 0, 0
mciSendString "close " & songname, vbNullString, 0, 0
End
End Sub

Sub DeleteUsedSnowDC()
If hdcSnow <> 0 Then
ClearSnowParticles
ReleaseDC HwndSnow, hdcSnow
End If
End Sub

Sub InitPos()
ReDim xx1(snowpcs), yy1(snowpcs), Vxx1(snowpcs), Vyy1(snowpcs), oldcolor(snowpcs)
Dim hdc
hdc = hdcSnow
W = twid: H = thigh
For i = 1 To snowpcs
xx1(i) = Rnd * W: yy1(i) = Rnd * H
colorno = &HFFFFFF ' &HFFEFEF
oldcolor(i) = GetPixel(hdc, xx1(i), yy1(i))
Vxx1(i) = VxMisnowpcs + Rnd * (VxMaxx1 - VxMisnowpcs)
Vyy1(i) = VyMisnowpcs + Rnd * (VyMaxx1 - VyMisnowpcs)
Next
End Sub

Private Sub Timer1_Timer()
AnimateSnow
End Sub

Private Sub startsnow()
Timer1.Enabled = False
StopSnow = False
ClearSnowParticles
clearpic = True
If snowpcs < 0 Then snowpcs = 250
InitPos
'this loop is to reach to steady state motion!
For i = 1 To 50
AnimateSnow 'False
DoEvents
Next
AnimateSnow
Timer1.Enabled = True
End Sub

Sub SetValueInRange(v As Variant, ByVal RangeMin As Variant, ByVal RangeMax As Variant, Optional SwapMaxMin As Boolean = False)
If SwapMaxMin Then 'swapMaxMin=True:
If v < RangeMin Then v = RangeMax Else If v > RangeMax Then v = RangeMin
Else 'default (swapmaxmin=false)
If v < RangeMin Then v = RangeMin Else If v > RangeMax Then v = RangeMax
End If
End Sub

Sub AnimateSnow()
Dim hdc
hdc = hdcSnow
W = twid: H = thigh
For i = snowpcs To 1 Step -1
colorno = oldcolor(i)
If colorno <> -1 Then SetPixelV hdc, xx1(i), yy1(i), colorno
Next
For i = 1 To snowpcs
X = xx1(i): Y = yy1(i)
vx = Vxx1(i) + VxAddMin + Rnd * (VxAddMax - VxAddMin)
vy = Vyy1(i) + VyAddMin + Rnd * (VyAddMax - VyAddMin)
SetValueInRange vx, VxMisnowpcs, VxMaxx1
SetValueInRange vy, VyMisnowpcs, VyMaxx1
Vxx1(i) = vx: Vyy1(i) = vy
X = X + vx: Y = Y + vy
If Not StopSnow Then
If Y > H And vy >= 0 Then
Y = 0
Else
If Y < 0 And vy <= 0 Then Y = H
End If
End If
SetValueInRange X, 0, W, True
colorno = GetPixel(hdc, X, Y)
xx1(i) = X: yy1(i) = Y
oldcolor(i) = colorno
SetPixelV hdc, X, Y, QBColor(15)
Next
End Sub

Sub ClearSnowParticles()
Dim hdc
If clearpic = False Then Exit Sub
hdc = hdcSnow
For i = snowpcs To 1 Step -1
colorno = oldcolor(i)
If colorno <> -1 Then SetPixelV hdc, xx1(i), yy1(i), colorno
Next
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 27 'Esc键
Unload Me
Case 36 'Home键
Timer1.Interval = IIf(Timer1.Interval <= 1, 1, Timer1.Interval - 1)
Case 35 'End键
Timer1.Interval = IIf(Timer1.Interval >= 100, 100, Timer1.Interval + 1)
Case 38 '上键
vy = IIf(vy <= -5, -5, vy - 1)
Case 40 '下键
vy = IIf(vy >= 5, 5, vy + 1)
Case 37 '左键
vx = IIf(vx <= -5, -5, vx - 1)
Case 39 '右键
vx = IIf(vx >= 5, 5, vx + 1)
End Select
VxMisnowpcs = vx - r / 2: VxMaxx1 = vx + r / 2
VyMisnowpcs = vy - r / 2: VyMaxx1 = vy + r / 2
End Sub

Sub dlmusic()
'下载音乐文件
DownloadFile "http://cbm666.com/music/traveler.mp3", songname
End Sub

Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean '下载文件
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function

Sub playmusic()
If Dir(songname) <> "" Then
mciSendString "open " & songname & " type mpegvideo", vbNullString, 0, 0
mciSendString "play " & songname & " repeat", vbNullString, 0, 0
playyn = True
End If
End Sub

Private Sub Timer2_Timer()
Label2.ForeColor = QBColor(Int(Rnd * 7) + 9)
If playyn = False Then
Call playmusic
End If
End Sub

参考资料：vb吧

参考技术C 使用Microsoft Visual Basic进行多媒体音乐的播放是一件非常容易的事情。Microsoft Windows系统中支持两种声音文件：WAV格式文件和MIDI格式文件，一般使用API(Windows应用程序编程接口)函数sndPlaySound播放WAV格式文件，使用mciExecute函数来播放MIDI文件。

1、播放WAV格式文件

要播放WAV格式文件，你必须在程序窗口的通用声明部分或标准模块中添加如下的声明：

Public Const SND_SYNC = &&H0

Public Const SND_ASYNC = &&H1

Public Const SND_NODEFAULT = &&H2

Public Const SND_MEMORY = &&H4

Public Const SND_ALIAS = &&H10000

Public Const SND_FILENAME = &&H20000

Public Const SND_RESOURCE = &&H40004

Public Const SND_ALIAS_ID = &&H110000

Public Const SND_ALIAS_START = 0

Public Const SND_LOOP = &&H8

Public Const SND_NOSTOP = &&H10

Public Const SND_VALID = &&H1F

Public Const SND_NOWAIT = &&H2000

Public Const SND_VALIDFLAGS = &&H17201F

Public Const SND_RESERVED = &&HFF000000

Public Const SND_TYPE_MASK = &&H170007

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

sndPlaySound函数需要两个参数：第一个参数soundfilename是要播放的WAV文件的名称；第二个参数是一个表明播放方式的标识常量，其定义的值如前面的声明所示，通常所使用的标识意义如下：

SND_SYNC播放WAV格式文件，播放完毕后将控制转移回应用中。

SND_ASYNC播放WAV格式文件，将控制立即转移回应用程序中，而不管对WAV文件的播放是否结束。

SND_MEMORY用于播放以前已经加载到内存中的WAV格式文件。

SND_LOOP循环播放WAV格式文件。

注意：SND_LOOP标识通常需要同SND_ASYNC共同使用，也即在两个标识之间添加“与”播放符，以免在对WAV格式文件进行播放的时候将系统挂起。

2、播放MIDI格式文件

播放MIDI格式文件时，你必须在程序窗口的通用声明部分中或标准模块中添加如下的声明语句：

Private Declare Function mciExecute Lib "winmm.dll" Alias "mciExecute" (ByVal lpstrCommand As String) As Long

API函数mciExecute只有一个参数：CommandString，它是一个命令字符串，用于表明对声音文件播放的命令，例如，要完整播放声音文件“C:WindowsMediaCanyon.mid”，只需要用以下一些语句即可实现：

Dim ReturnValue As Long

ReturnSoundValue = mciExecute("play C:WindowsMediaCanyon.mid")

如果只播放MIDI格式文件的部分，就可以使用from...to...这种语句格式，例如：需要播放CANYON.MID文件的20毫秒到500毫秒的部分，可以使用如下的语句：

Dim ReturnValue As Long

ReturnSoundValue = mciExecute("play C: WINDOWS MEDIACANYON.MID from 20 to 500")

使用API函数mciExecute也可以用来对WAV格式文件进行播放，方法同播放MIDI基本一样。现举列如下：

1、在Visual Basic应用窗体中加入以下声明：

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Const SND_SYNC = &&H0

Const SND_ASYNC = &&H1

Const SND_NODEFAULT = &&H2

Const SND_MEMORY = &&H4

Const SND_ALIAS = &&H10000

Const SND_FILENAME = &&H20000

Const SND_RESOURCE = &&H40004

Const SND_ALIAS_ID = &&H110000

Const SND_ALIAS_START = 0

Const SND_LOOP = &&H8

Const SND_NOSTOP = &&H10

Const SND_VALID = &&H1F

Const SND_NOWAIT = &&H2000

Const SND_VALIDFLAGS = &&H17201F

Const SND_RESERVED = &&HFF000000

Const SND_TYPE_MASK = &&H170007

Private Declare Function mciExecute Lib "winmm.dll" Alias "mciExecute" (ByVal lpstrCommand As String) As Long

2、在窗中激活事件中加入以下代码：

Private Sub Form_Activate()

Dim ReturnValue As Long

ReturnValue = sndPlaySound("C:windowsMEDIATADA.WAV",SND_SYNC)End Sub

通过(F5)键来运行该程度即可听到背景音乐。 参考技术D 太长了吧?不好整.自己加一个WAV播放器,让其在form.load中就运行就可以解决了.

WinForm窗体，在VS2010上背景颜色不能设置透明，我把背景颜色和TransparencyK

WinForm窗体，在VS2010上背景颜色不能设置透明，我把背景颜色和TransparencyKey设置成同一个颜色，然后是透明了，但是加上背景图片以后就不是透明了，为毛，想要的效果就是像QQ的客户端一样，四角是透明的圆角，背景图片已经处理好了，在VS2012就可以设置透明背景颜色，求解低版本的实现方法啊，没分，对不住啊。。

参考技术A form的属性里有个opacity属性，可以调节控件的不透明度百分比，这个不行？追问

。。。。那个是设置整体窗体透明度的，而我只想让窗体本身透明。上面的控件并不透明，其实我就是想弄个圆角的窗口嘛，图片扣好了，但是四角总是会显示Form的背景色，。。。坑死