directx7_下雪form1.frm

来自「个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助」· FRM 代码 · 共 69 行

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00000000&
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Xiaxue(1000, 2), Sumu As Long
Dim DX As New DirectX7
Dim DDraw As DirectDraw7

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then
        temp = ShowCursor(1)
        Call SystemParametersInfo(spi_screensaverrunning, False, ByVal 1&, 0)
        Unload Me
        End
    End If
End Sub

Private Sub Form_Load()
     temp = ShowCursor(0)
     Set DDraw = DX.DirectDrawCreate("")
     DDraw.SetCooperativeLevel Me.hWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN
     Call SystemParametersInfo(spi_screensaverrunning, True, ByVal 1&, 0)
     Form1.Show
     DoEvents
     Randomize
     Sumu = 400
     For j = 1 To 10 'Sumu
        Xiaxue(j, 1) = Int(Rnd * Form1.Height)
        Xiaxue(j, 0) = Int(Rnd * Form1.Width)
        Xiaxue(j, 2) = 15 + (Rnd * 5)
     Next j
     Do While Not (DoEvents = 0)
        For ls = 1 To 10
            For i = 1 To Sumu
                
                oldx = Xiaxue(i, 0): oldy = Xiaxue(i, 1)
                Xiaxue(i, 1) = Xiaxue(i, 1) + Xiaxue(i, 2)
                If Xiaxue(i, 1) > Form1.Height Then
                    Xiaxue(i, 1) = 0: Xiaxue(i, 2) = 15 + (Rnd * 20) '随机产生下降速度
                    Xiaxue(i, 0) = Int(Rnd * Form1.Width)
                    oldx = 0: oldy = 0
                End If
            coloury = 8 * (Xiaxue(i, 2) - 10): coloury = 60 + coloury
            PSet (oldx, oldy), QBColor(0)
            PSet (Xiaxue(i, 0), Xiaxue(i, 1)), RGB(coloury, coloury, coloury)
            Next i
        Next ls
    Loop
    End
End Sub

Private Sub Form_Unload(Cancel As Integer)
    temp = ShowCursor(1)
End Sub