网页资讯视频图片知道文库贴吧地图采购
进入贴吧全吧搜索
vb吧 关注：156,084贴子：1,166,208

母亲节,献给天下所有的母亲!

'母亲节的礼物----提前献给天下所有的母亲
'粘贴代码到Form里,什么也不要做,编译...

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Form_Load()
runsound
End Sub

Sub runsound()
sd 6, 150: sd 5, 50: sd 3, 100: sd 5, 100: sd 8, 100: sd 6, 50: sd 5, 50: sd 6, 200
Sleep 50
sd 3, 100: sd 5, 50: sd 6, 50: sd 5, 100: sd 3, 100: sd 1, 50: sd 16, 50: sd 5, 50: sd 3, 50: sd 2, 200
Sleep 50
sd 2, 150: sd 3, 50: sd 5, 100: sd 5, 50: sd 6, 50: sd 3, 100: sd 2, 100: sd 1, 200
Sleep 50
sd 5, 150: sd 3, 50: sd 2, 50: sd 1, 50: sd 16, 50: sd 1, 50: sd 15, 200
Sleep 50
End Sub

Function playsnd(ByVal x As Long, y As Long)
Beep x, y * 3
DoEvents
End Function

Function sd(n&, l&)
Select Case n
Case 1
playsnd 440, l
Case 2
playsnd 494, l
Case 3
playsnd 554, l
Case 4
playsnd 622, l
Case 5
playsnd 698, l
Case 6
playsnd 784, l
Case 7
playsnd 880, l
Case 8
playsnd 988, l

Case 17
playsnd 392, l
Case 16
playsnd 349, l
Case 15
playsnd 311, l

End Select
End Function


Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Private Sub Form_Load()
runsound
End Sub

Sub runsound()
sd 6, 150: sd 5, 50: sd 3, 100: sd 5, 100: sd 8, 100: sd 6, 50: sd 5, 50: sd 6, 200
sd 3, 100: sd 5, 50: sd 6, 50: sd 5, 100: sd 3, 50: sd 2, 50: sd 1, 50: sd 5, 50: sd 3, 50: sd 2, 200
sd 2, 100: sd 2, 50: sd 3, 50: sd 5, 100: sd 5, 50: sd 6, 50: sd 3, 150: sd 2, 50: sd 1, 50: sd 16, 150
sd 5, 150: sd 3, 50: sd 2, 50: sd 1, 50: sd 16, 50: sd 1, 50: sd 15, 200
End Sub

Function playsnd(ByVal x As Long, y As Long)
Beep x, y * 4
DoEvents
End Function

Function sd(n&, l&)
Select Case n
Case 1
playsnd 440, l
Case 2
playsnd 494, l
Case 3
playsnd 554, l
Case 4
playsnd 587, l
Case 5
playsnd 659, l
Case 6
playsnd 739, l
Case 7
playsnd 830, l
Case 8
playsnd 880, l
Case 17
playsnd 415, l
Case 16
playsnd 369, l
Case 15
playsnd 329, l
End Select
End Function


2025-09-04 05:34:31
广告
不感兴趣
开通SVIP免广告
世上只有妈妈好！


顶！


不错,有创意.


1楼的音高有点错误，2楼修正了下，还稍改了谱，用的是我学的第一个电子琴单手曲谱


快试试吧，
可以对自己使用挽尊卡咯~
◆
◆
呵呵‘
　可以‘


hahugo88 电子琴是我的最爱, 我疯狂的时侯, 3台落地式的 Yamaha Roland 与Casio 与 5个多功能音效与节拍的键盘, 够壮观吧.

哈哈哈,littleczb 你重发吧.


2025-09-04 05:28:31
广告
不感兴趣
开通SVIP免广告
我音乐可不好,音不准可以谅解,哈哈.....
hahugo88的频率我收藏啦,不要见怪...


嘿嘿,我再发一个"再版"吧,效果可能好一些,不过要开音箱哦
'引用cbm的下载文件
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 ShellExecute Lib "shell32.dll" Alias _
 "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
 ByVal lpFile As String, ByVal lpParameters As String, _
 ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Private Sub Form_Activate()
 DownloadFile "http://ring.caishow.com/ring/268016.mid ", "C:\mother.mid"
 ShellExecute 0&, vbNullString, "C:\mother.mid", vbNullString, vbNullString, 0
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


Option Explicit
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub SingS(ByVal S As String)
Dim i As Integer
For i = 1 To Len(S)
 sd Mid(S, i, 1)
Next i
End Sub

Private Sub sd(ByVal n As Integer, Optional ByVal l As Integer = 125)
Select Case n
Case 0
Sleep l * 4
DoEvents
Case 1
Beep 440, l * 4
DoEvents
Case 2
Beep 494, l * 4
DoEvents
Case 3
Beep 554, l * 4
DoEvents
Case 4
Beep 587, l * 4
DoEvents
Case 5
Beep 659, l * 4
DoEvents
Case 6
Beep 739, l * 4
DoEvents
Case 7
Beep 830, l * 4
DoEvents
Case 8
Beep 880, l * 4
DoEvents
Case 17
Beep 415, l * 4
DoEvents
Case 16
Beep 369, l * 4
DoEvents
Case 15
Beep 329, l * 4
DoEvents
End Select
End Sub


我还是觉得音调不改的好，呵呵


12F的代码还得改进。。。
不要每次都去下那个http://ring.caishow.com/ring/268016.mid
运行一次就下一次。。
首先应该要用DIR判断是否存在这个文件了
如果不存在再下载。


并不是这样,我发现它可以自动判断.


扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频！
分享到: