Code: Select all
#include "windows.bi"
#include "globals.bas"
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
Type Sprite
Dim As HDC hdcMem
Dim As HBITMAP hbmSPR
Dim As HBITMAP hbmMask
Dim As HBITMAP hbmOld
Dim As BITMAP bm
Declare Sub loadImage(ByVal pathname As String)
Declare Sub cleanUpImage()
Declare Sub drawImage(ByVal x As Integer, ByVal y As Integer, _
ByVal w As Integer, ByVal h As Integer)
End Type
Sub Sprite.loadImage(ByVal pathname As String)
hdcMem = CreateCompatibleDC(Memhdc)
hbmSPR = Cast(HBITMAP, LoadImageA(NULL, pathname,IMAGE_BITMAP,0,0,LR_DEFAULTSIZE Or LR_LOADFROMFILE))
hbmMask = CreateBitmapMask(hbmSPR, RGBA(255,0,255,0))
End Sub
Sub Sprite.cleanUpImage()
DeleteObject(hbmSPR)
DeleteObject(hbmMask)
DeleteDC(hdcMem)
End Sub
Sub Sprite.drawImage(ByVal x As Integer, ByVal y As Integer, _
ByVal w As Integer, ByVal h As Integer)
hbmOld = Cast(HBITMAP, SelectObject(hdcMem,hbmSPR))
BitBlt(Memhdc, x, y, w, h, hdcMem, 0, 0, SRCAND)
SelectObject(hdcMem, hbmSPR)
BitBlt(Memhdc, x, y, w, h, hdcMem, 0, 0, SRCPAINT)
SelectObject(hdcMem,hbmOld)
End Sub