98 lines
3.1 KiB
QBasic
98 lines
3.1 KiB
QBasic
|
Attribute VB_Name = "z_LoadPictureAPI"
|
|||
|
|
'================ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> GDI =============
|
|||
|
|
' Shared module version: 20210228
|
|||
|
|
' Required reference:
|
|||
|
|
Option Private Module
|
|||
|
|
Option Explicit
|
|||
|
|
|
|||
|
|
'Declare a UDT to store a GUID for the IPicture OLE Interface
|
|||
|
|
Private Type GUID
|
|||
|
|
Data1 As Long
|
|||
|
|
Data2 As Integer
|
|||
|
|
Data3 As Integer
|
|||
|
|
Data4(0 To 7) As Byte
|
|||
|
|
End Type
|
|||
|
|
|
|||
|
|
'Declare a UDT to store the bitmap information
|
|||
|
|
Private Type PictDescriptor
|
|||
|
|
size_ As LongLong
|
|||
|
|
type_ As LongLong
|
|||
|
|
hPic_ As LongPtr
|
|||
|
|
hPal_ As LongLong
|
|||
|
|
End Type
|
|||
|
|
|
|||
|
|
'Declare a UDT to store the GDI+ Startup information
|
|||
|
|
Private Type GdiplusStartupInput
|
|||
|
|
version_ As Long
|
|||
|
|
callback_ As LongPtr
|
|||
|
|
suppBgThread_ As LongLong
|
|||
|
|
suppExtCodecs_ As LongLong
|
|||
|
|
End Type
|
|||
|
|
|
|||
|
|
'Windows API calls into the GDI+ library
|
|||
|
|
Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (pToken As LongPtr, pInputBuf As GdiplusStartupInput, Optional ByVal pOutputBuf As LongPtr = 0) As Long
|
|||
|
|
Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal pFile As LongPtr, pBitmap As LongPtr) As Long
|
|||
|
|
Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal pBitmap As LongPtr, hbmReturn As LongPtr, ByVal pBackground As LongPtr) As Long
|
|||
|
|
Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal pImage As LongPtr) As Long
|
|||
|
|
Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal pToken As LongPtr) As Long
|
|||
|
|
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PictDescriptor, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, iPic As IPicture) As LongPtr
|
|||
|
|
|
|||
|
|
Private Const PICTYPE_BITMAP = 1
|
|||
|
|
|
|||
|
|
' Procedure: LoadPictureGDI
|
|||
|
|
' Purpose: Loads an image using GDI+
|
|||
|
|
' Returns: The image as an IPicture Object
|
|||
|
|
Public Function LoadPictureGDI(ByVal sFileName$) As IPicture
|
|||
|
|
'Initialize GDI+
|
|||
|
|
Dim uGdiInput As GdiplusStartupInput
|
|||
|
|
uGdiInput.version_ = 1
|
|||
|
|
Dim hGdiPlus As LongPtr
|
|||
|
|
Dim lResult&: lResult = GdiplusStartup(hGdiPlus, uGdiInput)
|
|||
|
|
|
|||
|
|
If lResult <> 0 Then _
|
|||
|
|
Exit Function
|
|||
|
|
|
|||
|
|
Dim hGdiImage As LongPtr
|
|||
|
|
If GdipCreateBitmapFromFile(StrPtr(sFileName), hGdiImage) = 0 Then
|
|||
|
|
Dim hBitmap As LongPtr
|
|||
|
|
Call GdipCreateHBITMAPFromBitmap(hGdiImage, hBitmap, 0)
|
|||
|
|
Set LoadPictureGDI = CreateIPicture(hBitmap)
|
|||
|
|
Call GdipDisposeImage(hGdiImage)
|
|||
|
|
End If
|
|||
|
|
|
|||
|
|
Call GdiplusShutdown(hGdiPlus)
|
|||
|
|
End Function
|
|||
|
|
|
|||
|
|
' Procedure: CreateIPicture
|
|||
|
|
' Purpose: Converts a image handle into an IPicture object.
|
|||
|
|
' Returns: The IPicture object
|
|||
|
|
Private Function CreateIPicture(ByVal hPic As LongPtr) As IPicture
|
|||
|
|
Dim IID_IDispatch As GUID
|
|||
|
|
With IID_IDispatch
|
|||
|
|
.Data1 = &H7BF80980
|
|||
|
|
.Data2 = &HBF32
|
|||
|
|
.Data3 = &H101A
|
|||
|
|
.Data4(0) = &H8B
|
|||
|
|
.Data4(1) = &HBB
|
|||
|
|
.Data4(2) = &H0
|
|||
|
|
.Data4(3) = &HAA
|
|||
|
|
.Data4(4) = &H0
|
|||
|
|
.Data4(5) = &H30
|
|||
|
|
.Data4(6) = &HC
|
|||
|
|
.Data4(7) = &HAB
|
|||
|
|
End With
|
|||
|
|
|
|||
|
|
Dim uPicInfo As PictDescriptor
|
|||
|
|
With uPicInfo
|
|||
|
|
.size_ = Len(uPicInfo)
|
|||
|
|
.type_ = PICTYPE_BITMAP
|
|||
|
|
.hPic_ = hPic
|
|||
|
|
.hPal_ = 0
|
|||
|
|
End With
|
|||
|
|
|
|||
|
|
Dim iPic As IPicture
|
|||
|
|
Call OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, iPic)
|
|||
|
|
Set CreateIPicture = iPic
|
|||
|
|
End Function
|
|||
|
|
|