用VB制作“满天星”屏保程序
用VB设计更换屏幕保护的程序
制作⼀个本企业的屏幕保护，在客户运⾏本企业的应⽤软件的时候，为客户更改屏幕保护，是个⼴告宣传的好办法。
有很多朋友提出这个问题，现解答如下： 要更换屏幕保护，⾸先得做好⼀个屏幕保护(scr⽂件)，本例以⼯程1.scr 这个⽂件为例。
由于Windows是把屏幕保护⽂件存放在system下，但记录屏幕保护⽂件位置的⽂件却是windows⽬录下的system.ini，所以，⾸先需要找出系统的windows和system⽬录的确切安装位置。
因此，可以分如下⼏步进⾏： 1、找到windows和system⽬录的安装位置 2、把屏幕保护⽂件复制到system⽬录下 3、在system.ini中的[boot]中写⼊: SCRNSAVE.EXE=C:\WINDOWS\SYSTEM\⼯程1.SCR 4、告诉系统切换屏幕保护。
下⾯的例⼦成功地改变了屏幕保护，全部源代码如下： '得到windows⽬录 Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lPBuffer As String, ByVal nSize As Long) As Long '修改system.ini Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long '得到system⽬录 Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long '设置屏幕保护 Private Const SPI_SETSCREENSAVETIMEOUT = 15 Private Const SPI_SETSCREENSAVEACTIVE = 17 Private Const SPIF_UPDATEINIFILE = &H1 Private Const SPIF_SENDWININICHANGE = &H2 Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Long, ByVal fuWinIni As Long) As Long '启动屏幕保护 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Const WM_SYSCOMMAND = &H112 Private Const SC_SCREENSAVE = &HF140 Private Sub Form_Load() '得到system⽬录 Dim sSave As String, Ret As Long sSave = Space(255) Ret = GetSystemDirectory(sSave, 255) sSave = Left$(sSave, Ret) '把屏保复制到系统⽬录 FileCopy App.Path & "\⼯程1.scr", sSave & "\⼯程1.SCR" '得到windows⽬录 Dim Path As String, strSave As String strSave = String(250, Chr$(0)) Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave))) '修改system.ini Dim r As Long Dim iniPath As String iniPath$ = Path + "\system.ini" r = WritePrivateProfileString("boot", "SCRNSAVE.EXE", sSave & "\⼯程1.SCR", iniPath) '设置时间间隔为1分钟=60秒 lRet = SystemParametersInfo(SPI_SETSCREENSAVETIMEOUT, 60, ByVal 0&, SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE) '设置屏幕保护 retval = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, True, 0, 0) '启动屏幕保护 Dim result As Long result = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&) End Sub 本例在VB6.0+win95下运⾏通过。
用VB制作屏幕保护程序
《用VB制作屏幕保护程序》利用VB制作屏幕保护程序非常容易。
本文将详细给大家介绍制作屏幕保护程序的方法。
一、基本编程思路大家都知道屏幕保护程序就是用变换的颜色或图形以防止屏幕荧光粉被损伤。
当有鼠标移动或按键时能够终止它。
1. 编制屏幕保护图形2. 隐藏鼠标用ShowCursor Windows API 函数我们可以实现隐藏鼠标。
3. 检测鼠标和按键行为检测鼠标行为以便退出屏幕保护程序。
4. Windows 调用屏幕保护程序的参数命令／a 在显示器属性对话框中单击它可改变口令按钮。
／p 每当选中显示器属性对话框中屏幕保护程序标签时，在对话框显示预览效果。
／c 在显示器属性对话框中单击它进行设置按钮。
／s 在显示器属性对话框中单击则预览按钮或屏幕保护程序被系统正常调用。
5. 编译屏幕保护程序其实任何VB应用程序都可作为屏幕保护程序来运行，但为了被Windows 95 所调用，需要将它作为屏幕保护程序来编译。
首先进入VB5编程环境，编好程序后选择／File／Make project菜单项，然后在File Name文本框中将后缀名EXE改为SCR。
最后单击OK按钮,将生成的SCR文件拷到Windows目录下，就完成了屏幕保护程序的创建。
二、实例下面就用一个实例给大家详细说明屏幕保护程序的制作。
名称属性值Form1BorderStyle=0－None ′取消标题栏和最大化、最小化按钮WindowState=2－Maximized ′窗体最大化TimerName=Timer1Interval=1 ′时间间隔为1毫秒Enabled=FalseTimerName=Timer2Interval=50Enabled=FalseLabelName=lab1 Caption=电脑爱好者Option ExplicitDim quitflag As Boolean ′声明终止程序标志变量Dim lleft′声明隐藏或显示鼠标的API函数Private Declare Function ShowCursor Lib ″user32″(ByVal bShow As Long) As Long ′检测鼠标单击或移动Private Sub Form_Click()quitflag = TrueEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Static xlast, ylastDim xnow As SingleDim ynow As Singlexnow = Xynow = YIf xlast = 0 And ylast = 0 Thenxlast = xnowylast = ynowExit SubEnd IfIf xnow <> xlast Or ynow <> ylast Thenquitflag = TrueEnd IfEnd Sub′检测按键Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)quitflag = TrueEnd SubPrivate Sub Form_Load()Dim X As Longlleft = 0 ′横向滚动文字的起始X坐标If App.PrevInstance = True Then ′用APP对象的PrevInstance属性Unload Me ′防止同时运行屏幕保护程序的两个实例Exit SubEnd IfSelect Case UCaseS(LeftS(CommandS, 2)) ′装载命令行参数Case ″／S″′在显示器属性对话框中单击了预览按钮或屏幕保护程序被系统正常调用。
利用VB做精美桌面
【ＶＢ】利用ＶＢ做美化界面如果大家用过《Windows优化大师》，肯定会被它的界面所倾倒，其实利用ActiveSkin 就可以办到,甚至更好,但是如果要做的共享软件只是一个文件,在加上几个OCX累赘,似乎很是不好,看看VB是怎么利用别的东西来实现的吧。
首先新建一个EXE工程，再在窗体上拖几个Label控件，看看Label 的强大功能吧，原理就是利用Label来模拟一个按钮，但是首先要将Label控件的属性要调一下，Name： LblBtn，BorderStyle: 1，Appearance: 0，Alignment: 2，这样一个按钮的雏形就已经出来了，如果工程量很大，可以将多个Label控件的Name 属性设为一样的，对于按钮的识别就要靠识别Index属性了，为了方便起见，在进入到代码编辑窗口，输入以下代码：Private Const LBL_BACK_COLOR ＝ &HE0E0E0 ’正常时Label控件的背景色Private Const LBL_WHEN_MOUSE_MOVE ＝ &HC0C0C0 ’鼠标移动时Label的背景色Private Const LBL_WHEN_MOUSE_DOWN ＝ &H808080 ’鼠标按下时Label的背景色再在Form的Load事件中输入以下内容Private Sub Form_Load（）Dim Count As IntegerFor Count ＝ 0 To 3 ’请将此出的3换成你的LblBtn数量的个数－1LblBtn（Count）.BackColor＝LBL_BACK_COLOR ’初始化LblBtn的背景Next CountEnd Sub然后再在LblBtn的MouseMove和MouseDown事件中来搞定剩余部分：Private Sub LblBtn_MouseDown（Index As Integer， Button As Integer， Shift As Integer， X As Single， Y As Single）’当鼠标按在LblBtn上时LblBtn（Index）.BackColor ＝ LBL_WHEN_MOUSE_DOWN ’临时改变LblBtn背景颜色End SubPrivate Sub LblBtn_MouseMove（Index As Integer， Button As Integer， Shift As Integer， X As Single， Y As Single）’鼠标在LblBtn上面移动时触发该事件Dim Count As IntegerDoEvents ’暂时将系统控制权教给系统If Button Then Exit Sub ’如果按钮被按下就退出该过程For Count ＝ 0 To 3If Count <> Index Then ’如果按下的不是其它按钮LblBtn（Index）.BackColor ＝ LBL_BACK_COLOR ’将背景设为正常ElseLblBtn（Index）.BackColor ＝ LBL_WHEN_MOUSE_MOVE ’将背景设为鼠标移动的背景End IfNext CountEnd SubPrivate Sub Form_MouseMove（Button As Integer， Shift As Integer， X As Single，Y As Single）Dim Count As IntegerDoEventsFor Count＝0 To 3LblBtn（Count）.BackColor＝LBL_BACKCOLOR ’恢复背景Next CountEnd本来利用Windows的消息系统来完成这一“艰巨”的任务最简单，可问题就来了，Label 控件没有窗口句柄怎么办？可是此问题与题无关，写了会有骗稿费之：）OK，Label控件就讲到这里，在来说说TextBox控件，各位看关恐怕看惯了白颜色的背景，那么就换换颜色以养养俺们那和绵羊一样的眼睛（为什么说绵羊？俺也不知道），可是VB提供的RGB函数弄出来的颜色不是怎么好看，这里俺来教大家一个小Tip，RGB函数的Red，Green，Blue这三个参数若一样，则产生的颜色是灰度，当然越接近白颜色越好，但也不能让各位看不出来，俺建议TextBox的背景为RGB（235，235，235），各位还是实战一下，将一个TextBox拖到窗体上，属性设置如下Appearance 0BorderStyle 1MutilLine True千万不要设置ScrollBars属性，否则会影响效果在Form的Load事件中初始化TextBoxDim bkColor As LongPrivate Sub Form_Load（）bkColor＝RGB（235，235，235）Text1.BackColor＝bkColorEnd Sub在Form和Text1的MouseMove事件中:Private Sub Form_MouseMove（Button As Integer， Shift As Integer， X As Single，Y As Single）Text1.BorderStyle ＝ 0End SubPrivate Sub Text1_MouseMove（Button As Integer， Shift As Integer， X As Single，Y As Single）DoEventsText1.BorderStyle ＝ 1End Sub在按下F5试试是不是很Cool?可能各位看关玩过石器时代，一定会对里面的TextBox的效果感到很爽，VB还不是可以做到，有焦点的控件可以使用SetFocus方法来为其设置焦点，可是一个窗体上如果控件太多了，一个一个的用SetFocus是不是太傻了?这一节的主角就是－－－－－－－－API函数，首先声明:Private Type POINTAPIx As Longy As LongEnd TypePrivate Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" （lpPoint As POINTAPI） As LongPrivate Declare Function WindowFromPoint Lib "user32" Alias "WindowFromPoint" （ByVal xPoint As Long， ByVal yPoint As Long） As LongPrivate Declare Function SetFocus Lib "user32" Alias "SetFocus" （ByVal hwnd As Long） As Long但是这里的SetFocus会和控件的SetFocus会搞混淆，改改吧，Private Declare Function nSetFocus Lib "user32" Alias "SetFocus" （ByVal hwnd As Long） As Long只要Alias指向的接口是对的前面的函数名称简直就是摆设，在建立一个过程:Public Function sSetFocus（） As LongDim CPos As POINTAPI，Successfull As Boolean，hWnd As LongDoEventsSuccessfull ＝GetCursorPos（CPos）If Not Successfull Then Exit Sub ’如果未成功则退出该过程hWnd＝WindowFromPoint（CPos.x，CPos.y）sSetFocus=nSetFocus(hWnd)End Sub在窗体上放一个Timer控件，Interval 属性设为100，就是0.1秒，在Timer1控件的Timer事件中填入sSetFocus，在运行一下看看，效果怎么样?可是有的先生小姐要问了，TextBox难道就不能用ScrollBar吗?非也非也，选工程－>部件－>Microsoft Windows Common Controls－2 6.0 （SP3）就是你的答案，至于卷动TextBox就去研究SendMessage函数吧，否则又有骗稿费之嫌，如果想作绿色软件，不想用控件，可以用俺前面讲到的Label控件，利用字体 Webdings 来模拟ScrollBar，需要注意的是，如果模拟ScrollBar，上下左右箭头分别是5，6，3，4，别忘了把字体设为Webdings再来讲讲窗体的美化，其实将BorderStyle属性设为0就是很好的2D美化;）可是，这样一来，问题又来了，怎么办?凡事都要请API来帮忙，这里需要两个API，一下是该API的声明:Public Declare Function ReleaseCapture Lib "user32" Alias "ReleaseCapture" （）As Long 注释：这个API是用来解下鼠标的追踪器，关于他的过多用法以及详细介绍可以写信向俺咨询，还有Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" （ByVal hwnd As Long， ByVal wMsg As Long， ByVal wParam As Long， lParam As Any） As Long’这个该不要俺多介绍了吧Public Const HTCAPTION ＝ 2 ’代表窗体的标题区Public Const WM_NCLBUTTONDOWN ＝ &HA1 ’表示非工作区左键按下原理很简单，卸下鼠标追踪器后向Form发送一个移动窗体的消息，其实做到这一点的方法很多，但俺个人认为这一种最简单，添加一个过程:Public Sub MoveForm（hWnd As Long）DoEventsReleaseCaptureSendMessage hWnd， WM_NCLBUTTONDOWN， HTCAPTION， 0&End Sub在Form的MouseMove事件中:Private Sub Form_MouseMove（Button As Integer， Shift As Integer， X As Single，Y As Single）If Button＝vbLeftButton Then MoveForm hWnd’如果按下鼠标左键就移动窗体End Sub台下的这位小姐又纳闷了，可是光秃秃的窗体没有了标题栏也不好看，俺要向这为小姐推荐俺的东东－ActiveX控件，ToolSign，需要的人可以写信给俺联系，该控件需要在代码编辑区域内添加一下代码:’一下声明是用在ToolSign的 AutoQuit属性的Public Const EXIT_FORCE ＝ 2 ’注意，在VB中运行的时候如果选用此退出方式，VB也会退出Public Const EXIT_MESSAGE ＝ 1 ’由操作系统发送关闭消息Public Const EXIT_CUSTOM ＝ Not （EXIT_FORCE Or EXIT_MESSAGE）’自定义将其注册后在部件栏中把e－Dogkid Studio Tools Sign打钩，添加到工具箱中，双击加入到窗体中，在Form的Load事件中添加一下初始化代码:Private Sub Form_Load（）With Sign1.AutoQuit ＝ EXIT_CUSTOM.ParentsHWND ＝ hWnd ’填了此属性可以直接用ToolSign来移动窗体而不需要前面的代码End WithEnd SubSign1的Click事件Private Sub Sign1_Click（）End ’关闭程序End Sub在Form的Resize事件中添加一下代码:Private Sub Form_Resize（）Sign1.Width ＝ WidthEnd Sub如果想让窗体可以改变大小，可以修改一下属性Caption ""BorderStyle 2或5ControlBox False不知道各位看关见过爆炸试的窗体没有?，没有见过可以从俺要另外一个俺自己的ActiveX DLL，我的那个东东其实是给我的Software作运行库的，各位若不嫌弃，可以用用，注册后在工程－>引用－>e－Dogkid Runtime Library然后在窗体Load事件中输入:Private Sub Form_Load(）Dim System As e_Dogkid_Runtime_Library.SystemSet System ＝ New e_Dogkid_Runtime_Library.SystemShowSystem.BoomIt hDC， 60， Width， Height， Left， TopSet System ＝ NothingEnd Sub。
VB：五彩缤纷的清屏效果
VB：五彩缤纷的清屏效果在一些软件演示中，这一屏内容到下一屏内容间往往以一些有趣的清屏图案来相互切换，有的像演出舞台上的开幕、闭幕，有的像百叶窗，也有一些圆形、菱形等形态各异的清屏图案。
VB作为一门优秀的WINDOWS下的开发语言，其图形功能也很强。
我们完全可以用其提供的画线语句作出上述的清屏图案，下面的程序给出了常见的清屏图案程序：Sub FilSCrO'设置背景色Me.BackColor=RGB(Int(Rnd＊256),Int(Rnd＊256),Int(Rnd＊256))End SubSub ClrScrl()'从左右两边到中间清屏Dim i As Integer：Randomize：color=RGB(Int(Rnd＊256),Int(Rnd＊256),Int(Rnd＊256)) For i=0 To ScaleWidth/2Line(i,0)－(i,ScaleHeight),colorLine(ScaleWidth－i,0)－(ScaleWidth－i,ScaleHeight),colorNext iEnd SubSub ClrSer20'从中间到左右两边清屏Dim i As Integer：Randomize：color=RGB(Int(Rnd＊256),Int(Rnd＊256),Int(Rnd＊256)) for i=ScaleWidth/2 To 0 Step －1Line(i,0)－(i,ScaleHeight－1),colorLine(ScaleWidth－i,0)－(ScaleWidth－i,ScaleHeight),colorNext iEnd SubSub ClrScr30'从上(顶)下(低)到中间清屏Dim i As Integer：Randomize：color=RGB(Int(Rnd＊256),Int(Rnd＊256),Int(Rnd＊256)) For i=0 To ScaleHeight/2Line(0,i)－(ScaleWidth,i),colorLine(0,ScaleHeight－i)－(ScaleWidth,ScaleHeight－i),colornext iEnd SubSub ClrScr40'从中间到上(顶)下(底)清屏Dim i As Integer:Randomize:color=RGB(Int(Rnd＊256),Int(Rnd＊256),Int(Rnd＊256))For i=ScaleHeight/2 To 0 Step －1Line(0,i)_(ScaleWidth,i),colorLine(0,ScaleHeight－i)－(ScaleWidth,ScaleHeight－i),colorNext iEnd SubSub ClrScr50'菱形清屏，从四角向中心Dim i,j As Integer:Randomize:color=RGB(Int(Rnd＊256),Int(Rnd＊256),Int(Rnd＊256)) For i=0 To ScaleWidth Sep 200For j=0 To ScaleHeight Step200＊ScaleHeight/ScaleWidthLine(i,0)－(0,j),colorLine(ScaleWidth－i,ScaleHeight)－(ScaleWidth,ScaleHeight－j),colorLine(0,ScaleHeight－j)－(i,ScaleHeight),colorLine(ScaleWidth－i,0)－(ScaleWidth,ScaleHeight－j),colorNext jNext iEnd SubSub ClrScr60'圆形清屏，由大至小从外围向中心Dim i As Integer:Randomize:color=RGB(Int(Rnd＊256),Int(Rnd＊256),Int(Rnd＊256)) For i=ScaleWidth To 0 Step－3Circle(ScaleWidth/2,ScaleHeight/2,i/2,colorNext iEnd SubSub ClrScr70'圆形清屏，由小至大从中心向外围Dim i As Integer:Randomize:color=RGB(Int(Rnd＊256),Int(Rnd＊256),Int(Rnd＊256)) For i=0 To ScaleHeight Step 3Circle(ScaleWidth/2,ScaleHeight/2),i/2,colorNext iEnd Sub‘以上程序作为定义的子函数，置于General间Sub Form_Activate()FillSCr;ClrScr1;ClrScr2;ClrScr3;ClrScr4;ClrScr5;ClrScr7;ClrScr6End SubPrivate Sub Form_Click()EndEnd Sub注：该程序在VB3.0、VB4.0、VB5.0下均通过，程序一开始运行即先后演示从左右到中间，从中间到左右，从上下到中间，从中间到上下，从四角向中心(菱形)，从中心向外围(圆形)，从外围向中心(圆形)等清屏图案。
用VB做屏保
End Sub
Private Sub Form1_Mousedown()
‘点击鼠标结束程序
End
End Sub
Private Sub Form1_load()
‘窗体最大化
Form1.windowstate 2
End Sub
第二个：
Private Sub Timer1_Timer()
‘随机位置随机颜urrentX=Form1.Width*Rnd
Form1.currentY=Form1.Height*Rnd
Form1.FontSize=50*Rnd
Form1.Forecolor=RGB(255*Rnd,255*Rnd,255*Rnd)
Form1.print “*”
Static I as Integer
0-None
使窗体无边框
窗体Form
Form1
WindowState
2-Max
实现窗体最大化
窗体Form
Form1
Backcolor
黑
使窗体背景色为黑色
定时器Timer
Time1
Interval
20
每秒显示50个文字
四、代码
第一个：
Private Sub Form1_keydown()
‘按键盘任意键结束程序
屏保
一、项目名称：屏保
二、项目要求
1.窗体无边框
2.窗体最大化显示
3.背景色为黑
4.按键盘任意键结束程序
5.单击鼠标结束程序
6.随机位置随机颜色
7.每秒显示50下该文字
8.满200个清屏重新显示
9.生成exe文件
10.把exe文件改成scr文件
VB循环设计范例——让我们和星星一起动起来 - 江苏省中小学教学
【教学课题】VB循环设计范例——让我们和星星一起动起来【本节教学目标】『认知目标』深刻理解和应用各种循环语句，并能在实际中加以应用。
『能力目标』培养学生自主研究、解决问题的实践能力，培养创新精神，锻炼学生的表达能力，全面发展学生素质。
『情感目标』在小组协作过程中，培养学生的合作精神和集体荣誉感。
通过自己动手创作作品，增强学生的自信心。
【教学内容分析】教学内容为苏教版高一《信息技术》第六章《程序设计初步》的第六节“循环结构”。
『本节教学重点』For-Next循环、Do-Loop循环。
『本节教学难点』何时使用循环、跳出循环体的判断条件、2种Loop循环的区别。
『本课教学重点』For-Next循环的实际运用——制作闪烁的星星。
『本课教学难点』星星位置的确定，tmr时钟的控制，应用Int函数、Rnd函数。
【教学对象分析】教学对象是高一年级的学生，刚刚接触VB不久，还没有接触过循环的概念，如果讲解不彻底，很容易在学习中把知识“循环捣鼓”在一起，产生混乱。
以前的教学也表明，学生反映循环是VB 中最不容易理解和接受的部分，有些同学接触过以后因为无法理解，就对VB产生了惧怕心理，总觉得VB是多么难学的内容，会考的时候也不愿意多看。
因此我决定在讲解VB循环时，安排一堂有趣的设计课，让学生积极主动地学习，使学生学中有乐，乐于学习，并且对本节课在课后进行了后续拓展，结合前后的知识点加以整合，表现了学习的整体性和连续性。
【教学方法、教学内容及课时安排】【教具及教学准备】『硬件』计算机教室、投影、白板『软件』基础知识演示文稿、程序范例、资源共享区、在线讨论区【教学过程及作业设计】本节内容安排简述：本课教学过程详述：VB程序设计流程：①理解问题，设计算法（解决方法）③定义对象名称，设置对象属性。
【自评互评表格】小组编号：小组成员以及分工：总计得分：【教学评价】由于使用了学生自主学习，学生自主构建、巩固了知识体系，主题研究小组协作的形式加强了学生之间的合作，后续网上交流和研究拓展了教学范围和思路，提高了学生的自主研究和解决问题的能力。
在VB中如何让背景图片铺满整个MDIForm
在VB中如何让背景图片铺满整个MDIForm'*************************************************************** * '* 程序名称：MDIForm1.frm'* 程序功能：让背景图片铺满整个MDIForm窗口''*************************************************************** * Dim WithEvents picBackground As PictureBoxPrivate Sub MDIForm_Load()Set picBackground = Me.Controls.Add("VB.PictureBox", "picBackground")picBackground.Appearance = 0picBackground.BorderStyle = 0picBackground.Align = 0picBackground.ScaleMode = vbPixelspicBackground.AutoRedraw = FalseSet picBackground.Picture = LoadPicture("g:\me.jpg")picBackground.Visible = TrueEnd SubPrivate Sub MDIForm_Resize()picBackground.Move 0, 0, Me.Width, Me.HeightEnd SubPrivate Sub MDIForm_Unload(Cancel As Integer)Me.Controls.Remove "picBackground"End SubPrivate Sub picBackground_Paint()Dim i As Long, j As Long, w As Long, h As Longw = picBackground.ScaleX(picBackground.Picture.Width, vbHimetric, vbPixels)h = picBackground.ScaleY(picBackground.Picture.Height, vbHimetric, vbPixels)For i = 0 To Me.Width \ 15 \ w + 1For j = 0 To Me.Width \ 15 \ h + 1picBackground.PaintPicture picBackground.Picture, i * w, j * hNextNextEnd Sub'*************************************************************** * '* 程序名称：MDIForm1.frm'* 程序功能：让背景图片铺满整个MDIForm窗口'*************************************************************** * Dim WithEvents picBackground As PictureBoxPrivate Sub MDIForm_Load()Set picBackground = Me.Controls.Add("VB.PictureBox", "picBackground")picBackground.Appearance = 0picBackground.BorderStyle = 0picBackground.Align = 0picBackground.ScaleMode = vbPixelspicBackground.AutoRedraw = FalseSet picBackground.Picture = LoadPicture("g:\me.jpg")picBackground.Visible = TrueEnd SubPrivate Sub MDIForm_Resize()picBackground.Move 0, 0, Me.Width, Me.HeightEnd SubPrivate Sub MDIForm_Unload(Cancel As Integer)Me.Controls.Remove "picBackground"End SubPrivate Sub picBackground_Paint()Dim i As Long, j As Long, w As Long, h As Longw = picBackground.ScaleX(picBackground.Picture.Width, vbHimetric, vbPixels)h = picBackground.ScaleY(picBackground.Picture.Height, vbHimetric, vbPixels)For i = 0 To Me.Width \ 15 \ w + 1For j = 0 To Me.Width \ 15 \ h + 1picBackground.PaintPicture picBackground.Picture, i * w, j * h NextNextEnd Sub这个代码基本上满足了设计要求，由于是为了清楚的表达思路，所以使用了一个动态图片框，在实际使用时，如果MDIForm窗体上还有一些设计时的子控件，比如有工具栏，则不使用动态图片框，而是在设计时直接放置一个PictureBox控件，然后工具栏放置到这个PictureBox控件里，再按代码中PictureBox的属性进行逐一设置，这样就可以既让背景图片铺满窗口，又可以显示工具栏，否则，动态加载的图片框会遮隐住工具栏，造成了顾此失彼。
用vb制作流星雨屏幕保护程序
用vb制作流星雨屏幕保护程序窗体属性页设置：AutoRedraw = -1 'TrueBackColor = &H00000000&BorderStyle = 0 'NoneCaption = "star"ClientHeight = 3195ClientLeft = 0ClientTop = 0ClientWidth = 4680ControlBox = 0 'FalseFillColor = &H008080FF&FillStyle = 0 'SolidKeyPreview = -1 'TrueLinkTopic = "Form1"ScaleHeight = 213ScaleMode = 3 'PixelScaleWidth = 312ShowInTaskbar = 0 'FalseStartUpPosition = 3 '窗口缺省WindowState = 2 'Maximized代码：Option ExplicitPrivate Declare Function Ellipse Lib "gdi32" _(ByV al hdc As Long, ByV al X1 As Long, ByV al Y1 As Long, _ByV al X2 As Long, ByV al Y2 As Long) As LongPrivate Declare Function BitBlt Lib "gdi32" (ByV al hDestDC As Long, _ByV al x As Long, ByV al Y As Long, ByV al nWidth As Long, _ByV al nHeight As Long, ByV al hSrcDC As Long, ByV al xSrc As Long, _ByV al ySrc As Long, ByV al dwRop As Long) As LongPrivate Declare Function ShowCursor Lib "user32" (ByV al bShow As Long) As LongPrivate Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _(ByV al uAction As Long, ByV al uParam As Long, ByRef lpvParam As Any, ByV al fuWinIni As Long) As LongPrivate Type Starx As LongY As LongSpeed As LongSize As LongColor As LongDim Stars(49) As Star'Dim QuitFlag As BooleanConst MaxSize As Long = 5Const MaxSpeed As Long = 25Const SPI_SETSCREENSA VEACTIVE = 17'显示鼠标光标:Private Sub ShowMouse()While ShowCursor(True) < 0WendEnd Sub'隐藏鼠标光标:Private Sub HideMouse()While ShowCursor(False) >= 0WendEnd SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) ShowMouseEnd'QuitFlag = TrueEnd SubPrivate Sub Form_Load()Dim i As LongDim x As Long'用APP对象的PrevInstance属性'If App.PrevInstance = True Then'防止同时运行屏幕保护程序的两个实例'Unload Me'Exit Sub'End Ifx = SystemParametersInfo(17, 0, ByV al 0&, 0)'Select Case UCase$(Left$(Command$, 2))'装载命令行参数'Case "/S" '在显示器属性对话框中单击了预览按钮或屏幕保护程序被系统正常调用'ShowHideMouse'产生50个小星星For i = LBound(Stars) To UBound(Stars)Stars(i).x = Me.ScaleWidth * Rnd + 1Stars(i).Y = Me.ScaleHeight * Rnd + 1'星星大小Stars(i).Size = MaxSize * Rnd + 1'星星速度Stars(i).Speed = MaxSpeed * Rnd + 1'星星颜色Stars(i).Color = RGB(Rnd * 255 + 1, Rnd * 255 + 1, Rnd * 255 + 1)Next i'Case Else'Unload Me'Exit Sub'End SelectEnd SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single) ShowMouseEndEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single) Static xorign As Single, yorign As SingleDim xnow As Single, ynow As Single'记录当前位置xnow = xynow = Y'第一次触发MouseMove事件,记录当前位置If xorign = 0 And yorign = 0 Thenxorign = xnowyorign = ynowExit SubEnd If'仅当鼠标移动足够迅速(一次2个像素以上)才恢复屏幕If Abs(xnow - xorign) > 2 Or Abs(ynow - yorign) > 2 ThenShowMouse'end'quitflag = TrueEnd IfEnd SubPrivate Sub Form_Unload(Cancel As Integer)Dim x As Longx = SystemParametersInfo(17, 1, ByV al 0&, 0)ShowMouseEnd SubPrivate Sub Timer1_Timer()Dim i As Long'清屏BitBlt Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, 0, 0, 0, vbBlacknessFor i = 0 To UBound(Stars)'移动小星星Stars(i).Y = (Stars(i).Y Mod Me.ScaleHeight) + Stars(i).Speed'判断小星星是否已出了窗口If Stars(i).Y > Me.ScaleHeight ThenStars(i).x = Me.ScaleWidth * Rnd + 1Stars(i).Speed = MaxSpeed * Rnd + 1End If'设置小星星的颜色Me.FillColor = Stars(i).ColorMe.ForeColor = Stars(i).Color'画星星Ellipse Me.hdc, Stars(i).x, Stars(i).Y, Stars(i).x + Stars(i).Size, Stars(i).Y + Stars(i).Size Next iMe.RefreshEnd Sub。