爆炸式顯示表單

這是一個顯示表單的特殊效果(由小變大)

來源:cww

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