module3.bas

银行定储模拟程序

Attribute VB_Name = "Module3"
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc 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 SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Public Const HWND_TOPMOST = -1
 Public Const HWND_NOTOPMOST = -2
 Public Const SWP_NOSIZE = &H1
 Public Const SWP_NOMOVE = &H2
 Public Const SWP_NOACTIVATE = &H10
 Public Const SWP_SHOWWINDOW = &H40


Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Type POINTAPI
    X As Long
    y As Long
End Type

Private Const R2_NOTXORPEN = 10
Private Const SW_SHOW = 5
Private Const SW_HIDE = 0

'动画关闭窗体
Public Sub AniUnloadFrm(Frm As Long, Optional Speed = 15)
    Dim hdc As Long
    Dim rcCurrent As RECT
    Dim rcNew As RECT
    Dim step1 As Long
    Dim step2 As Long
    Dim I As Long
    
    ShowWindow Frm, SW_HIDE
    DoEvents
    
    '得到桌面的DC
    hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
    '设置绘画模式为XOR
    SetROP2 hdc, R2_NOTXORPEN
    GetWindowRect Frm, rcCurrent

    '动画变化的步长
        '左右变化步长
    step1 = (rcCurrent.Right - rcCurrent.Left) / Speed / 2
        '上下变化步长
    step2 = (rcCurrent.Bottom - rcCurrent.Top) / Speed / 2
    '动画处理
    For I = 1 To Speed
        '绘动画矩形
        Rectangle hdc, rcCurrent.Left, rcCurrent.Top, rcCurrent.Right, rcCurrent.Bottom
        '显示一定时间的延时
        Sleep 30
        '擦除绘制的动画矩形
        Rectangle hdc, rcCurrent.Left, rcCurrent.Top, rcCurrent.Right, rcCurrent.Bottom
        '计算下次动画矩形的数据
        With rcCurrent
            .Left = rcCurrent.Left + step1
            .Top = rcCurrent.Top + step2
            .Bottom = rcCurrent.Bottom - step2
            .Right = rcCurrent.Right - step1
        End With
    Next
    '释放桌面DC
    DeleteDC hdc
End Sub

'动画显示窗体
Public Sub AniShowFrm(Frm As Long, Optional Speed = 15)
    Dim hdc As Long
    Dim rcCurrent As RECT
    Dim rcNew As RECT
    Dim step1 As Long
    Dim step2 As Long
    Dim I As Long
    
    '得到桌面的DC
    hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
    '设置绘画模式为XOR
    SetROP2 hdc, R2_NOTXORPEN
    GetWindowRect Frm, rcCurrent
    
    '动画变化的步长
    step1 = (rcCurrent.Right - rcCurrent.Left) / Speed / 2 '左右变化步长
    step2 = (rcCurrent.Bottom - rcCurrent.Top) / Speed / 2 '上下变化步长
    
    With rcCurrent
        .Left = (.Right - .Left) \ 2 + .Left
        .Right = .Left
        .Top = (.Bottom - .Top) \ 2 + .Top
        .Bottom = .Top
    End With
    
    '动画处理
    For I = 1 To Speed
        '绘动画矩形
        Rectangle hdc, rcCurrent.Left, rcCurrent.Top, rcCurrent.Right, rcCurrent.Bottom
        '显示一定时间的延时
        Sleep 30
        '擦除绘制的动画矩形
        Rectangle hdc, rcCurrent.Left, rcCurrent.Top, rcCurrent.Right, rcCurrent.Bottom
        '计算下次动画矩形的数据
        With rcCurrent
            .Left = rcCurrent.Left - step1
            .Top = rcCurrent.Top - step2
            .Bottom = rcCurrent.Bottom + step2
            .Right = rcCurrent.Right + step1
        End With
    Next
    '释放桌面DC
    DeleteDC hdc
End Sub

'动画旋转显示窗体
Sub AniRotateShowFrm(Frm As Long, Optional Speed As Long = 20)
    Dim PPP1(3) As POINTAPI
    Dim PPP2(3) As POINTAPI
    Dim cx As Long
    Dim cy As Long
    Dim hdc As Long
    Dim rcCurrent As RECT
    Dim rcNew As RECT
    Dim step1 As Long
    Dim step2 As Long
    Dim II As Long
    Dim Radian As Single
    
    '得到桌面的DC
    hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
    '设置绘画模式为XOR
    SetROP2 hdc, R2_NOTXORPEN
    GetWindowRect Frm, rcCurrent
    
    '窗体中心
    cx = (rcCurrent.Right - rcCurrent.Left) \ 2 + rcCurrent.Left
    cy = (rcCurrent.Bottom - rcCurrent.Top) \ 2 + rcCurrent.Top
    
    PPP1(0).X = cx - 1
    PPP1(0).y = cy - 1
    PPP1(1).X = PPP1(0).X + 1
    PPP1(1).y = PPP1(0).y - 1
    PPP1(2).X = PPP1(0).X + 1
    PPP1(2).y = PPP1(0).y + 1
    PPP1(3).X = PPP1(0).X - 1
    PPP1(3).y = PPP1(0).y + 1
    '动画变化的步长
    step1 = (rcCurrent.Right - rcCurrent.Left) / Speed / 2  '左右变化步长
    step2 = (rcCurrent.Bottom - rcCurrent.Top) / Speed / 2  '上下变化步长
    
    For Radian = 0 To 3.14159 Step 3.14159 / Speed
        PPP1(0).X = PPP1(0).X - step1
        PPP1(0).y = PPP1(0).y - step2
        PPP1(1).X = PPP1(1).X + step1
        PPP1(1).y = PPP1(1).y - step2
        PPP1(2).X = PPP1(2).X + step1
        PPP1(2).y = PPP1(2).y + step2
        PPP1(3).X = PPP1(3).X - step1
        PPP1(3).y = PPP1(3).y + step2
        
        For II = 0 To 3
            PPP2(II).X = (PPP1(II).X - cx) _
                * Cos(Radian) + (PPP1(II).y - cx) _
                * Sin(Radian) + cx
            PPP2(II).y = (PPP1(II).y - cy) _
                * Cos(Radian) - (PPP1(II).X - cy) _
                * Sin(Radian) + cy
        Next
        
        Polygon hdc, PPP2(0), 4
        Sleep 30
        Polygon hdc, PPP2(0), 4
    Next
End Sub

'动画旋转关闭窗体
Sub AniRotateUnloadFrm(Frm As Long, Optional Speed As Long = 20)
    Dim PPP1(3) As POINTAPI
    Dim PPP2(3) As POINTAPI
    Dim cx As Long
    Dim cy As Long
    Dim hdc As Long
    Dim rcCurrent As RECT
    Dim rcNew As RECT
    Dim step1 As Long
    Dim step2 As Long
    Dim II As Long
    Dim Radian As Single
    
    ShowWindow Frm, SW_HIDE
    DoEvents
    
    '得到桌面的DC
    hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
    '设置绘画模式为XOR
    SetROP2 hdc, R2_NOTXORPEN
    
    GetWindowRect Frm, rcCurrent
    '窗体中心
    cx = (rcCurrent.Right - rcCurrent.Left) \ 2 + rcCurrent.Left
    cy = (rcCurrent.Bottom - rcCurrent.Top) \ 2 + rcCurrent.Top
    
    PPP1(0).X = rcCurrent.Left
    PPP1(0).y = rcCurrent.Top
    PPP1(1).X = rcCurrent.Right
    PPP1(1).y = rcCurrent.Top
    PPP1(2).X = rcCurrent.Right
    PPP1(2).y = rcCurrent.Bottom
    PPP1(3).X = rcCurrent.Left
    PPP1(3).y = rcCurrent.Bottom
    
    '动画变化的步长
    step1 = (rcCurrent.Right - rcCurrent.Left) / Speed / 2  '左右变化步长
    step2 = (rcCurrent.Bottom - rcCurrent.Top) / Speed / 2  '上下变化步长
    
    For Radian = 0 To -3.14159 Step -3.14159 / Speed
        PPP1(0).X = PPP1(0).X + step1
        PPP1(0).y = PPP1(0).y + step2
        PPP1(1).X = PPP1(1).X - step1
        PPP1(1).y = PPP1(1).y + step2
        PPP1(2).X = PPP1(2).X - step1
        PPP1(2).y = PPP1(2).y - step2
        PPP1(3).X = PPP1(3).X + step1
        PPP1(3).y = PPP1(3).y - step2
        
        For II = 0 To 3
            PPP2(II).X = (PPP1(II).X - cx) _
                * Cos(Radian) + (PPP1(II).y - cx) _
                * Sin(Radian) + cx
            PPP2(II).y = (PPP1(II).y - cy) _
                * Cos(Radian) - (PPP1(II).X - cy) _
                * Sin(Radian) + cy
        Next
        
        Polygon hdc, PPP2(0), 4
        Sleep 30
        Polygon hdc, PPP2(0), 4
    Next
End Sub