小闹钟C10版VB源码.docx
- 文档编号:28905260
- 上传时间:2023-07-20
- 格式:DOCX
- 页数:28
- 大小:145.09KB
小闹钟C10版VB源码.docx
《小闹钟C10版VB源码.docx》由会员分享,可在线阅读,更多相关《小闹钟C10版VB源码.docx(28页珍藏版)》请在冰豆网上搜索。
小闹钟C10版VB源码
小闹钟程序
源文件及安装版下载地址:
功能简介:
闹钟定时、音乐播放、整点报时、定时关机等
注:
用户信息本地保存,VB语言,模块化代码设计
界面截图:
代码摘录:
’模块部分**********************************************************************
'函数声明
PublicDeclareFunctionShellExecuteLib"shell32.dll"Alias"ShellExecuteA"(ByValhwndAsLong,ByVallpOperationAsString,ByVallpFileAsString,ByVallpParametersAsString,ByVallpDirectoryAsString,ByValnShowCmdAsLong)AsLong
PublicDeclareFunctionPostMessageLib"user32"Alias"PostMessageA"(ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,ByVallParamAsLong)AsLong
PublicDeclareSubmouse_eventLib"user32"(ByValdwFlagsAsLong,ByValdxAsLong,ByValdyAsLong,ByValcButtonsAsLong,ByValdwExtraInfoAsLong)
PublicDeclareFunctionGetPrivateProfileStringLib"kernel32"Alias"GetPrivateProfileStringA"(ByVallpApplicationNameAsString,ByVallpKeyNameAsString,ByVallpDefaultAsString,ByVallpReturnedStringAsString,ByValnSizeAsLong,ByVallpFileNameAsString)AsLong
PublicDeclareFunctionWritePrivateProfileStringLib"kernel32"Alias"WritePrivateProfileStringA"(ByVallpApplicationNameAsString,ByVallpKeyNameAsString,ByVallpStringAsAny,ByVallpFileNameAsString)AsLong
'常量声明
PublicConstMOUSEEVENTF_LEFTDOWN=&H2
PublicConstMOUSEEVENTF_LEFTUP=&H4
PublicConstWM_QUIT=&H12
'数据类型声明
PublicTypeRECORD'记录数据类型
timeAsString*16'设定时间
URLAsString*128'歌曲路径
bcheckAsBoolean'是否选中
EndType
PublicTypeURL'歌曲数据类型
ftitleAsString*128'标题
fnameAsString*256'全名
fheadAsString*128'目录
EndType
'变量声明
PublicicountAsInteger'时间数组大小
PublicfcountAsInteger'路径数组大小
PubliciindexAsInteger'正在播放索引
PublicitmXAsListItem'列表
PublicistytleAsInteger'模式
PublicspicAsString'背景路径
Publicb_minAsBoolean'最小化时
Publicb_exitAsBoolean'关闭时
Publicb_speakAsBoolean'整点报时
PublicrtempAsRECORD'临时数据
Publicrcd()AsRECORD'记录结构体数组
PublicftempAsURL'临时数据
Publicfurl()AsURL'路径结构体数组
'读取数据备份
PublicFunctiongetdat()AsString
OnErrorResumeNext
DimretAsString
ret=String(255,0)
'spic
NC=GetPrivateProfileString(App.Title,"spic","Default",ret,255,App.Path&"\备份.ini")
IfNC<>0Thenspic=Left$(ret,NC):
主程序.Picture=LoadPicture(spic)
'b_min
NC=GetPrivateProfileString(App.Title,"b_min","Default",ret,255,App.Path&"\备份.ini")
IfNC<>0Thenb_min=CBool(Left$(ret,NC)):
主程序.zuixiao.Checked=b_min
'b_exit
NC=GetPrivateProfileString(App.Title,"b_exit","Default",ret,255,App.Path&"\备份.ini")
IfNC<>0Thenb_exit=CBool(Left$(ret,NC)):
主程序.guanbi.Checked=b_exit
'b_speak
NC=GetPrivateProfileString(App.Title,"b_speak","Default",ret,255,App.Path&"\备份.ini")
IfNC<>0Thenb_speak=CBool(Left$(ret,NC)):
主程序.zhengdian.Checked=b_speak
EndFunction
'写入歌曲列表地址
PublicFunctionwriteurl()AsLong
OnErrorGoToerr:
DimiAsInteger
IfDir(App.Path&"\furl.dat")<>""ThenKillApp.Path&"\furl.dat"
OpenApp.Path&"\furl.dat"ForRandomAs#112Len=Len(ftemp)
Fori=0ToUBound(furl)
Put#112,i+1,furl(i)
Nexti
Close#112
主程序.List1.Clear
Fori=0ToUBound(furl)
主程序.List1.AddItemgetstr(furl(i).ftitle)
Nexti
writeurl=0:
ExitFunction
err:
writeurl=1:
主程序.List1.Clear
EndFunction
'读取歌曲列表地址
PublicFunctionreadurl(ByReff_n()AsURL)AsLong
OnErrorGoToerr:
IfDir(App.Path&"\furl.dat")=""ThenGoToerr:
DimiAsInteger,flAsURL
OpenApp.Path&"\furl.dat"ForRandomAs#113Len=Len(ftemp)
WhileNotEOF(113)
i=i+1:
Get#113,i,fl
IfLen(getstr(fl.fhead))<>0AndLen(getstr(fl.fname))<>0Then_
ReDimPreservef_n(i-1):
f_n(i-1)=fl
Wend
Close#113
Fori=0ToUBound(f_n)
主程序.List1.AddItemgetstr(f_n(i).ftitle)
Nexti
readurl=0:
fcount=UBound(f_n):
ExitFunction
err:
readurl=1
EndFunction
'写入记录,False追加,True全写
PublicFunctionwritercd(allAsBoolean,rcAsRECORD,OptionalIdAsInteger)AsLong
OnErrorGoToerr:
DimiAsInteger
Ifall=TrueThenIfDir(App.Path&"\rcd.dat")<>""ThenKillApp.Path&"\rcd.dat"
OpenApp.Path&"\rcd.dat"ForRandomAs#110Len=Len(rc)
Ifall=FalseThen
Put#110,Id+1,rc
Else'全写
Fori=0ToUBound(rcd)
Put#110,i+1,rcd(i)
Nexti
EndIf
Close#110'关闭文件
writercd=0:
ExitFunction
err:
Close:
KillApp.Path&"\rcd.dat":
writercd=1
EndFunction
'获取本地记录
PublicFunctionreadrcd(ByReff_n()AsRECORD)AsLong
OnErrorGoToerr:
IfDir(App.Path&"\rcd.dat")=""ThenGoToerr:
DimiAsInteger,reAsRECORD
OpenApp.Path&"\rcd.dat"ForRandomAs#121Len=Len(rtemp)
WhileNotEOF(121)
i=i+1:
Get#121,i,re
IfLen(getstr(re.time))<>0AndLen(getstr(re.URL))<>0Then_
ReDimPreservef_n(i-1):
f_n(i-1)=re
Wend
IfSeek(121)=2AndUBound(f_n)=0AndLen(getstr(f_n(0).time))=0And_
Len(getstr(f_n(0).URL))=0ThenErasef_n():
GoToerr:
Close#121'关闭文件
readrcd=0:
icount=UBound(f_n):
ExitFunction
err:
readrcd=1
EndFunction
'列表定位
PublicFunctiongetid()AsInteger
DimiAsInteger
If主程序.WindowsMediaPlayer1.playState=3Then
Fori=0To主程序.List1.ListCount-1
Ifexe(主程序.WindowsMediaPlayer1.URL)=主程序.List1.List(i)Then
getid=i:
ExitFunction
EndIf
Nexti
EndIf
getid=-1
EndFunction
'更改播放器列表
PublicFunctionsetwmp()AsLong
OnErrorGoToerr:
DimvbMediaAsIWMPMedia,iAsInteger
主程序.WindowsMediaPlayer1.currentPlaylist.Clear
Fori=0ToUBound(furl)
SetvbMedia=主程序.WindowsMediaPlayer1.newMedia(getstr(furl(i).fname))
If主程序.WindowsMediaPlayer1.currentPlaylist.Count=0Then'当前播放列表为空时
主程序.WindowsMediaPlayer1.currentMedia=vbMedia
Else'当前列表不为空时
主程序.WindowsMediaPlayer1.currentPlaylist.appendItemvbMedia
EndIf
Nexti
SetcMedia=Nothing
setwmp=主程序.WindowsMediaPlayer1.currentPlaylist.Count
err:
EndFunction
'去结束符
PublicFunctiongetstr(stAsString)AsString
getstr=st
WhileRight(getstr,1)=Chr(0)
getstr=Left(getstr,Len(getstr)-1)
Wend
getstr=RTrim(getstr)
EndFunction
'删除指定项byindex
PublicSubdel(ByRefa()AsRECORD,anAsInteger)'删除指定数组byindex
DimiAsInteger
OnErrorGoToerr:
'空数组处理
Ifan>UBound(a)Oran<0ThenExitSub
Fori=anToUBound(a)-1
a(i)=a(i+1)'从第an个元素开始,每个元素向前移动一位
Nexti
ReDimPreservea(UBound(a)-1)'数组大小-1
ExitSub
err:
Erasea
EndSub
'删除指定项byindex
PublicSubdell(ByRefa()AsURL,anAsInteger)'删除指定数组byindex
DimiAsInteger
OnErrorGoToerr:
'空数组处理
Ifan>UBound(a)Oran<0ThenExitSub
Fori=anToUBound(a)-1
a(i)=a(i+1)'从第an个元素开始,每个元素向前移动一位
Nexti
ReDimPreservea(UBound(a)-1)'数组大小-1
ExitSub
err:
Erasea
EndSub
'数组排序函数
PublicFunctionupm(ByRefb()AsRECORD)'升序排列,冒泡法
DimiAsInteger,jAsInteger,tAsRECORD
OnErrorGoToerr:
'空数组处理
Fori=0ToUBound(b)-1
Forj=0ToUBound(b)-i-1
Ifb_max(b(j),b(j+1))Thent=b(j):
b(j)=b(j+1):
b(j+1)=t
Nextj
Nexti
err:
EndFunction
'元素交换位置,默认前移
PublicFunctionmoveto(ByRefarr()AsURL,IdAsInteger,OptionalitailAsInteger)
DimtempAsURL
OnErrorGoToerr:
Ifitail=0Then
temp=arr(Id-1):
arr(Id-1)=arr(Id):
arr(Id)=temp
Else
temp=arr(Id+1):
arr(Id+1)=arr(Id):
arr(Id)=temp
EndIf
err:
EndFunction
'判断元素是否属于数组
PublicFunctionb_exist(arr()AsRECORD,arAsRECORD)AsBoolean
DimiAsInteger
OnErrorGoToerr:
Fori=0ToUBound(arr)
Ifgetstr(arr(i).time)=getstr(ar.time)Andgetstr(arr(i).URL)=getstr(ar.URL)Then_
b_exist=True:
ExitFunction
Nexti
err:
b_exist=False
EndFunction
'判断时间大小
PublicFunctionb_max(op1AsRECORD,op2AsRECORD)AsBoolean
If(Val(find1(getstr(op1.time),":
",1))*3600+Val(find1(getstr(op1.time),":
",2))*60-_
Val(find1(getstr(op2.time),":
",1))*3600-Val(find1(getstr(op2.time),":
",2))*60)>0_
Then
b_max=True
EndIf
EndFunction
'取段-经典滚动法
PublicFunctionfind1(fsAsString,sAsString,fiAsInteger)AsString
DimiAsInteger,jAsInteger
Do
i=i+1:
j=j+1
WhileMid(fs,i,Len(s))=sAndi<=Len(fs)
i=i+1
Wend
find1=""
WhileMid(fs,i,Len(s))<>sAndi<=Len(fs)
find1=find1&Mid(fs,i,1)
i=i+1
Wend
Ifj=fiThenExitFunction
LoopWhilei<=Len(fs)
find1=""
EndFunction
'数组插入
PublicSubinser_h(ByRefsi()AsURL,nsAsURL)'尾插
OnErrorGoToerr:
ReDimPreservesi(UBound(si)+1)
si(UBound(si))=ns:
ExitSub
err:
ReDimPreservesi(0):
si(0)=ns
EndSub
'记录数组插入元素
PublicSubinsert(ByRefsi()AsRECORD,nsAsRECORD)'
DimiAsInteger,jAsInteger,kAsInteger
OnErrorGoToerr:
ReDimPreservesi(UBound(si)+1)
k=UBound(si)
Fori=0Tok
Ifb_max(si(i),ns)=TrueThenk=i:
ExitFor'找到插入位置
Nexti
Forj=UBound(si)Toi+1Step-1
si(j)=si(j-1)'依次后移
Nextj
si(k)=ns
ExitSub
err:
ReDimPreservesi(0):
si(0)=ns
EndSub
'更新列表
PublicSubupdate()
OnErrorGoToerr:
主程序.ListView1.ListItems.Clear
DimiAsInteger
Fori=UBound(rcd)To0Step-1
SetitmX=主程序.ListView1.ListItems.Add(1,"","")
itmX.SubItems
(1)=RTrim(Replace(rcd(i).time,Chr(0),""))
itmX.SubItems
(2)=exe(RTrim(Replace(rcd(i).URL,Chr(0),"")))
itmX.Checked=rcd(i).bcheck
Nexti
err:
EndSub
'改变颜色
PublicFunctionchange(rcAsRECORD,colorAsLong)
OnErrorGoToerr:
DimiAsInteger,jAsInteger
Fori=1To主程序.ListView1.ListItems.Count
IfLeft(主程序.ListView1.ListItems(i).SubItems
(1),5)=getstr(rc.time)Then
Forj=1To主程序.ListView1.ListItems(i).ListSubItems.Count
主程序.ListView1.ListItems(i).ListSubItems.Item(j).ForeColor=color'红色
主程序.ListView1.ListItems(i).ListSubItems.Item(j).Bold=True
Nextj
EndIf
Nexti
err:
EndFunction
'目录函数
PublicFunctionmulu(linkAsString)AsString'全路径名返回目录
DimiAsInteger
Fori=Len(link)To1Step-1
If
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 闹钟 C10 VB 源码