Sprite.vb

Option Explicit On

Imports System.Drawing
Imports System.Runtime.InteropServices

Public Class Sprite : Implements IDisposable

    Private Const COLOR_WHITE As Long = &HFFFFFF
    Private Const COLOR_BLACK As Long = &H0
    Private Const COLOR_MAGENTA As Long = &HFF00FF
    Private Const DEFAULT_MASK_COLOR As Long = COLOR_MAGENTA

    Private _bitmap As CUSTOM_BITMAP
    Private _mask As CUSTOM_BITMAP
    Private _hDC As IntPtr = IntPtr.Zero
    Private _hBmp As IntPtr = IntPtr.Zero
    Private _hOld As IntPtr = IntPtr.Zero
    Private _location As PointF
    Private _disposed As Boolean = False

    Public Sub New(ByVal Filename As String, ByRef g As Graphics, Optional ByVal TransparentColor As Integer = DEFAULT_MASK_COLOR)
        CleanUp(_bitmap)
        _bitmap = LoadBitmap(Filename)
        CleanUp(_mask, True)
        _mask = CreateMask(Filename, TransparentColor)
        Dim gdc As IntPtr = g.GetHdc()
        _hBmp = CreateCompatibleBitmap(gdc, _bitmap.Info.bmWidth, _bitmap.Info.bmHeight)
        _hDC = CreateCompatibleDC(gdc)
        _hOld = SelectObject(_hDC, _hBmp)
        Win32API.BitBlt(_hDC, 0, 0, _bitmap.Info.bmWidth, _bitmap.Info.bmHeight, gdc, 0, 0, TernaryRasterOperations.SRCCOPY)
        g.ReleaseHdc()
        _disposed = False
    End Sub
    Private Function LoadBitmap(ByVal Filename As String) As CUSTOM_BITMAP
        Dim bmp As CUSTOM_BITMAP

        With bmp
            Try
                .hBmp = Win32API.LoadImage(0, Filename, 0, 0, 0, LR_LOADFROMFILE)
                .hDC = CreateCompatibleDC(0)
                Win32API.SelectObject(.hDC, .hBmp)
                Dim hSDBmp As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(.Info))
                Marshal.StructureToPtr(.Info, hSDBmp, False)
                Win32API.GetObject(.hBmp, Len(.Info), hSDBmp)
                .Info = CType(Marshal.PtrToStructure(hSDBmp, GetType(Win32API.STRUCT_BITMAP)), Win32API.STRUCT_BITMAP)
                .Info = .Info
                Marshal.FreeHGlobal(hSDBmp)
                .hOld = Win32API.SelectObject(.hDC, .hBmp)
            Catch
            End Try
        End With

        Return bmp
    End Function
    Private Function CreateMask(ByVal Filename As String, ByVal ColorKey As Integer) As CUSTOM_BITMAP
        Dim bmpMask As CUSTOM_BITMAP
        Dim px As Integer
        Dim py As Integer
        Dim pc As Integer

        bmpMask = LoadBitmap(Filename)
        With bmpMask
            Try
                For py = 0 To .Info.bmHeight - 1
                    For px = 0 To .Info.bmWidth - 1
                        pc = GetPixel(.hDC, px, py)
                        If ColorKey = pc Then
                            SetPixel(.hDC, px, py, COLOR_WHITE) 'Not visible
                        Else
                            SetPixel(.hDC, px, py, COLOR_BLACK) 'Visible
                        End If
                    Next px
                Next py
            Catch
            End Try
        End With

        Return bmpMask
    End Function
    Public Sub Render(ByRef target As Canvas, Optional ByVal UseTransparency As Boolean = False)
        Render(target.Handle, _location.X, _location.Y, UseTransparency)
    End Sub
    Public Sub Render(ByRef target As Canvas, ByVal X As Integer, ByVal Y As Integer, Optional ByVal UseTransparency As Boolean = False)
        Render(target.Handle, X, Y, UseTransparency)
    End Sub
    Friend Sub Render(ByVal hdcDest As IntPtr, Optional ByVal UseTransparency As Boolean = False)
        Render(hdcDest, 0, 0, UseTransparency)
    End Sub
    Friend Sub Render(ByVal hdcDest As IntPtr, ByVal X As Integer, ByVal Y As Integer, Optional ByVal UseTransparency As Boolean = False)
        If UseTransparency Then
            Win32API.BitBlt(_hDC, 0, 0, _bitmap.Info.bmWidth, _bitmap.Info.bmHeight, _mask.hDC, 0, 0, TernaryRasterOperations.SRCAND) 'Draw the mask
            Win32API.BitBlt(_hDC, 0, 0, _bitmap.Info.bmWidth, _bitmap.Info.bmHeight, _bitmap.hDC, 0, 0, TernaryRasterOperations.SRCPAINT) 'Overlay the image
        Else
            Win32API.BitBlt(_hDC, 0, 0, _bitmap.Info.bmWidth, _bitmap.Info.bmHeight, _bitmap.hDC, 0, 0, TernaryRasterOperations.SRCCOPY) 'Just draw the plain image
        End If
        Win32API.BitBlt(hdcDest, X, Y, _bitmap.Info.bmWidth, _bitmap.Info.bmHeight, _hDC, 0, 0, TernaryRasterOperations.SRCCOPY) 'Render results to the destination
    End Sub

    Public Property Location As PointF
        Get
            Return _location
        End Get
        Set(ByVal value As PointF)
            _location = value
        End Set
    End Property
    Public Property X As Single
        Get
            Return _location.X
        End Get
        Set(ByVal value As Single)
            _location.X = value
        End Set
    End Property
    Public Property Y As Single
        Get
            Return _location.Y
        End Get
        Set(ByVal value As Single)
            _location.Y = value
        End Set
    End Property
    Public ReadOnly Property Width As Integer
        Get
            Return _bitmap.Info.bmWidth
        End Get
    End Property
    Public ReadOnly Property Height As Integer
        Get
            Return _bitmap.Info.bmHeight
        End Get
    End Property
    Public ReadOnly Property Size As Size
        Get
            Return New Size(Width, Height)
        End Get
    End Property

    Public Overloads Sub Dispose() Implements IDisposable.Dispose
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub
    Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
        If Not _disposed Then
            'Clear unmanaged resources
            CleanUp(_bitmap)
            CleanUp(_mask, True)
            _disposed = True
        End If
    End Sub
    Private Sub CleanUp(ByRef bmp As CUSTOM_BITMAP, Optional ByVal DeleteContext As Boolean = False)
        With bmp
            If .hOld.ToInt32 <> 0 Then Win32API.SelectObject(.hDC, .hOld)
            If .hBmp.ToInt32 <> 0 Then Win32API.DeleteObject(.hBmp)
            If .hDC.ToInt32 <> 0 Then Win32API.DeleteDC(.hDC)
            If _hdc.ToInt32 <> 0 And DeleteContext Then Win32API.DeleteDC(_hdc)
            .hOld = 0
            .hBmp = 0
            .hDC = 0
            If DeleteContext Then _hdc = IntPtr.Zero
            With .Info
                .bmBits = 0
                .bmBitsPixel = 0
                .bmHeight = 0
                .bmPlanes = 0
                .bmType = 0
                .bmWidth = 0
                .bmWidthBytes = 0
            End With
        End With
    End Sub

End Class