by Waty Thierry (60 Submissions)
Category: Graphics
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Tue 30th March 1999
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Creates a bitmap type Picture object from a bitmap and palette
API Declarations
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : [email protected]
' * Date : 13/10/98
' * Time : 09:18
' * Module Name : Capture_Module
' * Module Filename : Capture.bas
' **********************************************************************
' * Comments : Creates a bitmap type Picture object from a bitmap
' * and palette
' **********************************************************************
Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type PicBmp
Size As Long
nType As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long
VBcoders
' #VBIDEUtils#************************************************************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : [email protected]
' * Date : 13/10/98
' * Time : 09:18
' * Module Name : Capture_Module
' * Module Filename : Capture.bas
' * Procedure Name : CreateBitmapPicture
' * Parameters :
' * ByVal hBmp As Long
' * ByVal hPal As Long
' **********************************************************************
' * Comments : Creates a bitmap type Picture object from a bitmap
' * and palette
' * hBmp
' * - Handle to a bitmap
' *
' * hPal
' * - Handle to a Palette
' * - Can be null if the bitmap doesn't use a palette
' *
' * Returns
' * - Returns a Picture object containing the bitmap
' *
' *
' **********************************************************************
Dim r As Long
Dim Pic As PicBmp
' *** IPicture requires a reference to "Standard OLE Types"
Dim ipic As IPicture
Dim IID_IDispatch As GUID
' *** Fill in with IDispatch Interface ID
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
' *** Fill Pic with necessary parts
With Pic
.Size = Len(Pic) ' Length of structure
.nType = vbPicTypeBitmap ' Type of Picture (bitmap)
.hBmp = hBmp ' Handle to bitmap
.hPal = hPal ' Handle to palette (may be null)
End With
' *** Create Picture object
r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, ipic)
' *** Return the new Picture object
Set CreateBitmapPicture = ipic
End Function
