Падающий снег
Пример анимации падающего снега, выполненный средствами GDI.
Платформы:
Windows
Автор: MichaelW, создано в 2011 году.
''============================================================================= #INCLUDE "windows.bi" ''============================================================================= #DEFINE FLAKE_COUNT 3000 #DEFINE UPDATE_DELAY 0 #DEFINE USE_FASTSETPIXEL 1 ''============================================================================= #DEFINE FPU_RC_NEAREST 0 '' or to even if equidistant (initialized state) #DEFINE FPU_RC_DOWN &h400 '' toward -infinity #DEFINE FPU_RC_UP &h800 '' toward +inifinity #DEFINE FPU_RC_TRUNCATE &hc00 '' toward zero '-------------------------------------------------- '' This macro sets the rounding control bit in the '' FPU Control Word to one of the above values. '-------------------------------------------------- #MACRO FPU_SETRC(rc) Asm push eax fstcw [esp] pop eax And eax, Not 0xc00 Or eax, rc push eax fldcw [esp] pop eax End Asm #endmacro ''============================================================================= Type FLAKE ix As Integer iy As Integer fi As Single fy As Single End Type ''============================================================================= Dim Shared As FLAKE Ptr g_pFlakes Dim Shared As HDC g_hdcDDB Dim Shared As HBITMAP g_hDDB Dim Shared As BITMAPINFO Ptr g_pBMI Dim Shared As Any Ptr g_pDIBits Dim Shared As Integer g_width, g_height, g_frameCount ''============================================================================= Sub FastSetPixel naked ( Byval pBuff As Any Ptr, _ Byval pitch As Integer, _ Byval x As Integer, _ Byval y As Integer, _ Byval clr As Integer ) Asm mov ecx, [esp+16] mov eax, [esp+8] mul ecx mov ecx, eax mov edx, [esp+4] mov eax, [esp+12] Add ecx, eax mov eax, [esp+20] mov [edx+ecx*4], eax ret 20 End Asm End Sub ''============================================================================= Function WindowProc( Byval hWnd As HWND,_ Byval uMsg As uint,_ Byval wParam As WPARAM,_ Byval lParam As LPARAM ) As LRESULT Static As Integer frameCount Static As HGDIOBJ hPrevBmp Dim As RECT rc Dim As HDC hdcClient Dim As PAINTSTRUCT ps Dim As HBITMAP hDDB Dim As HGDIOBJ hPrevBM Select Case uMsg Case WM_CREATE ''---------------------------------------------- '' Get the width and height of the client area. ''---------------------------------------------- GetClientRect( hWnd, @rc ) g_width = rc.right + 1 g_height = rc.bottom + 1 ''------------------------------------------- '' Allocate memory for the flake data array. ''------------------------------------------- g_pFlakes = Callocate( g_width * g_height * Sizeof(FLAKE) ) ''------------------------------------------------------------- '' Get a DC for the client area and create a compatible memory '' DC and compatible bitmap (DDB). The compatible bitmap is '' used as a drawing surface for the API SetPixel function and '' to receive the bitmap bits from the device-independent '' bitmap (DIB) that the FastSetPixel procedure draws on. ''------------------------------------------------------------- hdcClient = GetDC( hWnd ) g_hdcDDB = CreateCompatibleDC( hdcClient ) g_hDDB = CreateCompatibleBitmap( hdcClient, g_width, g_height ) ''---------------------------------------------------- '' Select the bitmap into the memory DC and save the '' previously selected object. '' '' The bitmap, by default, will be filled with black. ''---------------------------------------------------- hPrevBmp = SelectObject( g_hdcDDB, g_hDDB ) ''------------------------------------------------------------- '' Allocate memory to store the BITMAPINFO structure for our '' DIB and set the biSize member to the size of the structure. ''------------------------------------------------------------- g_pBMI = Callocate( Sizeof(BITMAPINFO) ) g_pBMI->bmiHeader.biSize = Sizeof(BITMAPINFO) ''-------------------------------------------------------- '' Call the GetDIBits function with the lpvBits parameter '' set to null, so the function will pass the dimensions '' and format of the bitmap to the BITMAPINFO structure. ''-------------------------------------------------------- GetDIBits( hdcClient, g_hDDB, 0, 0, null, g_pBMI, DIB_RGB_COLORS ) ''------------------------------------ '' Ensure that the display bpp is 32. ''------------------------------------ If g_pBMI->bmiHeader.biBitCount <> 32 Then MessageBox( hWnd, "Display bpp must be 32", 0, 0 ) KillTimer( hWnd, 1 ) SelectObject( g_hdcDDB, hPrevBmp ) ReleaseDC( null, g_hdcDDB ) Deallocate( g_pFlakes ) Deallocate( g_pBMI ) Deallocate( g_pDIBits ) DestroyWindow( hWnd ) End If ''---------------------------------------------------------------- '' To keep access to the DIB bits simple, specify an uncompressed '' format and a negative height, so we get a top-down DIB instead '' of the normal bottom-up DIB. ''---------------------------------------------------------------- g_pBMI->bmiHeader.biCompression = BI_RGB g_pBMI->bmiHeader.biHeight = -g_pBMI->bmiHeader.biHeight ''--------------------------------------------------------- '' Allocate a buffer to store the bitmap bits for our DIB. '' Zero-filling the buffer effectively provides a black '' background for the DIB. The FastSetPixel procedure draws '' to this buffer. ''--------------------------------------------------------- g_pDIBits = Callocate( g_pBMI->bmiHeader.biSizeImage ) ReleaseDC( null, hdcClient ) ''----------------------------------------------------- '' Initialize the flake data array with random X and Y '' coordinates, and Y increment values spread over a '' small random range (~0.425 to ~0.575) ''----------------------------------------------------- For i As Integer = 0 To FLAKE_COUNT - 1 g_pFlakes[i].ix = Int(Rnd * g_width) g_pFlakes[i].fy = Rnd * g_height g_pFlakes[i].fi = Rnd * 0.15 + .425 Next ''----------------------------------------------------------- '' Create a timer to provide a time base for the frame rate. ''----------------------------------------------------------- SetTimer( hWnd, 1, 1000, null ) Case WM_PAINT ''------------------------------------------------ '' Display the DDB by copying it to the paint DC. ''------------------------------------------------ BeginPaint( hWnd, @ps ) hDDB = CreateCompatibleBitmap( ps.hdc, g_width, g_height ) hPrevBM = SelectObject( ps.hdc, hDDB ) BitBlt( ps.hdc, 0, 0, g_width, g_height, g_hdcDDB, 0, 0, SRCCOPY ) SelectObject( ps.hdc, hPrevBM ) DeleteObject( hDDB ) EndPaint( hWnd, @ps ) Case WM_ERASEBKGND 'return 1 Case WM_TIMER SetWindowText( hWnd, Str(g_frameCount) ) g_frameCount = 0 Case WM_COMMAND Select Case wParam Case IDCANCEL DestroyWindow( hWnd ) End Select Case WM_CLOSE KillTimer( hWnd, 1 ) SelectObject( g_hdcDDB, hPrevBmp ) ReleaseDC( null, g_hdcDDB ) Deallocate( g_pFlakes ) Deallocate( g_pBMI ) Deallocate( g_pDIBits ) DestroyWindow( hWnd ) Case WM_DESTROY PostQuitMessage( null ) Case Else Return DefWindowProc( hWnd, uMsg, wParam, lParam ) End Select Return 0 End Function ''============================================================================= Dim As WNDCLASSEX wcx Dim As HWND hWnd Dim As MSG wMsg Dim As Integer wx, wy, nWidth, nHeight Dim As String className = "test_class" With wcx .cbSize = Sizeof( WNDCLASSEX ) .style = CS_HREDRAW Or CS_VREDRAW Or CS_BYTEALIGNWINDOW .lpfnWndProc = Cast( WNDPROC, @WindowProc ) .cbClsExtra = null .cbWndExtra = null .hInstance = GetModuleHandle( null ) .hbrBackground = GetStockObject( BLACK_BRUSH ) .lpszMenuName = null .lpszClassName = Strptr( className ) .hIcon = LoadIcon( null, IDI_APPLICATION ) .hCursor = LoadCursor ( null, IDC_ARROW ) .hIconSm = 0 End With RegisterClassEx( @wcx ) nWidth = 400 nHeight = 400 wx = (GetSystemMetrics( SM_CXSCREEN ) / 2) - nWidth / 2 wy = (GetSystemMetrics( SM_CYSCREEN ) / 2) - nHeight / 2 hWnd = CreateWindowEx( 0,_ Strptr( className ),_ "Test",_ WS_OVERLAPPED Or WS_SYSMENU,_ wx, wy, nWidth, nHeight,_ null, null,_ GetModuleHandle( null ), null ) ShowWindow( hWnd, SW_SHOWNORMAL ) UpdateWindow( hWnd ) ''----------------------------------------------------------- '' Set the FPU to round down, to avoid in the flake-position '' update code below, having the default rounding (nearest) '' round the integer y-position up an invalid value, which '' will trigger an access-violation exception. ''----------------------------------------------------------- FPU_SETRC( FPU_RC_DOWN ) Do If PeekMessage( @wMsg, null, 0, 0, PM_REMOVE ) <> 0 Then If wMsg.message = WM_QUIT Then Exit Do If IsDialogMessage( hWnd, @wMsg ) = 0 Then TranslateMessage( @wMsg ) DispatchMessage( @wMsg ) End If Else ''--------------------------------------------------------- '' This code runs whenever there is no message to process. ''--------------------------------------------------------- For i As Integer = 0 To FLAKE_COUNT - 1 ''---------------------------------------- '' "Erase" the flake at the old position. ''---------------------------------------- #IF USE_FASTSETPIXEL FastSetPixel( g_pDIBits, g_width, g_pFlakes[i].ix, _ g_pFlakes[i].iy, 0 ) #ELSE SetPixel( g_hdcDDB, g_pFlakes[i].ix, g_pFlakes[i].iy, 0 ) #ENDIF ''------------------------------------------------------- '' Update the flake position, wrapping to the top of the '' window when the flake reaches the bottom. ''------------------------------------------------------- g_pFlakes[i].fy += g_pFlakes[i].fi If g_pFlakes[i].fy >= g_height Then g_pFlakes[i].fy = 1 g_pFlakes[i].iy = g_pFlakes[i].fy ''----------------------------------------- '' Draw the flake at the updated position. ''----------------------------------------- #IF USE_FASTSETPIXEL FastSetPixel( g_pDIBits, g_width, g_pFlakes[i].ix, _ g_pFlakes[i].iy, &hffffff ) #ELSE SetPixel( g_hdcDDB, g_pFlakes[i].ix, g_pFlakes[i].iy, &hffffff ) #ENDIF Next ''----------------------------------------------- '' If using the FastSetPixel procedure, copy the '' bitmap bits from the DIB to the DDB. ''----------------------------------------------- #IF USE_FASTSETPIXEL SetDIBits( 0, g_hDDB, 0, g_height, g_pDIBits, g_pBMI, DIB_RGB_COLORS ) #ENDIF ''------------------------------------- '' Force a repaint of the client area. ''------------------------------------- InvalidateRect( hWnd, 0, 0 ) Sleep UPDATE_DELAY g_frameCount += 1 End If Loop ''=============================================================================
