#Include "windows.bi" #Include "resource.bi" Const As String g_szClassName = "myWindowClass" Dim Shared As HMODULE hInstance Dim Shared As ZString Ptr lpCmdLine Dim Shared As HBITMAP g_hbmBall = NULL Dim Shared As HBITMAP g_hbmMask = NULL Function CreateBitmapMask(hbmColour As HBITMAP, crTransparent As COLORREF) As HBITMAP Dim As HDC hdcMem, hdcMem2 Dim As HBITMAP hbmMask Dim As BITMAP bm GetObject(hbmColour, SizeOf(BITMAP), @bm) hbmMask = CreateBitmap(bm.bmWidth, bm.bmHeight, 1, 1, NULL) hdcMem = CreateCompatibleDC(0) hdcMem2 = CreateCompatibleDC(0) SelectObject(hdcMem, hbmColour) SelectObject(hdcMem2, hbmMask) SetBkColor(hdcMem, crTransparent) BitBlt(hdcMem2, 0, 0, bm.bmWidth, bm.bmHeight, hdcMem, 0, 0, SRCCOPY) BitBlt(hdcMem, 0, 0, bm.bmWidth, bm.bmHeight, hdcMem2, 0, 0, SRCINVERT) DeleteDC(hdcMem) DeleteDC(hdcMem2) Return hbmMask End Function Function WndProc(hwnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT Select Case msg Case WM_CREATE g_hbmBall = LoadBitmap(GetModuleHandle(NULL), MAKEINTRESOURCE(IDB_BALL)) If g_hbmBall = NULL Then MessageBox(hwnd, "Could not load IDB_BALL!", "Error", MB_OK Or MB_ICONEXCLAMATION) EndIf g_hbmMask = CreateBitmapMask(g_hbmBall, RGBA(0, 0, 0, 0)) If g_hbmMask = NULL Then MessageBox(hwnd, "Could not create mask!", "Error", MB_OK Or MB_ICONEXCLAMATION) EndIf Case WM_CLOSE: DestroyWindow(hwnd) Case WM_PAINT Dim As BITMAP bm Dim As RECT rcClient Dim As PAINTSTRUCT ps Dim As HDC hdc = BeginPaint(hwnd, @ps) Dim As HDC hdcMem = CreateCompatibleDC(hdc) Dim As HBITMAP hbmOld = Cast(HBITMAP, SelectObject(hdcMem, g_hbmMask)) GetObject(g_hbmBall, SizeOf(bm), @bm) GetClientRect(hwnd, @rcClient) FillRect(hdc, @rcClient, Cast(HBRUSH, GetStockObject(LTGRAY_BRUSH))) BitBlt(hdc, 0, 0, bm.bmWidth, bm.bmHeight, hdcMem, 0, 0, SRCCOPY) BitBlt(hdc, bm.bmWidth, 0, bm.bmWidth, bm.bmHeight, hdcMem, 0, 0, SRCAND) BitBlt(hdc, bm.bmWidth * 2, bm.bmHeight * 2, bm.bmWidth, bm.bmHeight, hdcMem, 0, 0, SRCAND) SelectObject(hdcMem, g_hbmBall) BitBlt(hdc, 0, bm.bmHeight, bm.bmWidth, bm.bmHeight, hdcMem, 0, 0, SRCCOPY) BitBlt(hdc, bm.bmWidth, bm.bmHeight, bm.bmWidth, bm.bmHeight, hdcMem, 0, 0, SRCPAINT) BitBlt(hdc, bm.bmWidth * 2, bm.bmHeight * 2, bm.bmWidth, bm.bmHeight, hdcMem, 0, 0, SRCPAINT) SelectObject(hdcMem, hbmOld) DeleteDC(hdcMem) EndPaint(hwnd, @ps) Case WM_DESTROY DeleteObject(g_hbmBall) DeleteObject(g_hbmMask) PostQuitMessage(0) Case Else Return DefWindowProc(hwnd, msg, wParam, lParam) End Select Return 0 End Function Function WinMain(hInstance As HINSTANCE, hPrevInstance As HINSTANCE, lpCmdLine As ZString Ptr, nCmdShow As Long) As Long Dim As WNDCLASSEX wc Dim As HWND hwnd Dim As MSG Msg wc.cbSize = SizeOf(WNDCLASSEX) wc.style = 0 wc.lpfnWndProc = @WndProc wc.cbClsExtra = 0 wc.cbWndExtra = 0 wc.hInstance = hInstance wc.hIcon = LoadIcon(NULL, IDI_APPLICATION) wc.hCursor = LoadCursor(NULL, IDC_ARROW) wc.hbrBackground = Cast(HBRUSH, COLOR_WINDOW + 1) wc.lpszMenuName = NULL wc.lpszClassName = @g_szClassName wc.hIconSm = LoadIcon(NULL, IDI_APPLICATION) If RegisterClassEx(@wc) = 0 Then MessageBox(NULL, "Window Registration Failed!", "Error!", MB_ICONEXCLAMATION Or MB_OK) Return 0 EndIf hwnd = CreateWindowEx(WS_EX_CLIENTEDGE, _ g_szClassName, _ "Another Bitmap Program", _ WS_OVERLAPPEDWINDOW, _ CW_USEDEFAULT, CW_USEDEFAULT, 240, 160, _ NULL, NULL, hInstance, NULL) If hwnd = NULL Then MessageBox(NULL, "Window Creation Failed!", "Error!", MB_ICONEXCLAMATION Or MB_OK) Return 0 EndIf ShowWindow(hwnd, nCmdShow) UpdateWindow(hwnd) Do While GetMessage(@msg,NULL,0,0) TranslateMessage(@msg) DispatchMessage(@msg) Loop Return msg.wParam End Function ' Program start hInstance = GetModuleHandle(NULL) lpCmdLine = GetCommandLine WinMain(hInstance, NULL, lpCmdLine, SW_SHOWDEFAULT) ExitProcess(0)