¿Cómo utilizar el programa VB para crear una imagen de nieve cayendo?

El escritorio nevado hecho con VB

Agrega dos temporizadores al formulario

El código es el siguiente:

'Chongchongqingqingzhai Own Internet

Opción explícita

'Código fuente

Función de declaración privada GetDC Lib "user32" (ByVal hwnd As Long) As Long

' La función GetDC() es obtener el identificador (hDC) de la escena del dispositivo de la forma especificada. Utilice el parámetro 0 para obtener el identificador de escena de toda la pantalla

Función de declaración privada GetPixel Lib "gdi32" (ByVal). hdc As Long, ByVal x As Long, ByVal y As Long) As Long

'GetPixel se utiliza para obtener el valor de color de un determinado punto de la escena (aquí, la pantalla completa)

Función de declaración privada SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

'SetPixel se utiliza para establecer un punto determinado en la escena (aquí está la pantalla completa) Valor de color

Función de declaración privada ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

'Libera el identificador de escena del dispositivo obtenido por GetDC(); de lo contrario, puede provocar el bloqueo del sistema

Función de declaración privada InvalidateRect& Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long)

'Limpiar ventana copos de nieve

Tipo privado POINTAPI 'Definir estructura de puntos de coordenadas

x As Long

y As Long

Tipo final

Tipo privado RECT 'Define la estructura de datos de la "región", pero en realidad no se usa porque solo se pasa un parámetro RECT vacío en la función InvalidateRect

left As Long

arriba Mientras tanto

derecha Mientras tanto

abajo Mientras tanto

Tipo final

Dim rect1 Como RECT

Private Const ScrnWidth = 1024 'Ancho de pantalla (unidad: píxel)

Private Const ScrnHight = 768 'Alto de pantalla (unidad: píxel)

Private Const SnowCol = &HFEFFFE 'Copo de nieve color

Private Const SnowColDown = &HFFFFFF 'Color nieve

Private Const SnowColDuck = &HFFDDD 'Color nieve oscuro

Private Co

nst SnowNum = 500 'Número de copos de nieve volando al mismo tiempo

Dim hDC1 As Long 'Manejador del dispositivo de la ventana del escritorio de almacenamiento

Dim pData(SnowNum) As POINTAPI 'Información de posición de almacenamiento de cada uno copo de nieve

Dim pColor(SnowNum) As Long 'Almacena el color original de la pantalla antes de dibujar los copos de nieve

Dim Vx As Integer 'La velocidad de flotación horizontal general de los copos de nieve

Dim Vy As Integer 'La velocidad de caída vertical general del copo de nieve

Dim PVx As Integer 'La velocidad de vuelo horizontal real de un solo copo de nieve

Dim PVy As Integer ' La velocidad de vuelo vertical real de un solo copo de nieve

'Inicializar la posición del copo de nieve

Private Sub InitP(i As Integer)

pData(i).x = Rnd () * ScrnWidth

pData (i).y = Rnd() * 2

pColor(i) = GetPixel(hDC1, pData(i).x, pData(i) .y) 'Obtiene el valor de color original de la pantalla

End Sub

'Obtiene el contraste entre un determinado punto y los puntos circundantes para determinar si los copos de nieve se acumulan en esta posición

Función privada GetContrast(i As Integer) As Long

Dim ColorCmp As Long 'Almacena el valor de color del punto utilizado para la comparación

Dim tempR As Long 'Almacena la parte roja de CorlorCmp, lo mismo a continuación

Dim tempG As Long

Dim tempB As Long

Dim Slope As Integer 'Almacena la dirección de caída del copo de nieve: Vx/Vy

'Calcular la dirección de caída del copo de nieve

Si PVy <> 0 Entonces

Pendiente = PVx / PVy

De lo contrario

Pendiente = 2

Fin si

'Determina qué punto usar como punto de comparación en función de la dirección en la que caen los copos de nieve,

'Si PVx/PVy está entre -1 y 1, es decir, Pendiente=0, toma el píxel directamente debajo

p>

'Si PVx/PVy>1, toma la parte inferior derecha punto, si PVx/PVy<-1, tome el punto inferior izquierdo

Si Pendiente = 0 Entonces

ColorCmp = GetPixel(hDC1, pData(i).x, pData(i ).y + 1)

De lo contrario

Si Pendiente > 1 Entonces

ColorCmp = GetPixel (hDC1, pData(i).x + 1, pData( i).y + 1)

De lo contrario

ColorCmp = GetPixel(hDC1, pData(i).x - 1 , pData(i).y + 1)

End If

End If

'Asegúrese de que la posición actual no se superponga con otro copo de nieve; de ​​lo contrario, devuelva 0. Se utiliza para evitar que los copos de nieve se apilen debido a la superposición de diferentes copos de nieve.

Si ColorCmp = SnowCol Entonces<

/p>

GetContrast = 0

Salir de la función

End If

'Obtiene la diferencia entre ColorCmp y las partes azul, verde y roja del punto de comparación respectivamente Valor

tempB = Abs((ColorCmp y &HFF0000) - (pColor(i) y &HFF0000)) / &H10000

tempG = Abs((ColorCmp y &HFF00&) - ( pColor(i) ) And &HFF00&)) / &H100&

tempR = Abs((ColorCmp And &HFF&) - (pColor(i) And &HFF&))

'Valor de contraste de retorno

GetContrast = (tempR + tempG + tempB) / 3

Función final

'Dibujar un marco, es decir, volver a dibujar todas las posiciones de los copos de nieve una vez

Private Sub DrawP()

Dim i As Integer

For i = 0 To SnowNum

'Evita que los copos de nieve se superpongan y causen interferencias

Si pColor( i) <> SnowCol Then

'Restaura el color de la posición anterior

SetPixel hDC1, pData(i).x, pData(i).y , pColor(i)

End If

'Establece una nueva posición, i Mod 3 se usa para dividir los copos de nieve en tres categorías con diferentes velocidades para crear una sensación de capas

PVx = Rnd( ) * 2 - 1 + Vx * (i Mod 3)

PVy = Vy * (i Mod 3 + 1)

pData(i ).x = pData(i). x + PVx

pData(i).y = pData(i).y + PVy

'Obtiene el valor de color original del nuevo. posición, que se utilizará para restaurar aquí cuando los copos de nieve se desplacen en el siguiente paso Color

pColor(i) = GetPixel(hDC1, pData(i).x, pData(i).y)

'Si falla la obtención del color, significa que los copos de nieve se han salido de la pantalla, reinicialice

Si pColor(i) = -1 Entonces

InitP i

Else

'De lo contrario, si los copos de nieve no se superponen

If pColor(i) <> SnowCol Then

'Si el contraste es pequeño (es decir, no se puede acumular), dibuja copos de nieve

'Rnd()>0.3 Se utiliza para evitar que ciertos límites continuos y obvios intercepten todos los copos de nieve

Si Rnd() > 0.3 O GetContrast(i) < 50 Then

SetPixel hDC1, pData(i).x , pData(i).y, SnowCol

'De lo contrario, indica que se encuentra un límite obvio , la nieve acumulada se dibuja y se inicializa para dibujar nuevos copos de nieve

Else

SetPixel hDC1, pData(i).x, pData(i).y

- 1, PatoNieve

SetPixel hDC1, pData(i).x - 1, pData(i).y, PatoNieve

SetPixel hDC1, pData(i).x + 1, pData(i).y, SnowColDown

InitP i

Finalizar si

Finalizar si

Finalizar si

Siguiente

End Sub

Private Sub Form_Load()

Dim j As Integer

Me.Caption = "Nieve cayendo sobre el escritorio" 'Establecer título de ventana

'Establecer temporizador, Temporizador1 se usa para dibujar un solo cuadro, Temporizador2 se usa para cambios de dirección del viento

Timer1.Enabled = True

Timer1.Interval = 10

Timer2.Enabled = True

Timer2.Interval = 2000

Randomize 'Inicializar semilla de número aleatorio

hDC1 = GetDC( 0) 'Obtiene el identificador de escena del dispositivo de la ventana del escritorio

'Inicializa toda la pantalla

For j = 0 To SnowNum

pData(j ).x = Rnd() * ScrnWidth

pData(j).y = Rnd() * ScrnHight

pColor(j) = GetPixel(hDC1, pData(j).x , pData(j).y )

Siguiente

Fin Sub

Sub privado Form_Unload(Cancelar como entero)

ReleaseDC 0, hDC1 'Libera el identificador del dispositivo de la ventana del escritorio

InvalidateRect 0, rect1, 0 ​​​​'Borra todos los copos de nieve y restaura el escritorio

End Sub

Private Sub Timer1_Timer( )

DrawP ' Dibujar un marco

End Sub

Private Sub Timer2_Timer()

'Cambiar la dirección del viento

Vx = Rnd() * 4 - 2

Vy = Rnd() + 2

End Sub

'Finalmente, se necesitan dos temporizadores: Temporizador1 y Temporizador2.