信息的编程加工——用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:五彩缤纷的清屏效果
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自制屏保程序北京市顺义区第二中学计算机办公室邢波【适用教材】全日制普通高级中学教材·信息技术第二册(北京教育出版社)【适用单元】第五章面向对象程序设计初步(第六节定时器)一、教学指导思想与理论依据Visual Basic程序设计语言是高中阶段信息技术教学的重点内容,也是与初中阶段教学内容不同的地方,学习起来不如应用软件那样好理解,很多学生望而生畏。
在这种情况下,调动学生的学习兴趣至关重要。
“兴趣是最好的老师”,有了学习兴趣,学习起来就有动力了。
因此,我在讲授定时器控件时,以学生常见的屏幕保护程序引入,屏幕保护程序大家都知道,但如何编出自己的屏幕保护程序呢?这就自然而然的引入了课题。
在讲授的过程中,我采取“任务驱动”式教学,让学生在完成任务的同时学习新知识。
考虑到循序渐进的原则,我布置的任务遵循由简到难的原则。
第一个任务只要求学生照例操作,先让学生利用已学知识实现文字的自右向左移动的简单动画,学生很自然地想到了利用循环控制。
但要让文字移出屏幕,准确的循环次数很难确定,于是引出本课的新知识──定时器,利用定时器实现文字的移动就不必考虑循环次数的问题,以此让学生初步了解定时器的使用。
之后的第二个任务要求学生改进程序,以实现文字在屏幕上重复移动。
这要求学生考虑如何知道文字是否移出了屏幕。
教学时采用两人一组讨论的方式,当学生想到用IF语句实现时,教师要适时地引导学生注意条件的书写。
最后一个任务要求学生利用所学知识完成一个真正属于自己的屏幕保护程序,这是本节课的高潮部分。
教师提供几种屏幕保护的方案供学生参考:(1)文字可以在不同的位置交替出现;(2)文字可以用图片或几何图形代替;(3)利用画点语句实现满天星效果。
学生根据自己的能力,可以选择参考方案,也可以自己制定内容,只要用到定时器即可。
采用分组合作形式学习,能力有限的学生可以互相合作,能力稍强的学生也可以独立完成。
任务完成后教师组织学生将屏幕保护作品上传至教师机,采用学生评价与教师评价相结合、自我评价与他人评价相结合的方式互评作品,共同进步。
用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。
利用VB做精美桌面
利用VB做精美桌面【VB】利用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事件中初始化T extBoxDim 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控件,T oolSign,需要的人可以写信给俺联系,该控件需要在代码编辑区域内添加一下代码:’一下声明是用在T oolSign的 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 T ools 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 = Nothing End Sub。
VB中模拟星空的代码
Option ExplicitDim x(100), y(100), pace(100), size(100) As IntegerDim i, x1, y1, pace1, size1Private Sub Command1_Click()Unload Me '结束程序,因为用End结束可能会在内存中遗留下部分程序End SubPrivate Sub Form_Activate()Randomize '是与Rnd配套使用的一条语句,他可以生成一个随机数For i = 1 To 100x1 = Int(Form1.Width * Rnd) 'int函数返回所传送数值的整数部分y1 = Int(Form1.Height * Rnd) '这一步的思路是在循环时生成一个随机速度。
如果循环太快你将观察不到变化。
假如希望对上述情况进行实验,那就将Pace1=int。
行加上注释。
去掉注释,试着改变Pace1的值,然后观察速度的变化。
你也许更喜欢生成一个V eloc ity变量,然后设置Pace1=V elocity,采用这种方法,你可以通过为V elocity设置新值来控制速度pace1 = Int(500 - (Int(Rnd * 499))) 'pace1= 0 下一部分将为随机值分配大小,该值将被传送到Timer1_timer事件的circle方法中,以导致不同大小的循环周期。
你可以通过修改25来增加最大容量。
size1 = 30 * Rndx(i) = x1y(i) = y1pace(i) = pace1size(i) = size1NextEnd SubPrivate Sub Timer1_Timer()For i = 1 To 100Circle (x(i), y(i)), size(i), BackColory(i) = y(i) + pace(i)If y(i) >= Form1.Height Theny(i) = 0x(i) = Int(Form1.Width * Rnd) End IfCircle (x(i), y(i)), size(i)NextEnd Sub。
VB设置桌面背景
'将桌面图片清除
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0,"",SPIF_UPDATEINIFILE)
但以上程序设定图片之后, 必须等到下次 Windows 重新启动时才生效, 如果要设定之后立ndows 时改变桌面图片(下次开机时还原原状), 则程序如下:
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "c:\windows\CIRCLES.bmp", SPIF_SENDWININICHANGE ) ' 去掉 SPIF_UPDATEINIFILE
注:如果以上的声明放在“一般模块”下, 应在 Const 之前加上 Public 保留字, 并且将 Private 保留字去掉。
然后在命令按钮中的Click事件中输入以下代码:
'将桌面图片设定成 c:\windows\CIRCLES.bmp
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0,"c:\windows\CIRCLES.bmp", SPIF_UPDATEINIFILE)
Const SPIF_UPDATEINIFILE = &&H1
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
VB编程实现开机更换桌面背景
VB编程实现开机更换桌面背景汪志祥(四川化工职业技术学院四川泸州646005)摘要:本文比较全面的介绍了在Windows环境下,通过VB6.0编程调用Win32API函数来设置桌面背景的过程及方式,同时为了程序功能的完整性、易操作性及界面的友好,运用了其它的控件,并对其相应的事件过程编写了程序代码;此外还介绍了在VB中调用Win32 API函数来添加和删除系统托盘图标、读写注册表的方法。
关键字:Win32 API函数;注册表;托盘图标;控件一、引言对于使用计算机的人来说,整天对着同样的电脑屏幕太枯燥了,一点新意都没有。
能不能让计算机在每天(或每次)开机时就更换一次桌面背景呢?这个回答当然是肯定的。
在这里,我用VB6.0设计一个更换桌面背景的程序,它可以通过设置在每次开机时,从一个图片文件夹中随机读取出一个图片文件,用来设置计算机的桌面背景,背景设置完后,程序可以在设置的时间(大约1分钟)后自动结束,这样又可以免除用户自己手动结束程序。
二、理论实现要完成计算机桌面背景的设置,首先要明白计算机设置桌面背景的过程。
计算机要将一张图片文件设置成桌面背景,首先要求图片文件是BMP格式的,如果不是BMP格式的,则要先将图片转换成BMP格式的,然后将图片文件复制到计算机的安装目录(Win9X为Windows文件夹,Win NT/2000/XP为Winnt文件夹)中——我们可以调用Win32 API函数中的GetWindowsDirectory函数来获得Windows的安装目录,最后调用Win32 API函数SystemParametersInfo,把图片文件设置成Windows的桌面背景。
如果还要按照Windows的背景显示方式(居中、平铺、拉伸)来设置桌面背景,则在进行背景设置前,还要修改Windows 注册表中“HKEY_CURRENT_USER\Control Panel\Desktop”项下的子键“TileWallpaper”、“WallpaperStyle”的值。
如何用VB制作一个屏幕保护程序
如何用VB制作一个屏幕保护程序查了些资料,这里是一个解决方案添加一个窗体frm_Run,和frm_Setup。
在frmRun中添加代码:Private Sub Form_KeyDown(KeyCode As Integer, Shift As Int eger)If Mod_Main.Scan_RUN Then '如果此时是在运行屏保则关闭屏保modMain.CloseSCREnd IfEnd SubPrivate Sub Form_MouseDown(Button As Integer, Shift As In teger, X As Single, Y As Single)If Mod_Main.Scan_RUN Then '如果此时是在运行屏保则关闭屏保modMain.CloseSCREnd IfEnd SubPrivate Sub Form_Unload(Cancel As Integer)modMain.CloseSCREnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As In teger, X As Single, Y As Single)Static sx As Single, sy As SingleIf sx = 0 And sy = 0 Thensx = Xsy = YElseIf Abs(sx - X) > 5 Or Abs(sy - Y) > 5 Then End '鼠标移动了5象素则退出End IfEnd Sub添加一个模块modMain,添加代码:Option ExplicitPublic Const WM_LOOK As String = "屏保预览(demo)"Public Const WM_SET As String = "屏保设置(demo)"Public Const WM_RUN As String = "屏保运行(demo)"Public Const HWND_TOP As Long = 0&Public Const WS_CHILD As Long = &H40000000Public Const GWL_STYLE As Long = (-16)Type RECTLeft As LongTop As LongRight As LongBottom As LongEnd TypePublic Const SWP_NOZORDER = &H4Public Const SWP_NOACTIVATE = &H10Public Const SWP_SHOWWINDOW = &H40Public Const WM_CLOSE = &H10Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As LongDeclare Function GetClassName Lib "user32" Alias "GetClass NameA" (ByVal hwnd As Long, ByVal lpClassName As String, By Val nMaxCount As Long) As LongDeclare Function FindWindow Lib "user32" Alias "FindWind owA" (ByVal lpClassName As String, ByVal lpWindowName As St ring) As LongDeclare Function SendMessage Lib "user32" Alias "SendMes sageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wPara m As Long, lParam As Any) As LongDeclare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As LongPublic Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long ) As LongPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long , ByVal dwNewLong As Long) As LongDeclare Function SetWindowPos Lib "user32" (ByVal hwnd A s Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongDeclare Function ShowCursor Lib "user32" (ByVal bShow As Long) As LongSub Main() '程序运行入口Dim ClassName As String * 64 '存放窗口的类名Dim ExeCmd As String '存放命令行参数GetClassName frm_Setup.hwnd, ClassName, 64 '取得窗口的类名ExeCmd = UCase(Command$) '将调用的屏保的参数转换成大写后存放在变量ExeCmd里If Not (InStr(ExeCmd, "/P") = 0) Then '有“/P”参数,(小窗口预览)If Not (FindWindow(ClassName, WM_LOOK) = 0) Then End '如果找到已有同一个运行方式的实例存在则程序结束ClosePreWindow ClassName, WM_SET '关闭前面已启动的其他运行方式的实例ClosePreWindow ClassName, WM_RUN '同上SCR_LookElseIf Not (InStr(ExeCmd, "/S") = 0) Then '正常调用If Not (FindWindow(ClassName, WM_RUN) = 0) Then End ClosePreWindow ClassName, WM_LOOK '同上ClosePreWindow ClassName, WM_SET '同上Scr_RunElse '设置程序If Not (FindWindow(ClassName, WM_SET) = 0) Then EndClosePreWindow ClassName, WM_LOOK '同上ClosePreWindow ClassName, WM_RUN '同上Scr_SetupEnd IfEnd SubPublic Sub ClosePreWindow(ClassName As String, WinCapti on As String)Dim PreWnd As LongPreWnd = FindWindow(ClassName, WinCaption) '寻找类名为ClassName,标题为WinCaption的窗口If Not (PreWnd = 0) Then Call SendMessage(PreWnd, WM_ CLOSE, 0, 0) '如果窗口已找到则关闭它End SubPublic Sub SCR_Look()Dim LookScrWnd As LongDim Style As LongDim LookRect As RECTfrm_Run.Caption = WM_LOOK '赋上具有相应运行方式的标题LookScrWnd = Val(Right(Command$, Len(Command$) - 2)) '取得小屏幕的窗口句柄Style = GetWindowLong(frm_Run.hwnd, GWL_STYLE) '取得窗口的样式Style = Style Or WS_CHILD '在窗口的样式中加入子窗体常数SetWindowLong frm_Run.hwnd, GWL_STYLE, Style '改变窗体的样式SetParent frm_Run.hwnd, LookScrWnd '设置窗体的父窗体GetClientRect LookScrWnd, LookRect '取得小屏幕的大小SetWindowPos frm_Run.hwnd, HWND_TOP, 0, 0, LookRect.R ight, LookRect.Bottom, SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_SHOWWINDOW'显示窗体并将窗体的大小设置为小屏幕的大小以便覆盖小屏幕End SubPublic Sub Scr_Setup()frm_Run.Caption = WM_SET '赋上具有相应运行方式的标题frm_Setup.ShowEnd SubPublic Sub Scr_Run()frm_Run.Caption = WM_RUN '赋上具有相应运行方式的标题ShowCursor False '隐藏鼠标frm_Run.Move 0, 0, Screen.Width, Screen.Heightfrm_Run.ShowEnd SubPublic Sub CloseSCR()ShowCursor True '显示鼠标Unload frm_Setup '卸载窗体关闭屏保Unload frm_Run '同上End SubPublic Function Scan_RUN() As Boolean '侦测当前屏保的运行方式If (frm_Run.Caption = WM_RUN) Then '如果屏保是以运行方式在运行则返回“真”,否则返回“假”Scan_RUN = TrueElseScan_RUN = FalseEnd IfEnd Function设置工程的启动项为Sub Main,生成程序后改为scr就行了。
利用VB6.0设计屏幕保护程序
屏幕保护程序可以保护显示屏不被损坏,同时节约能源。
作为屏幕保护程序,应该具有如下特性:1)屏幕保护程序运行时,鼠标光标被自动隐藏,在程序结束时,光标显示。
2)当单击、移动鼠标或按下键盘时,屏幕保护结束,回到正常操作状态。
为了实现这些特性,在编写V B应用程序时,可以采用如下方法:1、改变窗体属性通常VB应用程序的窗体都采用有边框的窗体外观,但作为屏幕保护程序,应设置窗体为无边框,且为最大化。
2、隐藏及显示鼠标光标在Visual Basic应用程序中隐藏及显示鼠标光标需要运用Win dows的API函数,该函数名为ShowCursor。
当用参数值True调用时显示鼠标光标,当用参数值False调用时,鼠标光标自动隐藏。
3、检测鼠标移动VB中有一个检测鼠标移动的对象事件MouseMove事件。
MouseMove事件通常在应用程序启动时就会触发,有时在鼠标并未移动的情况下,MouseMove事件仍有可能被触发。
因此如果在程序中直接用MouseMove事件检测鼠标是否发生了移动,并不能正确反映鼠标的移动状况。
应该在MouseMove事件中编写代码加以控制。
为了正确反映鼠标的移动,先用变量记录下程序运行时的鼠标当前位置,然后用另外一组变量记录鼠标移动后的位置,当鼠标移动前后的位置差大于一定范围时,触发MouseMove 事件。
编写代码如下:Private Sub Form-MouseMove(Button As Integer,shift As Inteqer,X As Single,Y As Single)Static currentX,currentY As SingleDim orignX,orignY As Single’把当前的鼠标值赋给orignX和orignYorignX=XorignY=Y’初始化currentX和currentYif currentX=0 and currentY=0 ThencurrentX=orignXcurrentY=orignYExit SubEndif’当鼠标移动大于一个象素时,显示鼠标光标并退出程序If Abs(oriqnX-currentX)>1 or Abs(orignY-currentY)>1ThenX=ShowCursor(True)EndEndifEndSub4、检测鼠标单击在Visual Basic中,单击事件是由“Click”触发的。
vb屏幕保护程序
屏幕保护程序设计思路:设计好窗体,使得窗体运行时全屏幕占有及显示在最顶层。
运行时消除光标,退出时响应键盘、鼠标并显示光标。
设定好定时器,每隔0.5秒出现一次圆图像,当到达次数时清除画面,并调用画圆程序。
把画圆程序设置好,使其能每次随机出现圆个数,并每个圆能有许多同心圆,颜色随机生成。
屏幕保护程序需要几点:1、窗体覆盖整个屏幕move,和保持窗口定位在屏幕的最前端SetWindowsPos。
2、去除/显示光标ShowCursor。
3、画圆函数Circle。
1、窗体在屏幕的最前端是Move 0,0,screen.width,screen.height窗口在屏幕的最前端,用windows的API函数——SetWindowsPos ,当使用API函数时可以在VB6.0 API文本浏览器里查找,然后复制粘贴在“一般模块”里。
Move指令用法是确定一个方格在form中的位置,其坐标是从(0,0)开始的。
Command1.Move H1 * 0.5, H1 * 0.5, H1 * 7, H1 * 2Command2.Move H1 * 8, H1 * 0.5, H1 * 7, H1 * 2Command3.Move H1 * 16, H1 * 0.5, H1 * 7, H1 * 2 这里H1代表一个常数的话,方格就从H1 * 0.5, H1 * 0.5中知道第一点(原始点),然后H1 * 7(宽), H1 * 2(高)知道第二点(扩展点),然后以x、y轴方向连接这两点,就形成了扩展。
下面是设置窗口窗体位置的做法:(1)、在“一般模块”新增代码命令Option Explicit'常数定义Public Const HWND_TOPMOST = -1Public Const SWP_NOMOVE = &H2Public Const SWP_NOSIZE = &H1'API 函数声明Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hwndinserafter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongSetwindowpos 函数所使用的参数如表:注意:h 是类型描述,表示句柄,Wnd 是变量对象描述,表示窗口,所以hWnd 表示窗口句柄。
初学者API入门事例,VB锁屏小程序源码,及窗体布局!
自己编写的一个VB锁屏小程序里面涉及到的内容有:(主要的)API 窗体置顶(setwindowpos)获得活动窗体句柄(GetForegroundWindow)查找指定窗体句柄(findwindow)还有个窗体透明化的几个API,注释里面有标记下面是全部代码及窗体布局及运行效果:'窗口透明化申明语句,函数定义Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long 常数:Private Const WS_EX_LAYERED = &H80000Private Const GWL_EXSTYLE = (-20)Private Const LWA_ALPHA = &H2Private Const LWA_COLORKEY = &H1'消息(msgbog)函数声明Private Declare Function MessageBoxTimeout Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long, ByVal wlange As Long, ByVal dwTimeout As Long) As Long'窗体前置API函数申明Private Declare Function GetForegroundWindow Lib "user32" () As LongPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Declare Function SetWindowPos& Lib "user32" (ByVal hWnd As Long, _ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, _ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)Private num As Long '定义一变量来保存第一次输入的密码Private n As Long '定义一变量来记录密码输入格式规范(全数字密码),且按钮Cmd1按下的次数'定义一授权密码Private Const sc = 492158181密码部分编写代码Private Sub cmd1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If IsNumeric(Text1.Text) Thenn = n + 1If n = 1 Thennum = Val(Text1.Text)Cmd2.Enabled = FalseText1.Text = ""cmd1.Caption = "请输入解锁密码"Form1.ShowForm2.ShowEnd IfIf Val(n) > 1 And Val(Text1.Text) = num ThenEndEnd IfIf n > 1 And Val(Text1.Text) <> num ThenMessageBoxTimeout Me.hWnd, "亲出错了,请想想再输入,.", "出错了", 48, 0, 2000Text1.Text = ""End IfElseMessageBoxTimeout Me.hWnd, "请输入全数字密码,.", "出错了", 48, 0, 2000Text1.Text = ""End IfEnd SubPrivate Sub Cmd2_Click()EndEnd Sub'软件授权密码编写Private Sub Form_Load()q = InputBox("请输入程序授权密码", "锁屏小程序", 0)If q <> sc Then EndForm2.Show '窗体2激活'窗体Dim th As Longth = GetWindowLong(hWnd, GWL_EXSTYLE)th = th Or WS_EX_LAYEREDSetWindowLong hWnd, GWL_EXSTYLE, thSetLayeredWindowAttributes hWnd, vbBlue, 230, LWA_COLORKEY Or LWA_ALPHA Form1.Width = Screen.WidthForm1.Height = Screen.HeightForm1.Top = 0Form1.Left = 0Form1.BackColor = vbBlueForm1.ForeColor = vbRed'文本框设置Text1.BackColor = RGB(65, 210, 79)Text1.ForeColor = vbRed'按钮(cmd1)设置cmd1.BackColor = RGB(65, 210, 79)'按钮Cmd2设置Cmd2.BackColor = RGB(65, 210, 79)'标签(lb1)设置lb1.BackColor = RGB(133, 87, 179)lb1.ForeColor = vbRed'框架设置Frm1.BackColor = RGB(133, 87, 179)Frm1.Top = Screen.Height / 4'lb2设置Lb2.BackColor = RGB(133, 87, 179)Lb2.ForeColor = vbRedTimer4.Enabled = False'img1的设置img1.Width = Form1.Widthimg1.Height = Form1.HeightEnd SubPrivate Sub Frm1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Timer7.Enabled = TrueEnd SubPrivate Sub Text1_Change()Timer7.Enabled = TrueEnd SubPrivate Sub Timer2_Timer()Dim h1, h2 As Longh1 = FindWindow(vbNullString, "锁屏小程序")h2 = GetForegroundWindow()If h1 <> h2 ThenCall SetWindowPos(h1, -1, 0, 0, 0, 0, 3) End IfEnd SubPrivate Sub Timer3_Timer()Frm1.Left = Frm1.Left - 30If Frm1.Left < 0 ThenTimer4.Enabled = True:Timer3.Enabled = FalseEnd IfEnd SubPrivate Sub Timer4_Timer()Frm1.Left = Frm1.Left + 30If Frm1.Left >= Form1.Width - Frm1.Width Then Timer4.Enabled = FalseTimer3.Enabled = TrueEnd IfEnd SubPrivate Sub Timer7_Timer() Timer8.Enabled = True Timer3.Enabled = False Timer4.Enabled = False Timer7.Enabled = False End SubPrivate Sub Timer8_Timer() Timer3.Enabled = True Timer4.Enabled = False Timer8.Enabled = False End Sub。
VB锁定屏幕编程
VB锁定屏幕编程窗体代码Option ExplicitDim m_Exit As Boolean '限制ALT+F4退出窗体'******隐藏任务栏代码************************************'参数;lpClassName 指定了包含了窗口类名中的空中止,字串的指针,或设为0。
表示接收任何类。
'参数;lpWindowName 指向包含了窗口文本的空中止,字串的指针。
或设为0。
表示接收任何窗口标题。
'功能;寻找窗口列表中第一个符合指定条件的顶级窗口。
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _(ByVal lpClassName As String, _ByVal lpWindowName As String) As LongPrivate Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _ByVal nCmdShow As Long) As LongConst SW_HIDE = 0Const SW_SHOWNORMAL = 1Dim x As LongDim StartWindow As LongDim ClassName As String'******隐藏任务栏代码************************************Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)If m_Exit = True ThenCall DelHook '销内存ElseIf m_Exit = False ThenCancel = -1End IfEnd IfEnd SubPrivate Sub Form_Activate()Frame1.Item(0).Move Me.ScaleWidth - (Frame1.Item(0).Width + 300), Me.ScaleHeight - (Frame1.Item(0).Height + 400)Text1.Item(0).SetFocus' ModSuPing.ShuPing Frame1.Item(0) '调用函数。
C语言C编程学习程序员大神!绘制神奇代码之星空动态
C语⾔C编程学习程序员⼤神!绘制神奇代码之星空动态C语⾔是⾯向过程的,⽽C++是⾯向对象的C和C++的区别:C是⼀个结构化语⾔,它的重点在于算法和数据结构。
C程序的设计⾸要考虑的是如何通过⼀个过程,对输⼊(或环境条件)进⾏运算处理得到输出(或实现过程(事务)控制)。
C++,⾸要考虑的是如何构造⼀个对象模型,让这个模型能够契合与之对应的问题域,这样就可以通过获取对象的状态信息得到输出或实现过程(事务)控制。
所以C与C++的最⼤区别在于它们的⽤于解决问题的思想⽅法不⼀样。
之所以说C++⽐C更先进,是因为“ 设计这个概念已经被融⼊到C++之中 ”。
C与C++的最⼤区别:在于它们的⽤于解决问题的思想⽅法不⼀样。
之所以说C++⽐C更先进,是因为“ 设计这个概念已经被融⼊到C++之中 ”,⽽就语⾔本⾝⽽⾔,在C中更多的是算法的概念。
那么是不是C就不重要了,错!算法是程序设计的基础,好的设计如果没有好的算法,⼀样不⾏。
⽽且,“C加上好的设计”也能写出⾮常好的东西。
今天分享⼀个好玩的:星空要⽤C/C++绘制是动态的哦。
在今天之前,你能想象⽤C/C++⼏⼗⾏代码就能做出上⾯这个轨范吗?代码实现在EasyX的⽂档中,就有这么⼀个Demo轨范。
我们先来分析⼀下这段代码。
看过之前C说话专题的同窗们必定可以独⽴看明⽩这段代码。
代码构造⼤要如下:1. 星星构造体经由过程构造体保留每克星星的位置信息、颜⾊信息和挪动信息。
位置信息EasyX坐标系中的点坐标位置。
颜⾊信息所有的星星都是⽩⾊,不合的是敞亮程度不合。
近处的星星⽃劲亮,远处的星星⽃劲暗。
挪动速度每⼀次轮回,所有的星星都市向右挪动,经由过程这个参数来记实每个星星每次向右挪动的间隔。
近处的星星挪动得快,远处的星星挪动得慢。
2. 星星初始化⽤⼀个数组来保留所有的星星。
每个星星都⽤InitStar()函数随机出⼀组特征值。
把持这些特征值将每颗星星画在画布上。
这⾥使⽤了EasyX的画点接⼝:void putpixel(int x, int y, COLORREF color);3. 星星挪动每20毫秒轮回⼀次,每⼀次轮回中,每颗星星都向右挪动。