VB6之GDI+加载PNG图片

原生的VB6不支持PNG个图片，因为刚有VB的时候还没有PNG的概念呢。不过，利用GDI+加载解析个PNG简直是砍瓜切菜般简单。

GDI+的模块是我在网上下载的，地址应该是：http://vistaswx.com/blog/article/gdip-tutorial-6-image

上代码：

 1 'code by lichmama from cnblogs.com
 2 '@vb6.0 gdi+ png
 3 Private Sub DrawPng(ByVal pngfile As String, _
 4     Optional Left As Long = 0&, _
 5     Optional Top As Long = 0&, _
 6     Optional zoom As Single = 1#)
 7     
 8     Dim Graphic As Long
 9     Dim Image As Long
10     Dim imgWidth As Long
11     Dim imgHeight As Long
12     
13     Call GdipCreateFromHDC(Me.hDC, Graphic)
14     Call GdipSetSmoothingMode(Graphic, SmoothingModeAntiAlias)
15     Call GdipLoadImageFromFile(StrPtr(pngfile), Image)
16     Call GdipGetImageWidth(Image, imgWidth)
17     Call GdipGetImageHeight(Image, imgHeight)
18     Call GdipDrawImageRect(Graphic, Image, 10& + Left, 10& + Top, imgWidth * zoom, imgHeight * zoom)
19     
20     Call GdipDisposeImage(Image)
21     Call GdipDeleteGraphics(Graphic)
22 End Sub
23 
24 Private Sub Command1_Click()
25     Call DrawPng("D:迅雷下载
io-2-icons
io-2-tulio-icon-2.png", -70&, -30&)
26     Call DrawPng("D:迅雷下载
io-2-icons
io-2-linda-icon-2.png", 300&)
27     Call DrawPng("D:迅雷下载
io-2-icons
io-2-logo.png", 250, 250&, 0.5)
28     Call DrawPng("D:迅雷下载
io-2-icons
io-2-kids-icon.png", 225&, 220&, 0.25)
29     Call DrawPng("D:迅雷下载
io-2-icons
io-2-nico-&-pedro-icon.png", 350&, 200&, 0.25)
30     Call DrawPng("D:迅雷下载
io-2-icons
io-2-luiz-icon.png", 625&, 300&, 0.25)
31 End Sub
32 
33 Private Sub Form_Load()
34     Call InitGDIPlus
35 End Sub
36 
37 Private Sub Form_Unload(Cancel As Integer)
38     Call TerminateGDIPlus
39 End Sub

贴张图：

从资源文件加载PNG：

Private Function GdipCreateImageFromStream(ByVal resid As Integer, _
    ByVal restype As String) As Long

    Dim Image As Long
    Dim ResData() As Byte
    Dim IStream As Object
    Dim hGlobal As Long
    Dim pMem As Long
    
    ResData = LoadResData(resid, restype)
    hGlobal = GlobalAlloc(GMEM_MOVEABLE, UBound(ResData) + 1)
    pMem = GlobalLock(hGlobal)
    If pMem = 0 Then
        Debug.Print "Global Alloc Failed."
        Erase ResData
        Exit Function
    End If
    Call RtlMoveMemory(ByVal pMem, ResData(0), UBound(ResData) + 1)
    Call GlobalUnlock(hGlobal)
    Call CreateStreamOnHGlobal(hGlobal, False, IStream)
    Call GdipLoadImageFromStream(IStream, Image)

    Set IStream = Nothing
    Call GlobalFree(hGlobal)
    GdipCreateImageFromStream = Image
End Function

Private Sub Command1_Click()
    Dim Graphics As Long
    Dim Image As Long
    
    Call GdipCreateFromHDC(Me.hDC, Graphics)
    Call GdipSetSmoothingMode(Graphics, SmoothingModeAntiAlias)
    '调用方式如下
    Image = GdipCreateImageFromStream(101, "PNG")
    Call GdipDrawImage(Graphics, Image, 0&, 0&)
    
    Call GdipDisposeImage(Image)
    Call GdipDeleteGraphics(Graphics)
End Sub

贴张图：