$ filename "HelloWeen.exe"
'uses rtl32
'uses rtl64
uses winutil
'Adapt OxygenBasic path
string o2dir="d:\Oxygenbasic\"
string aBitmap=o2dir + "projectsB\SDL\bmp\pumpa.bmp"
% SRCCOPY = 0xCC0020
% SRCINVERT = 0x660046
% SRCAND = 0x8800C6
% SRCPAINT = 0xEE0086
% LR_LOADFROMFILE = 16
% IMAGE_BITMAP = 0
% WM_GETMINMAXINFO = 36
type BITMAP
long bmType
long bmWidth
long bmHeight
long bmWidthBytes
word bmPlanes
word bmBitsPixel
sys bmBits
end type
macro RGB(r,g,b) {r+(g<<8)+(b<<16)}
macro setMinSize(xMin, yMin)
MINMAXINFO *mm
@mm = lParam
mm.ptMinTrackSize.x = xMin
mm.ptMinTrackSize.y = yMin
end macro
int ID_TIMER = 1
int BALL_MOVE_DELTA = 2
type BALLINFO
int width
int height
int x
int y
int dx
int dy
end type
BALLINFO g_ballInfo
sys g_hbmBall = null
sys g_hbmMask = null
--------------------------------------------------------------------------
MainWindow(640,320, WS_OVERLAPPEDWINDOW)
--------------------------------------------------------------------------
function CreateBitmapMask(sys hbmColour, COLORREF crTransparent) as sys
sys hdcMem, hdcMem2
sys hbmMask
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(sys hdc, RECT *prc)
sys hdcBuffer = CreateCompatibleDC(hdc)
sys hbmBuffer = CreateCompatibleBitmap(hdc, prc.right, prc.bottom)
sys hbmOldBuffer = SelectObject(hdcBuffer, hbmBuffer)
sys hdcMem = CreateCompatibleDC(hdc)
sys hbmOld = SelectObject(hdcMem, g_hbmMask)
FillRect(hdcBuffer, prc, 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(RECT *prc)
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(sys hwnd, uint msg, sys wParam, lParam) as sys callback
select msg
case WM_CREATE
SetWindowText(hwnd, "Hello Ween")
BITMAP bm
g_hbmBall = LoadImage(hInst, aBitmap, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
if g_hbmBall = null then
mbox "Could not load ball.bmp!"
endif
g_hbmMask = CreateBitmapMask(g_hbmBall, RGB(255, 0, 255)) 'magenta
if g_hbmMask = null then
mbox "Could not create mask!"
endif
GetObject(g_hbmBall, sizeof(bm), bm)
g_ballInfo.width = bm.bmWidth
g_ballInfo.height = bm.bmHeight
g_ballInfo.dx = BALL_MOVE_DELTA
g_ballInfo.dy = BALL_MOVE_DELTA
if SetTimer(hwnd, ID_TIMER, 1, null) = 0 then
mbox "Could not SetTimer()!"
endif
case WM_CLOSE
DestroyWindow(hwnd)
case WM_PAINT
RECT rcClient
PAINTSTRUCT ps
sys hdc = BeginPaint(hwnd, ps)
GetClientRect(hwnd, rcClient)
DrawBall(hdc, rcClient)
EndPaint(hwnd, ps)
case WM_GETMINMAXINFO
setMinSize 200,200
case WM_TIMER
RECT rcClient
sys 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