Loading images with GDI+

Loading images with GDI+ 

http://www.mvps.org/emorcillo/en/code/vb6/loadimagegdip.shtml

Using GDI+ you can load BMP, GIF, TIFF, JPEG and PNG files. This code loads the image and then converts it to a StdPicture object to use it in Visual Basic controls.

 

'  ----==== API Declarations ====----

Private  Type GdiplusStartupInput
   GdiplusVersion 
As   Long
   DebugEventCallback 
As   Long
   SuppressBackgroundThread 
As   Long
   SuppressExternalCodecs 
As   Long
End  Type

Private   Declare   Function GdiplusStartup Lib "GDIPlus" ( _
   token 
As Long, _
   inputbuf 
As GdiplusStartupInput, _
   
Optional ByVal outputbuf As Long = 0As Long

Private Declare Function GdiplusShutdown Lib "GDIPlus" ( _
   
ByVal token As LongAs Long
   
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" ( _
   
ByVal filename As Long, _
   bitmap 
As LongAs Long

Private Declare Function GdipDisposeImage Lib "GDIPlus" ( _
   
ByVal image As LongAs Long

Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" ( _
   
ByVal bitmap As Long, _
   hbmReturn 
As Long, _
   
ByVal background As LongAs Long

Private Type PICTDESC
   cbSizeOfStruct 
As Long
   picType 
As Long
   hgdiObj 
As Long
   hPalOrXYExt 
As Long
End Type

Private Type IID
   Data1 
As Long
   Data2 
As Integer
   Data3 
As Integer
   Data4(
0 To 7)  As Byte
End Type

Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" ( _
   lpPictDesc 
As PICTDESC, _
   riid 
As IID, _
   
ByVal fOwn As Boolean, _
   lplpvObj 
As Object)

'------------------------------------------------------
'
 Procedure : LoadPicturePlus
'
 Purpose   : Loads an image using GDI+
'
 Returns   : The image loaded in a StdPicture object
'
 Author    : Eduardo A. Morcillo
'
------------------------------------------------------
'
Public Function LoadPicturePlus( _
    
ByVal filename As StringAs StdPicture
Dim tSI As GdiplusStartupInput
Dim lGDIP As Long
Dim lRes As Long
Dim lBitmap As Long

   
' Initialize GDI+
   tSI.GdiplusVersion = 1
   lRes 
= GdiplusStartup(lGDIP, tSI)
   
   
If lRes = 0 Then
   
      
' Open the image file
      lRes = GdipCreateBitmapFromFile(StrPtr(filename), lBitmap)
   
      
If lRes = 0 Then
      
         
Dim hBitmap As Long
      
         
' Create a GDI bitmap
         lRes = GdipCreateHBITMAPFromBitmap(lBitmap, hBitmap, 0)
      
         
' Create the StdPicture object
         Set LoadPicturePlus = HandleToPicture(hBitmap, vbPicTypeBitmap)
         
         
' Dispose the image
         GdipDisposeImage lBitmap
      
      
End If
      
      
' Shutdown GDI+
      GdiplusShutdown lGDIP
   
End If
   
   
If lRes Then Err.Raise 5, , "Cannot load file"
   
End Function


'------------------------------------------------------
'
 Procedure : HandleToPicture
'
 Purpose   : Creates a StdPicture object to wrap a GDI
'
             image handle
'
------------------------------------------------------
'
Public Function HandleToPicture( _
   
ByVal hGDIHandle As Long, _
   
ByVal ObjectType As PictureTypeConstants, _
   
Optional ByVal hPal As Long = 0As StdPicture
Dim tPictDesc As PICTDESC
Dim IID_IPicture As IID
Dim oPicture As IPicture
    
   
' Initialize the PICTDESC structure
   With tPictDesc
      .cbSizeOfStruct 
= Len(tPictDesc)
      .picType 
= ObjectType
      .hgdiObj 
= hGDIHandle
      .hPalOrXYExt 
= hPal
   
End With
    
   
' Initialize the IPicture interface ID
   With IID_IPicture
      .Data1 
= &H7BF80981
      .Data2 
= &HBF32
      .Data3 
= &H101A
      .Data4(
0= &H8B
      .Data4(
1= &HBB
      .Data4(
3= &HAA
      .Data4(
5= &H30
      .Data4(
6= &HC
      .Data4(
7= &HAB
   
End With
    
   
' Create the object
   OleCreatePictureIndirect tPictDesc, IID_IPicture, _
                            
True, oPicture
    
   
' Return the picture object
   Set HandleToPicture = oPicture
        
End Function
  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值