【VB开源代码栏目提醒】：网学会员为需要VB开源代码的朋友们搜集整理了闹铃软件VB源码+设计思路 doc - 培训资料相关资料，希望对各位网友有所帮助!

闹铃软件D2.0版附界面VB源码 ——值得参考的VB源码 作者西门吹雪 本文适用于初中级VB程序设计爱好者做研究参考。

    高级程序设计者及精通API的飘过看懂这个程序后相信你能很熟练VB。

     笔者认为程序设计主要靠两方面的能力一是技术二是思路。

    技术上的问题都不是问题自己的思路则是你成功的首要前提。

    本程序的一些巧妙的设计可以为大家提供借鉴。

     下面先介绍一下主要功能吧 1·启动定时后时间到后播放器开始播放音乐 2·支持用户自定义歌曲 3·程序自动记录用户信息歌曲列表所定时间选项主题等重启程序时加载用户信息 4·简单数据库记录歌曲路径等 5·支持用户定两个时间 6·用户点击关闭时询问 7·用户点击最小化按钮时最小化到托盘 8·实现托盘菜单 9·支持顺序播放音乐列表。

     10·实现标准时间显示 以下是本程序的界面截图 1·托盘图标及托盘菜单实现最小化到托盘 2·主菜单截图 3·音乐框菜单截图实现列表框右键选中项目 4·退出询问截图实现关闭程序不直接退出 5·主界面截图 主程序代码 发送按键 Private Declare Sub keybd_event Lib user32 ByVal bVk As Byte ByVal bScan As Byte ByVal dwFlags As Long ByVal dwExtraInfo As Long Const KEYEVENTF_KEYUP H2 Option Explicit Private Declare Function LockWorkStation Lib user32.dll As Long 变量列表a1b1c1d1d2c3d3nm Dim a1 As String b1 As String c1 As String d1 As String Dim d2 As String c3 As Integer d3 As String n shun As Integer Dim m picu As String 用户数据数组 变量列表ptampnlb1lb2op1op2con Private Type config pic As String 背景 pta As String 用户路径 mpn As String 歌曲名字 lb1 As String 时间1 lb2 As String 时间2 op1 As Integer 开关1 op2 As Integer 开关2 End Type Dim con As config 歌曲信息数组 变量列表nampthpat Private Type lujing nam As String 16 pth As String 64 End Type Dim pat As lujing Dim thr As Integer API实现右键选中 Private Declare Sub mouse_event Lib user32 ByVal dwFlags As Long ByVal dx As Long ByVal dy As Long ByVal cButtons As Long ByVal dwExtraInfo As Long Const MOUSEEVENTF_LEFTDOWN H2 Const MOUSEEVENTF_LEFTUP H4 载入自动编码函数原创 变量列表mn Function bianmaname As String As Integer Dim mn As String If name Then bianma 1000 If name Then mn AscLeftname 1 AscRightname 1 Lenname bianma AbsMidmn 2 1 Rightmn 1 Lenmn Midmn FixLenmn / 2 1 End If End Function 载入判断文件类型函数成员为文件全名原创。

     变量列表m2flkon2p Function filtins As String As String Dim qufan As String P As Integer Dim m2 f l k o As String Dim n2 I As Integer m2 ins l ins n2 Lenins For I 1 To Lenm2 Midm2 I 1 Midm2 n2 1 - I 1 Next I k Leftm2 Fixn2 / 2 For I 1 To Lenm2 Midm2 n2 1 - I 1 Midl I 1 o Rightm2 Fixn2 / 2 Next I If n2 Mod 2 0 Then qufan k o If n2 Mod 2 1 Then qufan k Midl n2 1 / 2 1 o P InStrqufan . filt Rightins P End Function 载入不带后缀文件名函数原创。

    变量列表cn3 Function chunyuan As String As String Dim cn3 As String cn3 filtyuan 返回文件类型 chun Leftyuan Lenyuan - Lencn3 返回纯文件名 End Function Private Sub bangzhu_Click Form5.Show End Sub Private Sub banquan_Click Form4.Show Me.Hide End Sub 接受用户定时数据按钮。

     变量列表na1c1d1 Private Sub Command1_Click n n 1 If Text1.Text Then 禁止小时缺省 MsgBox 请在文本框输入需要定的时间 Text1.SetFocus Exit Sub Else: GoTo 6: End If 6: If Text2.Text Then Text2.Text 0 允许分钟缺省 c1 Text1.Text d1 Text2.Text If Lenc1 1 Then c1 0 c1 自动填补为两位数 If Lend1 1 Then d1 0 d1 a1 c1 : d1 :00 a1为标签传递参数 If n Mod 2 1 Then Label5.Caption a1 If n Mod 2 0 Then Label11.Caption a1 End Sub Private Sub Command2_Click n n 1 If n Mod 2 1 Then Command2.Caption 播放 WindowsMediaPlayer2.Controls.pause ElseIf n Mod 2 0 Then Command2.Caption 停止 WindowsMediaPlayer2.Controls.play End If End Sub 实现顺序播放 Private Sub Command3_Click shun 0 Get 5 bianmachunList1.Listshun pat WindowsMediaPlayer2.Enabled True WindowsMediaPlayer2.URL pat.pth Timer4.Enabled True End Sub 接受添加音乐文件。

     变量列表c3d3nampththr Private Sub Command4_Click Dim I As Integer cdOpen.Action 1 cdOpen.InitDir d3 For I 0 To List1.ListCount - 1 防止项目重复 If cdOpen.FileTitle List1.ListI Then Exit Sub Next I If cdOpen.FileTitle Then GoTo tiaoguo c3 LencdOpen.FileName - LencdOpen.FileTitle c3为用户打开文件路径字符长度 d3 LeftcdOpen.FileName c3 d3为用户打开文件夹路径 pat.nam cdOpen.FileTitle pat.pth cdOpen.FileName thr bianmachuncdOpen.FileTitle Put 5 thr pat tiaoguo: List1.AddItem cdOpen.FileTitle End Sub Private Sub Command5_Click 测试 pat.nam pat.pth Put 5 1000 pat Get 5 1000 pat MsgBox pat.pth End Sub Private Sub cSysTray1_MouseDblClickButton As Integer Id As Long 主程序.WindowState vbNormal 主程序.Visible True End Sub Private Sub dingshiguanji_Click Me.Hide 关机.Show End Sub Private Sub fe1_Click 主程序.Picture LoadPictureApp.Path 风景1.jpg picu 风景1 End Sub Private Sub fe2_Click 主程序.Picture LoadPictureApp.Path 风景2.jpg picu 风景2 End Sub Private Sub fe3_Click 主程序.Picture LoadPictureApp.Path 风景3.jpg picu 风景3 End Sub Private Sub Form_Load Dim s x1 x2 x3 x4 x5 x6 x7 As String Timer1.Interval 1000 Timer2.Interval 1000 Timer3.Interval 1000 Timer4.Interval 1000 Timer4.Enabled False Open App.Path ced.dat For Random As 5 Len Lenpat 打开数据文件 pat.nam 好不好.mp3 pat.pth App.Path 好不好.mp3 thr bianmachun好不好.mp3 Put 5 thr pat Dim m As String m App.Path 返回程序安装路径 If RightApp.Path 1 Then m m 防止根目录错误 cdOpen.Filter 所有文件.音乐文件.mp3音频文件.wma cdOpen.FilterIndex 2 Label7.Caption HourTime : MinuteTime : SecondTime 加载系统时间 Label15.Caption YearDate 年 MonthDate 月 DayDate 日 ChooseWeekdayNow vbMonday 星期一 星期二 星期三 星期四 星期五 星期六 星期日 加载音乐列表 On Error GoTo err: Open m mp3config.txt For Input As 4 Do While Not EOF4 Line Input 4 s List1.AddItem s Loop err: Close 4 加载其它设置 On Error GoTo checkerror Open m config.txt For Input As 2 Do While Not EOF2 Input 2 x1 x2 x3 x4 x5 x6 x7 If x1 Then x1 m d3 x1 cdOpen.InitDir x1 Label5.Caption x5 Label11.Caption x6 Label13.Caption x2 Check1.Value x3 Check2.Value x4 主程序.Picture LoadPictureApp.Path x7 .jpg Loop Close 2 GoTo orr: checkerror: Close 2 主程序.Picture LoadPictureApp.Path 美女.jpg orr: End Sub Private Sub Form_QueryUnloadCancel As Integer UnloadMode As Integer Dim I As Integer Cancel 1 Open m mp3config.txt For Output As 3 For I 0 To List1.ListCount - 1 Print 3 List1.ListI Next I Close 3 con.pic picu con.pta d3 con.mpn Label13.Caption con.lb1 Label5.Caption con.lb2 Label11.Caption con.op1 Check1.Value con.op2 Check2.Value Open m config.txt For Output As 1 Print 1 con.pta vbNewLine con.mpn vbNewLine con.op1 vbNewLine con.op2 Write 1 con.lb1 Write 1 con.lb2 Write 1 con.pic Close 1 Form3.Show Exit Sub End Sub Private Sub guanyu_Click MsgBox vbNewLine 时尚闹钟D2.0版 vbNewLine vbNewLine 改进版本请关注西门吹雪官方网站 vbNewLine vbNewLine End Sub Private Sub help_Click Form5.Show Me.Hide End Sub Private Sub List1_Click Label13.Caption List1.Text End Sub 接受用户双击音乐列表试听。

     变量列表msmn1pth Private Sub List1_DblClick 双击 Dim ms mn2 As String Dim mn1 As Integer ms chunList1.Text mn1 bianmaCStrms Get 5 mn1 pat mn2 pat.pth WindowsMediaPlayer2.URL pat.pth End Sub Private Sub List1_MouseDownButton As Integer Shift As Integer x As Single y As Single If Button 2 Then 实现右键选择 mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP 0 0 0 0 End If End Sub Private Sub List1_MouseUpButton As Integer Shift As Integer x As Single y As Single If Button 2 Then PopupMenu youjiancaidan 4 8500 shiting 列表弹出菜单 End Sub Private Sub me1_Click 主程序.Picture LoadPictureApp.Path 美女1.jpg picu 美女1 End Sub Private Sub me2_Click 主程序.Picture LoadPictureApp.Path 美女2.jpg picu 美女2 End Sub Private Sub me3_Click 主程序.Picture LoadPictureApp.Path 美女3.jpg picu 美女3 End Sub Private Sub me4_Click 主程序.Picture LoadPictureApp.Path 美女4.jpg picu 美女4 End Sub Private Sub qingkong_Click List1.Clear End Sub Private Sub qingling_Click Label5.Caption 00:00 Label11.Caption 00:00 Label13.Caption 好不好.mp3 Check1.Value 0 Check2.Value 0 List1.Clear End Sub Private Sub sh1_Click 主程序.Picture LoadPictureApp.Path 帅哥1.jpg picu 帅哥1 End Sub Private Sub sh2_Click 主程序.Picture LoadPictureApp.Path 帅哥2.jpg picu 帅哥2 End Sub Private Sub shanchu_Click On Error GoTo checkerror List1.RemoveItem List1.ListIndex checkerror: Exit Sub End Sub Private Sub shiting_Click Get 5 bianmachunList1.Text pat WindowsMediaPlayer2.URL pat.pth End Sub Private Sub suo_Click LockWorkStation End Sub Private Sub suoding_Click LockWorkStation End Sub Private Sub Text1_Change Text1.MaxLength 2 限制二位数字 If LenText1.Text 2 Then Text2.SetFocus 自动跳转 If ValText1.Text 23 Then 限制24小时制 MsgBox 请输入正确的小时数0到23 Text1.Text Text1.SetFocus End If End Sub Private Sub Text1_KeyPressKeyAscii As Integer 限制输入数字和退格 If KeyAscii 8 Then ElseIf KeyAscii 47 Or KeyAscii 58 Then KeyAscii 0 End If End Sub Private Sub Text2_Change Text2.MaxLength 2 If LenText2.Text 2 Then Command1.SetFocus 自动跳转 If ValText2.Text 59 Then 限制60分钟制 MsgBox 请输入正确的小时数0到59 Text2.Text Text2.SetFocus End If End Sub Private Sub Text2_KeyPressKeyAscii As Integer 限制输入数字和退格 If KeyAscii 8 Then ElseIf KeyAscii 47 Or KeyAscii 58 Then KeyAscii 0 End If End Sub Private Sub Timer1_Timer 主界面时间 Dim a2 As String b2 As String c2 As String Dim I As Integer 此处供测试 a2 HourTime b2 MinuteTime c2 SecondTime If Inta2 / 10 1 Then a2 0 a2 限制显示两位时间 If Intb2 / 10 1 Then b2 0 b2 If Intc2 / 10 1 Then c2 0 c2 Label7.Caption a2 : b2 : c2 d2 Label7.Caption 此处供测试 Timer2.Enabled IIfCheck1 True False Timer3.Enabled IIfCheck2 True False If List1.ListCount 0 Then List1.AddItem 好不好.mp3 默认音乐 On Error GoTo checkerror For I 0 To List1.ListCount - 1 If List1.ListI Then List1.RemoveItem I Next I checkerror: Exit Sub End Sub Private Sub Timer2_Timer 选项一 If d2 Label5.Caption Then Label10 时间到啦: HourTime 时 MinuteTime 分 On Error GoTo checkerror WindowsMediaPlayer2.URL d3 Label13.Caption checkerror: Get 5 bianmaCStrchunLabel13.Caption pat WindowsMediaPlayer2.Enabled True WindowsMediaPlayer2.URL pat.pth End If End Sub Private Sub Timer3_Timer 选项二 If d2 Label11.Caption Then Label10 时间到啦: HourTime 时 MinuteTime 分 Get 5 bianmachunLabel13.Caption pat WindowsMediaPlayer2.URL pat.pth End If End Sub Private Sub Timer4_Timer If WindowsMediaPlayer2.playState 1 Then shun shun 1 Get 5 bianmachunList1.Listshun pat WindowsMediaPlayer2.URL pat.pth End If If shun List1.ListCount - 1 Then Timer4.Enabled False End Sub Private Sub tuichu_Click Dim I As Integer Open m mp3config.txt For Output As 3 For I 0 To List1.ListCount - 1 Print 3 List1.ListI Next I Close 3 con.pic picu con.pta d3 con.mpn Label13.Caption con.lb1 Label5.Caption con.lb2 Label11.Caption con.op1 Check1.Value con.op2 Check2.Value Open m config.txt For Output As 1 Print 1 con.pta vbNewLine con.mpn vbNewLine con.op1 vbNewLine con.op2 Write 1 con.lb1 Write 1 con.lb2 Write 1 con.pic Close 1 End End Sub Private Sub tuichu1_Click Dim I As Integer Open m mp3config.txt For Output As 3 For I 0 To List1.ListCount - 1 Print 3 List1.ListI Next I Close 3 con.pic picu con.pta d3 con.mpn Label13.Caption con.lb1 Label5.Caption con.lb2 Label11.Caption con.op1 Check1.Value con.op2 Check2.Value Open m config.txt For Output As 1 Print 1 con.pta vbNewLine con.mpn vbNewLine con.op1 vbNewLine con.op2 Write 1 con.lb1 Write 1 con.lb2 Write 1 con.pic Close 1 cSysTray1.InTray False 主程序.WindowState vbNormal 主程序.Visible True 主程序.SetFocus keybd_event vbKeyControl 0 0 0 keybd_event vbKeyF1 0 0 0 keybd_event vbKeyControl 0 KEYEVENTF_KEYUP 0 Exit Sub End End Sub Private Sub xinggan_Click 主程序.Picture LoadPictureApp.Path 性感.jpg picu 性感 End Sub Private Sub xingx_Click 主程序.Picture LoadPictureApp.Path 性感2.jpg picu 性感2 End Sub Private Sub xuanding_Click Label13.Caption List1.Text End Sub Private Sub Form_Resize If Me.WindowState vbMinimized Then cSysTray1.InTray True Me.Visible False Else: cSysTray1.InTray True End If End Sub Private Sub cSysTray1_MouseDownButton As Integer Id As Long If Button 2 Then PopupMenu tuopan 10 End Sub Private Sub zhuangkuang_Click Dim chk3 chk4 As String If Timer2.Enabled True Then chk3 LeftLabel5 5 If Timer3.Enabled True Then chk4 LeftLabel11 5 If Timer2.Enabled False And Timer3.Enabled False Then MsgBox 您未启动定时系统 Else MsgBox 您所定的时间是: chk3 chk4 End If End Sub Private Sub zhujiemian_Click 主程序.WindowState vbNormal 主程序.Visible True End Sub 其他部件代码相信大家都能写得出来在此不再赘述开头的几个自创的函数适合初学者研究你能得到一些启发有不明白的地方可以联系笔者需要本软件的也可以QQ我欢迎交流。

     QQ529472731 E-mail:zhaorujiajia163.com