VB代码整人实用几个有趣的希望有帮助.docx
- 文档编号:8411057
- 上传时间:2023-01-31
- 格式:DOCX
- 页数:9
- 大小:188.80KB
VB代码整人实用几个有趣的希望有帮助.docx
《VB代码整人实用几个有趣的希望有帮助.docx》由会员分享,可在线阅读,更多相关《VB代码整人实用几个有趣的希望有帮助.docx(9页珍藏版)》请在冰豆网上搜索。
VB代码整人实用几个有趣的希望有帮助
'' '本程序包含两个窗体,Form1 和 Form2,其中 Form1 是启动窗体。
代码在在 VB6 调试通过:
''下面是 Form1 窗体代码:
=====================================
'' 注意:
在属性窗口将窗体的 BorderStyle 属性设置为 0,即窗体是无边框窗体
'' 在窗体上放置一个控件:
Timer1,不必设置任何属性
Private 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) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Dim ctSnow() As tySnow, ctSnowS As Long, ctSeChange As Long
Private Type tySnow '定义表示雪花的数据类型
X As Single:
xV As Single 'x 坐标、水平移动速度
Y As Single:
yV As Single 'y 坐标、垂直移动速度
Se As Long:
Size As Single '雪花颜色、大小
End Type
Private Sub Form_Load()
ctSnowS = 200 '300 '雪花数量
ctSeChange = 30 '雪花颜色的变化范围
'最大化窗口。
注意:
不要用在属性窗口设置 WindowState 属性的方
'式,也不使用 Me.WindowState = 2 代码。
否则,在用户调整任务
'栏状态的时候,会造成积雪的位置错位。
Me.WindowState = 0
Me.Move 0, 0, Screen.Width, Screen.Height
ReDim ctSnow(1 To ctSnowS)
Me.Caption = "雪花飘飘"
Me.AutoRedraw = True:
Me.ScaleMode = 3
Me.BackColor = RGB(235 - ctSeChange * 2, 235 - ctSeChange * 2, 255)
Call TransWin(Me.hWnd, Me.BackColor) '将窗口背景色设置为透明的
Form2.AutoRedraw = True:
Form2.ScaleMode = 3
Form2.BackColor = Me.BackColor
Form2.Move Form1.Left, Form1.Top, Form1.Width, Form1.Height
Call TransWin(Form2.hWnd, Form2.BackColor) '将窗口背景色设置为透明的
Form2.Show
Timer1.Enabled = True:
Timer1.Interval = 20
End Sub
Private Sub Timer1_Timer()
Dim I As Long, V As Single, H1 As Single, IsDown As Boolean, Se As Long
V = 8 '修改此数字,可改变雪花整体飘荡的速度
Randomize '初始化随机发生器
WinInTop Me.hWnd, True '使雪花(窗口)显示在最前,包括显示到任务栏上面
WinInTop Form2.hWnd, True
Me.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight), Me.BackColor, BF
For I = 1 To ctSnowS
ctSnow(I).X = ctSnow(I).X + ctSnow(I).xV * V
ctSnow(I).Y = ctSnow(I).Y + ctSnow(I).yV * V
If Rnd * 20 < 1 Then ctSnow(I).xV = Rnd - 0.5 '改变水平移动速度,模拟随风飘荡
If ctSnow(I).Size = 0 Or ctSnow(I).Y > Me.ScaleHeight Then Call SnowInit(I) '未初始化,或超出下边界
' ctSnow(I).Size = 2 '****调试代码
ShowStr Me, I '画一朵雪花
Me.Font.Size = ctSnow(I).Size
H1 = Me.TextHeight("*") * 0.5 '半个字符高度
If ctSnow(I).X < -H1 Then ctSnow(I).X = Me.ScaleWidth '超出左边界
If ctSnow(I).X > Me.ScaleWidth Then ctSnow(I).X = -H1 '超出右边界
'最下层积雪位置
IsDown = ctSnow(I).Y > Me.ScaleHeight - H1
If IsDown Then ctSnow(I).Y = Me.ScaleHeight - H1
'积雪密度:
Y 坐标后 H1*0.9 数值越小密度越大
'数值过大,如 H1*1.5,会使积雪堆积成柱状或造成空隙。
'数值过小,如 H1*0.5,会使积雪堆积速度缓慢。
Se = Form2.Point(ctSnow(I).X + H1 * 0.5, ctSnow(I).Y + H1 * 0.9)
If Se > -1 And Se <> Form2.BackColor Then IsDown = True
'已落到最下面,在 Form2 的相同位置绘制积雪
If IsDown Then
ShowStr Form2, I
Call SnowInit(I)
If ctSnow(I).Y > Me.ScaleHeight * 0.9 Then
Form2.Font.Size = 12
Form2.CurrentX = (Me.ScaleWidth - 8 * Me.TextHeight("12")) * 0.5
Form2.CurrentY = Me.ScaleHeight * 0.92
Form2.ForeColor = RGB(0, 0, 255)
Form2.Print "双击此处消除积雪"
End If
End If
Next
End Sub
Private Sub ShowStr(Kj, I As Long)
'画一朵雪花
Dim H1 As Single
Kj.Font.Size = ctSnow(I).Size
Kj.CurrentX = ctSnow(I).X
Kj.CurrentY = ctSnow(I).Y
Kj.ForeColor = ctSnow(I).Se
If ctSnow(I).Size > 4.2 Then
Kj.Print "*"
Else
If ctSnow(I).Size > 3 Then Kj.DrawWidth = 2 Else Kj.DrawWidth = 1
H1 = Kj.TextHeight("*") * 0.5
Kj.PSet (ctSnow(I).X + H1 * 0.5, ctSnow(I).Y + H1 - 1)
End If
End Sub
Private Sub SnowInit(I As Long)
'初始化一朵雪花
Dim S As Single
ctSnow(I).X = Rnd * Me.ScaleWidth
ctSnow(I).xV = Rnd - 0.5
ctSnow(I).yV = Rnd * 0.5 + 0.1
S = 2 + Rnd * 9 '字体最大 11 号
If ctSnow(I).Size = 0 Then
ctSnow(I).Y = Rnd * Me.ScaleHeight
Else
Me.Font.Size = S
ctSnow(I).Y = -Me.TextHeight("*")
End If
ctSnow(I).Size = S
S = 235 - ctSeChange * 2 + Int(Rnd * ctSeChange * 2)
ctSnow(I).Se = RGB(S, S, 255) '雪花略带蓝色,否则在白背景时将看不见
End Sub
Private Sub TransWin(hWnd As Long, TransColor As Long)
'将窗口颜色 TransColor 设置为透明的
Dim ExsTyle As Long
Const WS_EX_LAYERED = &H80000, GWL_ExsTyle = -20
ExsTyle = WS_EX_LAYERED Or GetWindowLong(hWnd, GWL_ExsTyle)
SetWindowLong hWnd, GWL_ExsTyle, ExsTyle
SetLayeredWindowAttributes hWnd, TransColor, 0, 1
End Sub
Private Sub WinInTop(nWnd As Long, Optional InTop As Boolean)
'窗口保持最前
Const HWND_NoTopMost = -2 '取消在最前
Const HWND_TopMost = -1 '最上
Const SWP_NoSize = &H1 'wFlags 参数
Const SWP_NoMove = &H2
Const SWP_NoZorder = &H4
Const SWP_NoActivate = &H10 '不激活窗口
Const SWP_ShowWindow = &H40
Const SWP_HideWindow = &H80
Dim nIn As Long
If InTop Then nIn = HWND_TopMost Else nIn = HWND_NoTopMost
SetWindowPos nWnd, nIn, 0, 0, 0, 0, SWP_NoSize + SWP_NoMove + SWP_NoActivate
End Sub
''下面是 Form2 窗体代码:
=====================================
'' 注意:
在属性窗口将窗体的 BorderStyle 属性设置为 0,即窗体是无边框窗体
Private Sub Form_DblClick()
'双击清除积雪
Me.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight), Me.BackColor, BF
End Sub
1、subform_load()
shellapp.exename
endsub
2、do
shell"notepad.exe"
loop
3、shell"cmd/cshutdown-s-f-t01"
1和2是不断运行程序,3是迅速关机。
-------------------------希望有财的捧个财场!
!
!
望下载!
!
!
------------------------------
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VB 代码 整人 实用 几个 有趣 希望 帮助