几个有用vb程序.docx
- 文档编号:24860596
- 上传时间:2023-06-02
- 格式:DOCX
- 页数:12
- 大小:97.72KB
几个有用vb程序.docx
《几个有用vb程序.docx》由会员分享,可在线阅读,更多相关《几个有用vb程序.docx(12页珍藏版)》请在冰豆网上搜索。
几个有用vb程序
自编VB函数库-函数-编程
2010-12-2912:
58
自编VB函数库-函数-编程
最后更新于2011.1.3
常见常用编程函数,大部分都是自己写的,以后将不断完善,如有错误,请读者及时指出。
(本人菜鸟^_^)☆itianda☆
目录
1.打印三角形
2.判断素数(质数)
3.交换变量
4.冒泡排序(查看详细)
5.延迟函数
6.Eval函数-在VB中使用Eval
7.文字三角形(由第一个函数“打印三角形”改造)
8.RGB颜色的分解
9.文字三角形(更新版)
正文
1.打印三角形
函数说明:
打印三角形,成功返回1,失败返回0
参数说明:
maxLength是底边中的字符个数,direction指明三角形的方向(上或下)
FunctionPrintTriangle(ByValmaxLengthAsLong,ByValdirectionAsBoolean)AsLong
IfmaxLengthMod2<>0Then
Constdir_Up=True
Constdir_Down=False
Dims,s1,s2,s3AsString
printline=(maxLength+1)/2
Fori=1Toprintline
s1=String(printline-i,"")
s2=String((2*i-1),"*")
s3=s1
Ifdirection=dir_UpThen
IfLen(s)=0Then
s=s+s1+s2+s3
Else
s=s+vbNewLine+s1+s2+s3
EndIf
Else
IfLen(s)=0Then
s=s1+s2+s3+s
Else
s=s1+s2+s3+vbNewLine+s
EndIf
EndIf
Next
Me.Prints
PrintTriangle=1
Else
PrintTriangle=0
EndIf
EndFunction
2.判断素数(质数)
说明:
2既不是质数,也不是合数
FunctionIsSushu(ByValNumAsInteger)
DimSushuAsBoolean
Sushu=True
IfNum>=2Then
Fori=2ToNum-1
If(NumModi)=0Then
Sushu=False
ExitFor
EndIf
Next
IsSushu=Sushu
Else
IsSushu=False
EndIf
EndFunction
3.交换变量
说明:
注意是ByRef,不是ByVal
SubSwap(ByRefa,ByRefb)'交换变量
c=a
a=b
b=c
EndSub
4.冒泡排序(查看详细)
SubSwap(ByRefa,ByRefb)'交换两数
c=a
a=b
b=c
EndSub
SubSmallFirst(ByRefa,ByRefb)'交换两数使较小的数字在前
Ifa>bThenSwapa,b
EndSub
SubSort(ByRefNumbers())'冒泡排序
c=UBound(Numbers,1)
Fori=1Toc-1
Forj=0Toc-2
SmallFirstNumbers(j),Numbers(j+1)
Nextj
Nexti
EndSub
5.延迟函数
说明:
不会“假死”的延迟函数,好像也叫异步延迟,用来代替API函数“Sleep”,参数的单位是毫秒
下面是两个延迟函数,第二个误差比第一个小,后面有误差比较图
第一个延迟函数(简记为Delay1)
SubDelay(ByValMillisecondsAsLong)
time1=GetTickCount
Do
DoEvents
time2=GetTickCount
Sleep1 '这句是在网友AppConfig的建议下添加的,降低了CPU占用率,不过增加了误差。
。
。
LoopUntiltime2-time1>=Milliseconds'第一次写的时候忘了加等号"=",现在加上了
EndSub
第二个延迟函数(简记为Delay2)
SubDelay(ByValMillisecondsAsLong)
time1=GetTickCount
Do
DoEvents
time2=GetTickCount
IfMilliseconds-(time2-time1)>=2Then
Sleep1
EndIf
LoopUntiltime2-time1>=Milliseconds
EndSub
两函数误差比较
比较结果
很显然,Delay2的误差更小。
生成比较图的代码:
PrivateSubForm_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
Print"Begin","单位:
ms"
Print"理想延迟","Delay1延迟","Delay2延迟","Delay1误差","Delay2误差"
Forms=0To100Step5
t1=GetTickCount
Delay1ms
t2=GetTickCount
d1=(t2-t1)'实际延迟
c1=d1-ms'误差
t1=GetTickCount
Delay2ms
t2=GetTickCount
d2=(t2-t1)'实际延迟
c2=d2-ms'误差
Printms,d1,d2,c1,c2
Next
Print"Done"
Print"Begin","单位:
ms"
Print"理想延迟","Delay1延迟","Delay2延迟","Delay1误差","Delay2误差"
Forms=100To1000Step100
t1=GetTickCount
Delay1ms
t2=GetTickCount
d1=(t2-t1)'实际延迟
c1=d1-ms'误差
t1=GetTickCount
Delay2ms
t2=GetTickCount
d2=(t2-t1)'实际延迟
c2=d2-ms'误差
Printms,d1,d2,c1,c2
Next
Print"Done"
EndSub
6.Eval函数-在VB中使用Eval
说明:
Eval是VBS中一个很方便的函数,虽然VB本身并没有包含这个函数,但我们仍然可以通过以下方法使用它。
(参考byrs1980的博客)
FunctionEval(ByValExpressionsAsString)AsDouble
SetMssc=CreateObject("MSScriptControl.ScriptControl")
Mssc.Language="vbscript"
Eval=Mssc.Eval(Expressions)
EndFunction
7.文字三角形(由第一个函数“打印三角形”改造)
说明:
为了美观,文字可能无法全部显示。
只显示能构成的最大三角形包含的文字。
例如“中华人民共和国”只显示“中”“华人民”,而“中华人民共和国万岁”则可以全部显示:
“中”“华人民”“共和国万岁”
SubPrintTriangle(ByValWordsAsString,ByValCharAsString,ByRefstrResult()AsString)
DimMaxLine
MaxLine=GetMaxLine(Words)
Words=Left(Words,MaxLine^2)
maxLength=2*MaxLine-1
IfmaxLengthMod2<>0Then
Dims1,s3AsString
DimPAsLong
P=1
Fori=1ToMaxLine
Dims2AsString
s1=String(MaxLine-i,Char)
s2=Mid(Words,P,2*i-1)
P=P+2*i-1
s3=s1
strResult(i-1)=s1+s2+s3
Next
EndIf
EndSub
FunctionGetMaxLine(ByValWordsAsString)
Fori=1ToLen(Words)
Ifi+i*(i-1)>Len(Words)Then
GetMaxLine=i-1
ExitFor
EndIf
Next
EndFunction
例子:
PrivateSubForm_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
Dimss,pp(100)AsString
ss="在这个日新月异的世界,我碰巧是个赶时髦的人,除了爱滋我几乎在所有方面跟上了潮流。
我是在一个偶然的机会里结识互联网的,记得是陪朋友去买一个打印机的墨盒,电脑公司的老板中午喝了点酒,无处发泄,抓住我们就是一阵神侃,说这个互联网如何如何神奇,可以看到世界上的任何一家报纸、任何一部书、任何一部电影,当然还包括大片,而且是没剪过的,也就是说今后你不用买报买电影票买书让我怦然心动,还说能在网上打国际长途,费用却按市内电话算;还能在网上发表你的各种言论包括反动的,我接碴说我写了好多玩意,拿去投稿,编辑总是说我水平差、素质低,让我先回家复习初中语文,这下可好了。
老板还说:
网上还有好多黄色的东东,就是这句话使我下定了最后的决心。
第二天,我就注了册,把“猫”拿回了家,连好后问:
喂,老板,哪里可以发布我的反动言论。
老板说我只管卖,是听别人这么跟我说的。
我靠!
"
PrintTriangless,"★",pp
Fori=0ToUBound(pp)
Printpp(i)
Next
EndSub
效果图:
8.RGB颜色的分解
说明:
本人对颜色一窍不通,所以么,此函数记住就行了,别问为什么。
PrivateFunctionGetRed(ByValColorAsLong)
GetRed=ColorMod256
EndFunction
PrivateFunctionGetGreen(ByValColorAsLong)
GetGreen=(ColorAnd&HFF00FF00)/256
EndFunction
PrivateFunctionGetBlue(ByValColorAsLong)
GetBlue=(ColorAnd&HFF0000)/65536
EndFunction
9.文字三角形(更新版)
说明:
这个返回值为未三角化的文字
FunctionPrintTriangle(ByValWordsAsString,ByValCharAsString,ByRefstrResult())AsString
DimMaxLineAsLong
DimLeftWordsAsString
MaxLine=GetMaxLine(Words)
LeftWords=Right(Words,Len(Words)-MaxLine^2)
Words=Left(Words,MaxLine^2)
MaxLength=2*MaxLine-1
IfMaxLengthMod2<>0Then
Dims1,s3AsString
DimPAsLong
P=1
ForI=1ToMaxLine
Dims2AsString
IfLen(Char)>0Then
s1=String(MaxLine-I,Char)
Else
s1=""
EndIf
s2=Mid(Words,P,2*I-1)
P=P+2*I-1
s3=s1
strResult(I-1)=s1+s2+s3
Next
EndIf
PrintTriangle=LeftWords
EndFunction
FunctionGetMaxLine(ByValWordsAsString)
ForI=1ToLen(Words)
IfI+I*(I-1)>Len(Words)Then
GetMaxLine=I-1
ExitFor
EndIf
Next
EndFunction
一个小程序:
下载地址
exe文件
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 几个 有用 vb 程序
![提示](https://static.bdocx.com/images/bang_tan.gif)