#Include "windows.bi"
#Include "resource.bi"

Const As String g_szClassName = "myWindowClass"
Const As Long ID_TIMER = 1
Const As Long BALL_MOVE_DELTA = 2

Dim Shared As HMODULE hInstance
Dim Shared As ZString Ptr lpCmdLine

Type BALLINFO 
	As Long width_
	As Long height_
	As Long x
	As Long y

	As Long dx
	As Long dy
End Type

Dim Shared As BALLINFO g_ballInfo
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

Sub DrawBall(hdc As HDC, prc As RECT Ptr)
	Dim As HDC hdcBuffer = CreateCompatibleDC(hdc)
	Dim As HBITMAP hbmBuffer = CreateCompatibleBitmap(hdc, prc->Right, prc->bottom)
	Dim As HBITMAP hbmOldBuffer = Cast(HBITMAP, SelectObject(hdcBuffer, hbmBuffer))

	Dim As HDC hdcMem = CreateCompatibleDC(hdc)
	Dim As HBITMAP hbmOld = Cast(HBITMAP, SelectObject(hdcMem, g_hbmMask))

	FillRect(hdcBuffer, prc, Cast(HBRUSH, GetStockObject(WHITE_BRUSH)))

	BitBlt(hdcBuffer, g_ballInfo.x, g_ballInfo.y, g_ballInfo.width_, g_ballInfo.height_, hdcMem, 0, 0, SRCAND)

	SelectObject(hdcMem, g_hbmBall)
	BitBlt(hdcBuffer, g_ballInfo.x, g_ballInfo.y, g_ballInfo.width_, g_ballInfo.height_, hdcMem, 0, 0, SRCPAINT)

	BitBlt(hdc, 0, 0, prc->Right, prc->bottom, hdcBuffer, 0, 0, SRCCOPY)

	SelectObject(hdcMem, hbmOld)
	DeleteDC(hdcMem)

	SelectObject(hdcBuffer, hbmOldBuffer)
	DeleteDC(hdcBuffer)
	DeleteObject(hbmBuffer)
End Sub

Sub UpdateBall(prc As RECT Ptr)
	g_ballInfo.x += g_ballInfo.dx
	g_ballInfo.y += g_ballInfo.dy

	If g_ballInfo.x < 0 Then
		g_ballInfo.x = 0
		g_ballInfo.dx = BALL_MOVE_DELTA
	ElseIf (g_ballInfo.x + g_ballInfo.width_) > prc->Right Then
		g_ballInfo.x = prc->Right - g_ballInfo.width_
		g_ballInfo.dx = -BALL_MOVE_DELTA
	EndIf

	If g_ballInfo.y < 0 Then
		g_ballInfo.y = 0
		g_ballInfo.dy = BALL_MOVE_DELTA
	ElseIf (g_ballInfo.y + g_ballInfo.height_) > prc->bottom Then
		g_ballInfo.y = prc->bottom - g_ballInfo.height_
		g_ballInfo.dy = -BALL_MOVE_DELTA
	EndIf
End Sub

Function WndProc(hwnd As HWND, msg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
	Select Case msg
		Case WM_CREATE
			Dim As ULong ret
			Dim As BITMAP bm

			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

			GetObject(g_hbmBall, SizeOf(bm), @bm)

			ZeroMemory(@g_ballInfo, SizeOf(g_ballInfo))
			g_ballInfo.width_ = bm.bmWidth
			g_ballInfo.height_ = bm.bmHeight

			g_ballInfo.dx = BALL_MOVE_DELTA
			g_ballInfo.dy = BALL_MOVE_DELTA

			ret = SetTimer(hwnd, ID_TIMER, 50, NULL)
			If ret = 0 Then 
				MessageBox(hwnd, "Could not SetTimer()!", "Error", MB_OK Or MB_ICONEXCLAMATION)
			EndIf
	
		Case WM_CLOSE
			DestroyWindow(hwnd)
		
		Case WM_PAINT
			Dim As RECT rcClient
			Dim As PAINTSTRUCT ps
			Dim As HDC hdc = BeginPaint(hwnd, @ps)

			GetClientRect(hwnd, @rcClient)
			DrawBall(hdc, @rcClient)

			EndPaint(hwnd, @ps)
		
		Case WM_TIMER
			Dim As RECT rcClient
			Dim As HDC hdc = GetDC(hwnd)

			GetClientRect(hwnd, @rcClient)

			UpdateBall(@rcClient)
			DrawBall(hdc, @rcClient)

			ReleaseDC(hwnd, hdc)
		
		Case WM_DESTROY
			KillTimer(hwnd, ID_TIMER)

			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, _
		                    "An Animation Program", _
		                    WS_OVERLAPPEDWINDOW, _
		                    CW_USEDEFAULT, CW_USEDEFAULT, 320, 240, _
		                    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)