克林顿对美国的贡献:能用VB6.0制作一个像万象那样的图片吗？

你可以参照下面的内容!!
祝你好运~~~

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=&H80000007&
BorderStyle=0 ’None
MaxButton=False
MinButton=False
Windowstate=2 ’Maximized
Timer
Intelval=5
PictureBox
BackColor=&H80000007&
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的系统下即可。

可以啊 和制作加密的原理差不多

先新建一个工程，然后将form1的BorderStyle属性改为0、WindowState = 2、Picture的属性设置为自已喜欢的图片，在向form1里添加一个command1 将command1的Visible =False 设置command的快捷键为你想要的快捷键，然后在Command1_Click里添加 代码 end 就ok了

如果仅想盖住其它程序，可以按上面观点实现，也可以设置form的keypreview属性为真，这样就不用加按钮了，直接在form的keypress事件中判断键值就可以了。另外，你如想更通用些，可以在form上放一个image控件，在form的resize事件中写代码，使image和form同样大小，图片放在image中，将其stretch属性设为真即可（这样可以在你更改显示分辨率设置后不受影响）。如果你想使其他程序不能工作，那就要调用很多WINDOWS的底层API了，这样程序就比较麻烦了，相比较而言，最简单的方法就是设置你的程序永远在最前，只需调用一个API就可以了，函数名为SetForegroundWindow 调用方法如下：
你可以添加一个模块，对函数声明
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
然后在form的form_load事件中写
SetForegroundWindow Me.hwnd
即可。
不过你如果想实现这个功能，还不如直接使用WINDOWS的屏幕保护了，这样更省事，哈哈。

这个太简单了，窗体上放一个图片控件，窗体加载时把图片控件的zorder设成最高，这样就在最前边，挡着后边的任何东西，然后再在图片的key_up事件中判断按键，如果是ctrl+alt+a，就把这个图片的zorder设低就行了。
Private Sub Form_Load()
Picture1.ZOrder (0)
End Sub

Private Sub Form_Resize()
Picture1.Move 0, 0, Me.Width, Me.Height
End Sub

Private Sub Picture1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 65 And ((Shift And vbAltMask) > 0) And ((Shift And vbCtrlMask) > 0) Then
Picture1.ZOrder (1)
End If
End Sub