VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "dwBitmap"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
Option Explicit

' Class dwBitmap
' Desaware API Toolkit object library
' Copyright (c) 1996 by Desaware Inc.
' All rights reserved

#If Win32 Then
Private ihBitmap As Long
#Else
Private ihBitmap As Integer
#End If
Private iStockBm As Boolean

#If Win32 Then
Private Declare Function apiDeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal handle As Long) As Long
Private Declare Function apiCreateBitmap& Lib "gdi32" Alias "CreateBitmap" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, ByVal lpBits As Long)
Private Declare Function apiCreateBitmapIndirect& Lib "gdi32" Alias "CreateBitmapIndirect" (ByVal lpBitmap As Long)
Private Declare Function apiCreateCompatibleBitmap& Lib "gdi32" Alias "CreateCompatibleBitmap" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long)
Private Declare Function apiGetBitmapBits& Lib "gdi32" Alias "GetBitmapBits" (ByVal hBitmap As Long, ByVal dwCount As Long, ByVal lpBits As Long)
Private Declare Function apiGetBitmapDimensionEx& Lib "gdi32" Alias "GetBitmapDimensionEx" (ByVal hBitmap As Long, lpDimension As Size)
Private Declare Function apiLoadBitmap& Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As Any)
Private Declare Function apiSetBitmapBits& Lib "gdi32" Alias "SetBitmapBits" (ByVal hBitmap As Long, ByVal dwCount As Long, ByVal lpBits As Long)
Private Declare Function apiSetBitmapDimensionEx& Lib "gdi32" Alias "SetBitmapDimensionEx" (ByVal hbm As Long, ByVal nX As Long, ByVal nY As Long, lpSize As Size)
Private Declare Function apiGetObject& Lib "gdi32" Alias "GetObjectA" (ByVal handle As Long, ByVal nCount As Long, ByVal plBuffer As Long)
#Else
Private Declare Function apiDeleteObject% Lib "gdi" Alias "DeleteObject" (ByVal handle As Integer)
Private Declare Function apiCreateBitmap% Lib "gdi" Alias "CreateBitmap" (ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal nPlanes As Integer, ByVal nBitCount As Integer, ByVal lpBits As Long)
Private Declare Function apiCreateBitmapIndirect% Lib "gdi" Alias "CreateBitmapIndirect" (lpBitmap As BITMAP)
Private Declare Function apiCreateCompatibleBitmap% Lib "gdi" Alias "CreateCompatibleBitmap" (ByVal hDC As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer)
Private Declare Function apiGetBitmapBits& Lib "gdi" Alias "GetBitmapBits" (ByVal hBitmap As Integer, ByVal dwCount As Long, ByVal lpBits As Any)
Private Declare Function apiGetBitmapDimensionEx% Lib "gdi" Alias "GetBitmapDimensionEx" (ByVal hBitmap As Integer, lpDimension As Size)
Private Declare Function apiLoadBitmap% Lib "user" Alias "LoadBitmap" (ByVal hInstance As Integer, ByVal lpBitmapName As Any)
Private Declare Function apiSetBitmapBits& Lib "gdi" Alias "SetBitmapBits" (ByVal hBitmap As Integer, ByVal dwCount As Long, ByVal lpBits As Any)
Private Declare Function apiSetBitmapDimensionEx% Lib "gdi" Alias "SetBitmapDimensionEx" (ByVal nY As Integer, lpSize As Size, ByVal hBitmap As Integer, ByVal nX As Integer)
Private Declare Function apiGetObject% Lib "gdi" Alias "GetObject" (ByVal handle As Integer, ByVal nCount As Integer, ByVal plBuffer As Long)
#End If 'WIN32

Public Property Get hBitmap() As Long
    hBitmap = ihBitmap
End Property

Public Sub CreateBitmap(ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, Bits() As Long)
Attribute CreateBitmap.VB_HelpID = 2490
Attribute CreateBitmap.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&

    ClearBitmap
    ret& = apiCreateBitmap(nWidth, nHeight, nPlanes, nBitCount, Bits(0))
    If ret& = 0 Then RaiseBitmapError
    ihBitmap = ret&
    iStockBm = False
End Sub

Public Sub CreateBitmapIndirect(lpBitmap As Long)
Attribute CreateBitmapIndirect.VB_HelpID = 2491
Attribute CreateBitmapIndirect.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
#If Win32 Then
    Dim ret&
    
    ClearBitmap
    ret& = apiCreateBitmapIndirect(lpBitmap)
    If ret& = 0 Then RaiseBitmapError
    ihBitmap = ret&
    iStockBm = False
#Else
    Dim ret%
    Dim tmpBitmap As BITMAP
    
    ClearBitmap
    agCopyData agGetAddressForObject(tmpBitmap), lpBitmap, Len(tmpBitmap)
    ret% = apiCreateBitmapIndirect(tmpBitmap)
    If ret% = 0 Then RaiseBitmapError
    ihBitmap = ret%
    iStockBm = False
#End If
End Sub

Public Sub CreateCompatibleBitmap(dc As dwDeviceContext, ByVal nWidth As Long, ByVal nHeight As Long)
Attribute CreateCompatibleBitmap.VB_HelpID = 2493
Attribute CreateCompatibleBitmap.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&
    
    ClearBitmap
    ret& = apiCreateCompatibleBitmap(dc.hDC, nWidth, nHeight)
    If ret& = 0 Then RaiseBitmapError
    ihBitmap = ret&
    iStockBm = False
End Sub

Public Sub GetBitmapBits(ByVal dwCount As Long, lpBits As Long)
Attribute GetBitmapBits.VB_HelpID = 2538
Attribute GetBitmapBits.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&
    
    If ihBitmap = 0 Then RaiseBitmapError DWERR_UNINITIALIZED
    ret& = apiGetBitmapBits(ihBitmap, dwCount, lpBits)
    If ret& = 0 Then RaiseBitmapError
End Sub

Public Property Get Height() As Long
    Dim ret&
    Dim iBitmap As BITMAP
    
    If ihBitmap = 0 Then RaiseBitmapError DWERR_UNINITIALIZED
    ret& = apiGetObject(ihBitmap, Len(iBitmap), agGetAddressForObject(iBitmap.bmType))
    If ret& = 0 Then RaiseBitmapError
    Height = iBitmap.bmHeight
End Property

Public Property Get Width() As Long
    Dim ret&
    Dim iBitmap As BITMAP
    
    If ihBitmap = 0 Then RaiseBitmapError DWERR_UNINITIALIZED
    ret& = apiGetObject(ihBitmap, Len(iBitmap), agGetAddressForObject(iBitmap.bmType))
    If ret& = 0 Then RaiseBitmapError
    Width = iBitmap.bmWidth
End Property

Public Sub LoadBitmap(ByVal hInstance As Long, ByVal lpBitmapName)
Attribute LoadBitmap.VB_HelpID = 3022
Attribute LoadBitmap.VB_Description = "Help available in Visual Basic Programmer's Guide to Win32 API CD ROM"
    Dim ret&
    
    ClearBitmap
    If hInstance = 0 Then
        ret& = apiLoadBitmap(hInstance, ByVal CLng(lpBitmapName))
        iStockBm = True
    Else
        ret& = apiLoadBitmap(hInstance, ByVal CStr(lpBitmapName))
        iStockBm = False
    End If
    If ret& = 0 Then RaiseBitmapError
    ihBitmap = ret&
End Sub

Public Sub SetBitmapBits(ByVal dwCount As Long, lpBits As Long)
Attribute SetBitmapBits.VB_HelpID = 2614
    Dim ret&
    
    If ihBitmap = 0 Then RaiseBitmapError DWERR_UNINITIALIZED
    ret& = apiSetBitmapBits(ihBitmap, dwCount, lpBits)
    If ret& = 0 Then RaiseBitmapError
End Sub

Public Sub ClearBitmap()
    If Not iStockBm And ihBitmap <> 0 Then
        Call apiDeleteObject(ihBitmap)
        ihBitmap = 0
    End If
End Sub

Private Sub RaiseBitmapError(Optional errval)
    If IsMissing(errval) Then
        RaiseBitmapError DWERR_APIRESULT
    Else
        RaiseError errval, "dwBitmap"
    End If
End Sub

Public Property Get IsStockBitmap() As Boolean
    If ihBitmap = 0 Then RaiseBitmapError DWERR_UNINITIALIZED
    IsStockBitmap = iStockBm
End Property

Private Sub Class_Terminate()
    ClearBitmap
End Sub

Public Sub CopyFrom(bm As dwBitmap)
    Dim dc1 As New dwDeviceContext
    Dim dc2 As New dwDeviceContext
    Dim dc3 As New dwDeviceContext
    
    dc3.CreateDC "Display", vbNullString, vbNullString, Nothing
    dc1.CreateCompatibleDC dc3
    dc2.CreateCompatibleDC dc3
    Set dc3 = Nothing
    dc1.SelectObjectBitmap Me
    dc2.SelectObjectBitmap bm
    dc1.BitBlt 0, 0, bm.Width, bm.Height, dc2, 0, 0, dc1.SRCCOPY
End Sub
