爆炸式显示表单

资讯 驱动中国 若水 1,100 次阅读 0 条评论
分享 Q

Option Explicit
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, _
ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long

Private hbrush As Long, hdc5 As Long

Private Sub Form_Load()
Dim dx As Long, dy As Long
Dim rx1 As Long, rx2 As Long, ry1 As Long, ry2 As Long
Dim i As Long, j As Long, bcolor As Long
Dim DispCnt As Long

DispCnt = 60 '一共Display多少次榘形後才显示Form
hdc5 = GetDC(0)
bcolor = GetBkColor(Me.hdc) '取得form的背景色
'注:之所以不使用me.BackColor的原因是:这个属性不一定使用调色盘,
' 如果使用系统配色,那结果会不对
hbrush = CreateSolidBrush(bcolor) '设定笔刷颜色
Call SelectObject(hdc5, hbrush)
dx = Me.Width \ (DispCnt * 2)
dy = Me.Height \ (DispCnt * 2)
j = 1
For i = DispCnt To 1 Step -1
rx1 = (Me.Left + dx * (i - 1)) \ Screen.TwipsPerPixelX
ry1 = (Me.Top + dy * (i - 1)) \ Screen.TwipsPerPixelY
rx2 = rx1 + dx * 2 * j \ Screen.TwipsPerPixelX
ry2 = rx1 + dy * 2 * j \ Screen.TwipsPerPixelY
j = j + 1
Call Rectangle(hdc5, rx1, ry1, rx2, ry2)
Sleep (1)
Next i
Call ReleaseDC(0, hdc5)
Call DeleteObject(hbrush)
End Sub

版权声明:本文由驱动中国整理发布,转载需注明出处与原文链接。如有疑问请联系 editor@qudong.com
本文价值 成为第一个评分的人
登录后为本文打分
网友评论0 条评论
正在回复 的评论取消
评论加载中…
🔐

登录后参与互动

评论、点赞均可赚积分
连续签到、邀请好友也有奖励 🎁

电脑端: 微信扫码登录 微信内: 一键登录

微信扫一扫

打开微信「扫一扫」,分享本文到朋友圈或好友