能用VB6.0制作一个像万象那样的图片吗?

王朝知道·作者佚名  2010-03-19
窄屏简体版  字體: |||超大  
 
分類: 電腦/網絡 >> 程序設計 >> 其他編程語言
 
問題描述:

能用VB6.0制作一个像万象那样的图片吗?运行后图一张全屏的图片把画面挡住。但是我按下快捷键后(例如ctrl+alt+a),又可以让计算机退出图片,回到能使用的状态。能把代码给我吗?一部份也可以。

參考答案:

你可以参照下面的内容!!

祝你好运~~~

1111111111111------

用VB定义热键

2222222222222-------

用VB制作下雪效果

333333333333-------

用VB制作屏保

************************************************

1111111111111------

用VB定义热键

使用VB在应用程序中注册热键

日期:2005-6-15 15:35:00 来源: 编辑: 26 [全屏查看全文]

'窗体中

Option Explicit

Private Sub Form_Load()

Dim ret As Long

'记录原来的window程序地址

preWinProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)

'用自定义程序代替原来的window程序

ret = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf wndproc)

idHotKey = 1 'in the range &h0000 through &hBFFF

Modifiers = MOD_ALT '辅助键为Alt

uVirtKey1 = vbKeyQ '注册的热键为Alt+Q

'注册热键

ret = RegisterHotKey(Me.hWnd, idHotKey, Modifiers, uVirtKey1)

If ret = 0 Then

MsgBox "注册热键失败,请使用其它热键!", vbCritical, "错误"

End If

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Dim ret As Long

'取消Message的截取,使之送往原来的window程序

ret = SetWindowLong(Me.hWnd, GWL_WNDPROC, preWinProc)

Call UnregisterHotKey(Me.hWnd, uVirtKey1)

End Sub

'模块中

'以下程序放在模块中

Option Explicit

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long

Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long

Public Const WM_HOTKEY = &H312

Public Const MOD_ALT = &H1

Public Const MOD_CONTROL = &H2

Public Const MOD_SHIFT = &H4

Public Const GWL_WNDPROC = (-4)

Public preWinProc As Long

Public Modifiers As Long, uVirtKey1 As Long, idHotKey As Long

Private Type taLong

ll As Long

End Type

Private Type t2Int

lWord As Integer

hword As Integer

End Type

Public Function wndproc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim lp As taLong, i2 As t2Int

If Msg = WM_HOTKEY Then

If wParam = idHotKey Then

lp.ll = lParam

LSet i2 = lp

If (i2.lWord = Modifiers) And i2.hword = uVirtKey1 Then

Form1.Visible = Not Form1.Visible

End If

End If

End If

'如果不是热键信息则调用原来的程序

wndproc = CallWindowProc(preWinProc, hWnd, Msg, wParam, lParam)

End Function

************************************************

2222222222222-------

用VB制作下雪效果

VB: 制作下雪的特技景象

日期:2005-6-15 15:35:00 来源: 编辑: 24 [全屏查看全文]

对于下雪的景象大家可能都不陌生,我们还是用VB来制作一个下雪的景象吧。其实制作这样一个下雪的景象并不复杂,它的原理是首先在底色为黑色的屏幕上随机画出许多白点(雪花),然后使这些雪花不断地向下移动(重画),反复循环,就成功地模拟了下雪的景象。下面是这个小程序,你可以修改其中的一些数据调整雪花的密度和雪花落下的快慢。

双击窗体写如下代码:

Dim Snow(1000, 2), Amounty As Integer

Private Sub Form_Load()

Form1.Show

DoEvents

Randomize

Amounty = 325

For J = 1 To Amounty

Snow(J, 0) = Int(Rnd * Form1.Width)

Snow(J, 1) = Int(Rnd * Form1.Height)

Snow(J, 2) = 10 + (Rnd * 20)

Next J

Do While Not (DoEvents = 0)

For LS = 1 To 10

For I = 1 To Amounty

OldX = Snow(I, 0): OldY = Snow(I, 1)

Snow(I, 1) = Snow(I, 1) + Snow(I, 2)

If Snow(I, 1) > Form1.Height Then

Snow(I, 1) = 0: Snow(I, 2) = 5 + (Rnd * 30)

Snow(I, 0) = Int(Rnd * Form1.Width)

OldX = 0: OldY = 0

End If

Coloury = 8 * (Snow(I, 2) - 10): Coloury = 60 + Coloury

PSet (OldX, OldY), QBColor(0)

PSet (Snow(I, 0), Snow(I, 1)), RGB(Coloury, Coloury, Coloury)

Next I

Next LS

Loop

End

End Sub

编写窗体的鼠标按下代码:

Private Sub Form_MouseDown(Button As Integer,Shift As Integer, X As Single, Y As Single)

unload me

End Sub

运行上面的小程序,就可以看到漫天的雪花在缓缓落下,地面上还会有积雪!鼠标单击可结束程序。

************************************************

333333333333-------

用VB制作屏保

利用VB6.0设计屏幕保护程序

Windows操作平台设有一个屏幕的保护措施,即屏幕保护功能。经常在Windows操作平台上使用电脑的人们对系统提供给我们的几个屏幕保护程序是不是感到非常平常了,没有新鲜感了,是不是想自己设计屏幕保护程序。下面介绍如何利用VB设计用户自己的屏幕保护程序。屏幕保护程序可以保护显示屏不被损坏,同时节约能源。作为屏幕保护程序,应该具有如下特性:

1)屏幕保护程序运行时,鼠标光标被自动隐藏,在程序结束时,光标显示。2)当单击、移动鼠标或按下键盘时,屏幕保护结束,回到正常操作状态。为了实现这些特性,在编写VB应用程序时,可以采用如下方法:

1、谋浯疤迨粜酝ǔB应用程序的窗体都采用有边框的窗体外观,但作为屏幕保护程序,应设置窗体为无边框,且为最大化。

2、隐藏及显示鼠标光标在Visual Basic应用程序中隐藏及显示鼠标光标需要运用Windows的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 Single

Dim orignX,orignY As Single

’把当前的鼠标值赋给orignX和orignY

orignX=X

orignY=Y

’初始化currentX和currentY

if currentX=0 and currentY=0 Then

currentX=orignX

currentY=orignY

Exit Sub

Endif

’当鼠标移动大于一个象素时,显示鼠标光标并退出程序

If Abs(oriqnX-currentX)>1 or Abs(orignY-currentY)>1Then

X=ShowCursor(True)

End

Endif

EndSub

4、检测鼠标单击在Visual Basic中,单击事件是由“Click”触发的。当屏幕保护程序运行时遇到单击事件,则程序运行终止。代码编辑如下:

Private Sub Form-Click()

X=ShowCursor(True)

End

EndSub

注意在结束之前先设光标的显示为真,以免在程序结束后丢失光标。

5、检测键盘上各按键的状态Visual Basic中的键盘活动由KeyDown触发。代码与单击事件的代码一样。

Private Sub Form-KeyDown(KeyCode As Integer,Shift As Integer)

X=ShowCursor(True)

End

EndSub

下面我们将设计一个简单的屏幕保护程序,该程序运行时,从左至右显示一张图片,图片从屏幕左边出现,至屏幕右面消失,象拉幕一样,且重不停复该过程。假设图片文件名为PIC.BMP,并存放在Windows文件夹中。实际操作如下:

创建一新工程,在窗体中添加一图片框和一个Timer控件。设置它们的属性如下:

Form

BackColor=&H***********&

BorderStyle=0 ’None

MaxButton=False

MinButton=False

Windowstate=2 ’Maximized

Timer

Intelval=5

PictureBox

BackColor=&H***********&

BorderStyle=0 ’None

AutoSize=Ture

输入代码如下:

’在窗体的声明部分声明ShowCursor函数。

Private Declare Function ShowCursor Lib“user32”(By Val bShow As Long) As Long

’在窗体上单击鼠标时退出程序

Private Sub Form-Click()

X=ShowCursor(True)

End

EndSub

’在窗体上按下按键时退出程序

Private Sub Form-KeyDown(KeyCode As Integer,Shift As Integer) X=ShowCursor(True)

End

EndSub

’加载窗体时隐藏鼠标

Private Sub Form-Load()

Dim X As Long

X=ShowCursor(False)

Picture1.Visible=False

Picture1.PICTure=LoadPICTure(“C:\windows\PIC.BMP”)

Picture1.Left=-Picture1.Width

EndSub

’在窗体上移动鼠标时退出程序

Private Sub Form-MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)

Static currentX,currentY As Single

Dim orignX,orignY As Single

’把当前的鼠标值赋给orignX和orignY

orignX=X

orignY=Y

’初始化currentX和currentY

If currentX=0 And currentY=0 Then

currentX=orignX

currentY=orignY

ExitSub

EndIf

If Abs(orignX-currentX)>1 Or Abs(orignY-currentY)>1

Then X=ShowCursor(True)

End

EndIf

EndSub

Private Sub Picture1-Click()

X=ShowCursor(True)

End

EndSub

Private Sub Picture1-KeyDown(KeyCode As Integer,Shift As Integer)

X=ShowCursor(True)

End

EndSub

Private Sub Picture1-MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)

Static Xlast,Ylast As Single

Dim Xnow,Ynow As Single

Xnow=X

Ynow=Y

If Xlast=0 And Ylast=0 Then

Xlast=Xnow

Ylast=Ynow

ExitSub

EndIf

If Abs(Xnow-Xlast)>1 Or Abs(Ynow-Ylast)>1 Then

X=ShowCursor(True)

End

EndIf

EndSub

Private Sub Timer1-Timer()

Picture1.Visible=True

Picture1.Top=(Form1.Height-Picture1.Height)/2

Picture1.Left=Picture1.Left+50

If Picture1.Left>Form1.Width Then

Picture1.Left=-Picture1.Width

EndIf

EndSub

将以上代码编译生成可执行文件,在保存文件对话窗中输入文件名称时把扩展名改为”SCR”,最后将生成的屏幕保护程序添加到Windows的系统下即可。

小贴士:① 若网友所发内容与教科书相悖,请以教科书为准;② 若网友所发内容与科学常识、官方权威机构相悖,请以后者为准;③ 若网友所发内容不正确或者违背公序良俗,右下举报/纠错。
 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航