vb+VBS整人代码大集合小伟哥收集.docx

1、vb+VBS整人代码大集合小伟哥收集实验一（带有进度条的倒计时程序）Public Class Form1 Dim timers As Integer Dim temp As Integer Private Sub Timer1_Tick(ByVal sender As System.Object,ByVal e As System.EventArgs)Handles Timer1.Tick If(ProgressBar1.Value+ProgressBar1.Maximum/timers ProgressBar1.Maximum)Then ProgressBar1.Value+=Progres

2、sBar1.Maximum/timers Else Timer1.Enabled=False ProgressBar1.Value=ProgressBar1.Maximum MessageBox.Show(进度完成！)End If temp+=1 Label1.Text=temp.ToString()End Sub Private Sub Form1_Load(ByVal sender As System.Object,ByVal e As System.EventArgs)Handles MyBase.Load timers=30 End Sub Private Sub Button2_Cl

3、ick(ByVal sender As System.Object,ByVal e As System.EventArgs)Handles Button2.Click timers=Val(InputBox(输入,请输入总时间。,30,0,0)End Sub Private Sub Button1_Click(ByVal sender As System.Object,ByVal e As System.EventArgs)Handles Button1.Click Timer1.Enabled=True End SubEnd Class 实验二（定时器控制蝴蝶飞舞）Public Class

4、Form1 Dim t As Integer Private Sub Timer1_Tick(ByVal sender As System.Object,ByVal e As System.EventArgs)Handles Timer1.Tick Dim t As Boolean If t=True Then PictureBox3.Image=PictureBox2.Image t=False Else PictureBox3.Image=PictureBox1.Image t=True End If Select Case t Case 0 PictureBox3.Image=Pictu

5、reBox1.Image t=1 Case 1 PictureBox3.Image=PictureBox2.Image t=2 Case 2 PictureBox3.Image=PictureBox1.Image t=3 Case 3 PictureBox3.Image=PictureBox1.Image t=0 End Select End SubEnd Class 实验三（递推法 迭代法-猴子吃桃）Public Class Form1 Private Sub Button1_Click(ByVal sender As System.Object,ByVal e As System.Even

6、tArgs)Handles Button1.Click Dim n,y As Integer n=Val(TextBox1.Text)y=Val(TextBox2.Text)Dim xi As Double xi=y TextBox3.Text=第+n.ToString()+天的桃子为：+y.ToString()+个。+vbCrLf For i As Integer=n-1 To 1 Step-1 xi=(xi+1)*2 TextBox3.Text+=第+i.ToString()+天的桃子为：+xi.ToString()+个。+vbCrLf Next End SubEnd Class 实验四（

7、加减乘除随机数题）Public Class Form1 Dim x,y As Integer Dim i As Integer Dim sum As Integer Private Sub Button2_Click(ByVal sender As System.Object,ByVal e As System.EventArgs)Handles Button2.Click If(Label1.Text)Then TextBox2.Text+=Label1.Text+TextBox1.Text TextBox2.Text+=结果 If(sum=Val(TextBox1.Text)Then Te

8、xtBox2.Text+=+vbCrLf Else TextBox2.Text+=+vbCrLf End If End If Randomize()x=Int(Rnd()*999+1)y=Int(Rnd()*999+1)i=Int(Rnd()*4+1)Select Case i Case 1 Label1.Text=x.ToString()+y.ToString()+sum=x+y Case 2 Label1.Text=x.ToString()+y.ToString()+sum=x-y Case 3 Label1.Text=x.ToString()+y.ToString()+sum=x*y C

9、ase 4 Label1.Text=x.ToString()+y.ToString()+sum=x/y End Select End SubEnd Class VB实现按钮浮动效果关于浮动按钮的实现思路不少，多是采取多图片重叠显示来实现。这种方法代码量多，实现起来较繁琐。因为，一个按钮还好，如果有十个按钮呢？一个按钮三个图片，十个就要三十个图片，可不是闹着玩的。我的思路是：舍弃 CommandButton控件，每个按钮用 4条 Line控件和一个 Label控件替代。4条 Line围住 Label的边缘，调入窗体时，置显示属性为 False，并将左、上直线的颜色设为白色，右、下直线的颜色设为黑

10、色。当鼠标移到 Label上时，4条 Line的显示属性置 True；当鼠标离开按钮时，将 4条 Line的显示属性设置为 False。这样在视觉上就完全得到立体浮动的效果。另外，VB的 Line控件还支持直线倾斜，以此类推，完全可以做出更加美观的倾斜按钮。篇幅所限，下面仅给出一个按钮实现浮动效果的源代码。Option ExplicitPrivate Sub Form_Load()初始 Form与 LabelForm1.Caption=“浮动按钮Form1.KeyPreview=Falselabel1.Caption=“确定初始 4条 Line的显示属性为 FalseLine1.Visible

11、=FalseLine2.Visible=FalseLine3.Visible=FalseLine4.Visible=False初始 4条 Line的颜色Line1.BorderColor=HE0E0E0Line2.BorderColor=HE0E0E0Line3.BorderColor=H808080Line4.BorderColor=H808080End SubPrivate Sub Form_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)鼠标指针在窗体上(不在按钮上)时，置 4条 Line的显示属性

12、为 FalseLine1.Visible=FalseLine2.Visible=FalseLine3.Visible=FalseLine4.Visible=FalseEnd SubPrivate Sub label1_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)鼠标指针在按钮上时，置 4条 Line的显示属性为 TrueLine1.Visible=TrueLine2.Visible=TrueLine3.Visible=TrueLine4.Visible rueEnd Sub-setup类型的进度条Di

13、m tenth As Long条件编译#If Win32 ThenPrivate 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#ElsePrivate Declare Function BitBlt

14、Lib GDI(ByVal hDestDC As _Integer,ByVal x As Integer,ByVal y As Integer,ByVal nWidth _As Integer,ByVal nHeight As Integer,ByVal hSrcDC As Integer,_ByVal xSrc As Integer,ByVal ySrc As Integer,ByVal dwRop As _Long)As Integer#End IfSub UpdateStatus(FileBytes As Long)-更新 Picture1 status bar-Static progr

15、ess As LongDim r As LongConst SRCCOPY=&HCC0020Dim Txt$progress=progress+FileBytesIf progress Picture1.ScaleWidth Thenprogress=Picture1.ScaleWidthEnd IfTxt$=Format$(CLng(progress/Picture1.ScaleWidth)*100)+%Picture1.ClsPicture1.CurrentX=_(Picture1.ScaleWidth-Picture1.TextWidth(Txt$)2Picture1.CurrentY=

16、_(Picture1.ScaleHeight-Picture1.TextHeight(Txt$)2Picture1.Print Txt$Picture1.Line(0,0)-(progress,Picture1.ScaleHeight),_Picture1.ForeColor,BFr=BitBlt(Picture1.hDC,0,0,Picture1.ScaleWidth,_Picture1.ScaleHeight,Picture1.hDC,0,0,SRCCOPY)End SubPrivate Sub Command1_Click()Picture1.ScaleWidth=109tenth=10

17、For i=1 To 11Call UpdateStatus(tenth)x=TimerWhile Timer x+0.75DoEventsWendNextEnd SubPrivate Sub Form_Load()Picture1.FontBold=TruePicture1.AutoRedraw=TruePicture1.BackColor=vbWhitePicture1.DrawMode=10Picture1.FillStyle=0Picture1.ForeColor=vbBlueEnd Sub-图像浏览小程序下面分步设置各控件的属性：1.设置窗体的 Caption属性为“图片浏览器”，B

18、orderStyle属性为 3,即窗体大小不能改变。2.设置 Label1的属性为“当前驱动器”，Label2的属性为“当前目录”，Label3的属性为“当前文件”；Label4的属性为“当前图像”，Label5的属性为“当前文件路径”。3.设置 Text1的 Text属性为空。4.设置 Image1的 Stretch属性为 True，即所装入的图形能够缩放以适应图像框大小。5.设置 Command1的 Caption属性为“确定”，Command2的 Caption属性为“退出”。Private Sub Command1_Click()Image1.Picture=LoadPicture(T

19、ext1.Text)当单击“确定”时，文本框中的文件在图像框中显示出来 End Sub Private Sub Command2_Click()当单击“退出”时，弹出是否退出系统对话框 Dim exi As String exi=MsgBox(您真的想退出吗？,vbYesNo+vbQuestion+vbDefaultButton1,退出)If exi=vbYes Then End End If End Sub Private Sub Dir1_Change()File1.Path=Dir1 当目录发生变化时，文件列表框中的文件也相应变化 End Sub Private Sub Drive1_C

20、hange()Dir1.Path=Drive1 当驱动器变化时，目录列表也相应变化 End Sub Private Sub File1_Click()Text1.Text=File1.Path+File1 用来在文本框中显示被选中的图形名 End Sub Private Sub File1_DblClick()Image1.Picture=LoadPicture(File1.Path+File1)当双击文件列表中的文件时,文件在图像框中显示出来 End Sub Private Sub Form_Load()Command1.Enabled=False 在未选择图形文件时“确定”按钮不可用 Fi

21、le1.Pattern=*.bmp;*.jpg;*.ico;*.cur 在文件列表框中显示扩展名为.BMP、.JPG、.ICO、.CUR的文件 End Sub Private Sub Text1_Change()Command1.Enabled=True 当文本框中的内容变化时使“确定”按钮可用 End Sub-浮动按钮小程序Option Explicit Private Sub Form_Load()初始 Form与 Label Form1.Caption=浮动按钮 Form1.KeyPreview=False Label1.Caption=确定 初始 4条 Line的显示属性为 False

22、 Line1.Visible=False Line2.Visible=False Line3.Visible=False Line4.Visible=False 初始 4条 Line的颜色 Line1.BorderColor=&HE0E0E0 Line2.BorderColor=&HE0E0E0 Line3.BorderColor=&H808080 Line4.BorderColor=&H808080 End Sub Private Sub Form_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)鼠标指

23、针在窗体上(不在按钮上)时，置 4条 Line的显示属性为 False Line1.Visible=False Line2.Visible=False Line3.Visible=False Line4.Visible=False End SubPrivate Sub Label1_Click()EndEnd Sub Private Sub Label1_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)鼠标指针在按钮上时，置 4条 Line的显示属性为 True Line1.Visible=True Li

24、ne2.Visible=True Line3.Visible=True Line4.Visible=TrueEnd Sub-VB实现按钮浮动Option Explicit Private Sub Form_Load()初始 Form与 Label Form1.Caption=Form1.KeyPreview=False Label1.Caption=确定 初始 4条 Line的显示属性为 False Line1.Visible=False Line2.Visible=False Line3.Visible=False Line4.Visible=False 初始 4条 Line的颜色 Line

25、1.BorderColor=&HE0E0E0 Line2.BorderColor=&HE0E0E0 Line3.BorderColor=&H808080 Line4.BorderColor=&H808080 End Sub Private Sub Form_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)鼠标指针在窗体上(不在按钮上)时，置 4条 Line的显示属性为 False Line1.Visible=False Line2.Visible=False Line3.Visible=False Lin

26、e4.Visible=False End SubPrivate Sub Label1_Click()EndEnd Sub Private Sub Label1_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)鼠标指针在按钮上时，置 4条 Line的显示属性为 True Line1.Visible=True Line2.Visible=True Line3.Visible=True Line4.Visible=True End SubPrivate Sub Form_MouseDown(Button As

27、Integer,Shift As Integer,X As Single,Y As Single)ReleaseCaptureSendMessage hwnd,WM_NCLBUTTONDOWN,HTCAPTION,0&End SubModule1.bas移动模块的程序 Declare Function ReleaseCapture Lib user32()As LongDeclare Function SendMessage Lib user32 Alias SendMessageA(ByVal hwnd As Long,ByVal wMsg As Long,ByVal wParam As L

28、ong,lParam As Any)As LongPublic Const HTCAPTION=2Public Const WM_NCLBUTTONDOWN=&HA1-此代码锁定了任务管理器，想关闭只有重新启动电脑，恶搞你的好友，或者骚扰你 Private Sub Form_Load()Open Environ$(WinDir)&system32taskmgr.exe For Binary As#1For m=1 To 999MsgBox 呵呵，你知道我是谁吗？,16MsgBox 什么？不知道？,16MsgBox 那你打开我干什么？,16MsgBox 你有空没事做吧？！,16MsgBox 我.

29、就是鼎鼎大名的小伟哥,16MsgBox QQ897507391.,16MsgBox 现在你把它打开了觉得后悔了吧？呵呵.,16MsgBox 算了算了，不玩你了,16MsgBox 现在我数 3声就闪人,行了吧?,16MsgBox 1.,16MsgBox 2.,16MsgBox 3.,16MsgBox 噔噔噔噔,我又回来了！,16MsgBox 哈哈，是不是很过瘾呢？,16MsgBox 现在我先介绍下自己.,16MsgBox 我叫薛明山.,16MsgBox 性别：男.,16MsgBox 今年 20岁.,16MsgBox 不好意思噢，我好像说多了.,16MsgBox 不要这样喇，听我说完先好不？,16

30、MsgBox 来来来，开始喇.,16MsgBox 我叫薛明山.,16MsgBox 家中有屋又有田.,16MsgBox 生活乐无边.,16MsgBox 好像我又说多了.,16MsgBox 不要生气嘛，你认真看下去我就放你走.,16MsgBox 好，开始喇.,16MsgBox 从前有座山.,16MsgBox 山里有个座庙.,16MsgBox 庙里有个和尚.,16MsgBox 哈哈，想哭吗？,16MsgBox 被骗的感觉不爽吧？,16MsgBox 喂喂喂！别别.千万别重启电脑,16MsgBox 我告诉你怎么关吧,16MsgBox 先打开任务管理器,16MsgBox 忘了告诉你了，任务管理器打不开了,

31、16MsgBox 别恨我啊你不小心,16MsgBox 电脑重新启动吧,16MsgBox 相信我吧,你知道我是不会骗人的,16MsgBox 如果你还想继续点的话,你就别听我的,16MsgBox 呵呵,我又没有说这个东西没有,16MsgBox 我只想说桌面没有罢了.,16MsgBox 嘻嘻,爽不爽吖?,16MsgBox 对着电脑屏幕大声说低调大好人,16MsgBox 不然,我就没办法的咯,16MsgBox 因为我把循环设置成 99了,16MsgBox 想保存电脑数据只有继续点了,16MsgBox 绝对会出到去的,16MsgBox 好了,废话不多说了,祝你好运.,16MsgBox 制作:低调不倒,1

32、6MsgBox QQ：897507391,16MsgBox E-mail:不告诉你,16MsgBox 好,继续循环.,16NextEnd Sub1和 2是不断运行程序，3是迅速关机。1、sub form_load()shell app.exename end sub2、do shell notepad.exe loop3、shell cmd/c shutdown-s-f-t 014、运行了一个 vb代码，用任务管理器关闭不了set vbs=createobject(Wscript.shell)a=inputbox(请输入&vbcr&我是大笨蛋&vbcr&否则电脑将立即重启。,笨蛋炸弹)if a

33、 我是大笨蛋 then vbs.run(shutdown-r-t 0),vbhideend if这个是关闭桌面所有窗口（直接复制上去就 ok）Private Type POINTAPI x As Long y As LongEnd TypePrivate Declare Function GetCursorPos Lib user32(lpPoint As POINTAPI)As LongPrivate Declare Function WindowFromPoint Lib user32(ByVal xPoint As Long,ByVal yPoint As Long)As LongPrivate Declare Function ShowWindow Lib user32(ByVal hwnd As Long,ByVal nCmdShow As Long)As LongDim a(5