关于VB6中代码显示PNG图片的问题

概述vb6中显示png图片，主要代码来自于帖子 http://www.vbforums.com/showthread.php?509292-RESOLVED-png-files-in-Visual-Basic中的【Using_Ping_In_VB.ZIP】例子。 本人对【Using_Ping_In_VB.ZIP】的代码做了相关修改以适应本人要求。具体代码见下面 1. modGDIPlusResize.

vb6中显示png图片，主要代码来自于帖子

http://www.vbforums.com/showthread.php?509292-RESOLVED-png-files-in-Visual-Basic中的【Using_Ping_In_VB.ZIP】例子。

本人对【Using_Ping_In_VB.ZIP】的代码做了相关修改以适应本人要求。具体代码见下面

1.modGDIPlusResize.bas

Option ExplicitPrivate Type GUID   Data1    As Long   Data2    As Integer   Data3    As Integer   Data4(7) As ByteEnd TypePrivate Type PICTDESC   size     As Long   Type     As Long   hBmp     As Long   hPal     As Long   Reserved As LongEnd TypePrivate Type Gdiplusstartupinput    Gdiplusversion           As Long    DeBUGEventCallback       As Long    SuppressBackgroundThread As Long    SuppressExternalCodecs   As LongEnd TypePrivate Type PWMFRect16    left   As Integer    top    As Integer    Right  As Integer    Bottom As IntegerEnd TypePrivate Type wmfplaceablefileheader    Key         As Long    hMf         As Integer    BoundingBox As PWMFRect16    Inch        As Integer    Reserved    As Long    CheckSum    As IntegerEnd Type' GDI FunctionsPrivate Declare Function CreateCompatibleDC lib "gdi32" (ByVal hDC As Long) As LongPrivate Declare Function oleCreatePictureIndirect lib "olepro32.dll" (PicDesc As PICTDESC,RefIID As GUID,ByVal fPictureOwnsHandle As Long,IPic As IPicture) As LongPrivate Declare Function CreateCompatibleBitmap lib "gdi32" (ByVal hDC As Long,ByVal nWIDth As Long,ByVal nHeight As Long) As LongPrivate Declare Function GetDeviceCaps lib "gdi32" (ByVal hDC As Long,ByVal nIndex As Long) As LongPrivate Declare Function PatBlt lib "gdi32" (ByVal hDC As Long,ByVal x As Long,ByVal y As Long,ByVal nHeight As Long,ByVal DWRop As Long) As LongPrivate Declare Function CreateBitmap lib "gdi32" (ByVal nWIDth As Long,ByVal nPlanes As Long,ByVal nBitCount As Long,lpBits As Any) As LongPrivate Declare Function SelectObject lib "gdi32" (ByVal hDC As Long,ByVal hObject As Long) As LongPrivate Declare Function CreateSolIDBrush lib "gdi32" (ByVal crcolor As Long) As LongPrivate Declare Function DeleteObject lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function DeleteDC lib "gdi32" (ByVal hDC As Long) As Long' GDI+ functionsPrivate Declare Function GdipLoadImageFromfile lib "gdiplus.dll" (ByVal filename As Long,GpImage As Long) As LongPrivate Declare Function Gdiplusstartup lib "gdiplus.dll" (Token As Long,gdipinput As Gdiplusstartupinput,GdiplusstartupOutput As Long) As LongPrivate Declare Function GdipCreateFromHDC lib "gdiplus.dll" (ByVal hDC As Long,GpGraphics As Long) As LongPrivate Declare Function GdipSetInterpolationMode lib "gdiplus.dll" (ByVal Graphics As Long,ByVal InterMode As Long) As LongPrivate Declare Function GdipDrawImageRectI lib "gdiplus.dll" (ByVal Graphics As Long,ByVal img As Long,ByVal WIDth As Long,ByVal Height As Long) As LongPrivate Declare Function GdipDeleteGraphics lib "gdiplus.dll" (ByVal Graphics As Long) As LongPrivate Declare Function GdipdisposeImage lib "gdiplus.dll" (ByVal Image As Long) As LongPrivate Declare Function GdipCreateBitmapFromHBITMAP lib "gdiplus.dll" (ByVal hBmp As Long,ByVal hPal As Long,GpBitmap As Long) As LongPrivate Declare Function GdipGetimageWIDth lib "gdiplus.dll" (ByVal Image As Long,WIDth As Long) As LongPrivate Declare Function GdipGetimageHeight lib "gdiplus.dll" (ByVal Image As Long,Height As Long) As LongPrivate Declare Function GdipCreateMetafileFromWmf lib "gdiplus.dll" (ByVal hWmf As Long,ByVal deleteWmf As Long,Wmfheader As wmfplaceablefileheader,Metafile As Long) As LongPrivate Declare Function GdipCreateMetafileFromEmf lib "gdiplus.dll" (ByVal hEmf As Long,ByVal deleteEmf As Long,Metafile As Long) As LongPrivate Declare Function GdipCreateBitmapFromHICON lib "gdiplus.dll" (ByVal hIcon As Long,GpBitmap As Long) As LongPrivate Declare Function GdipDrawImageRectRectI lib "gdiplus.dll" (ByVal Graphics As Long,ByVal GpImage As Long,ByVal dstx As Long,ByVal dsty As Long,ByVal dstwIDth As Long,ByVal dstheight As Long,ByVal srcx As Long,ByVal srcy As Long,ByVal srcwIDth As Long,ByVal srcheight As Long,ByVal srcUnit As Long,ByVal imageAttributes As Long,ByVal callback As Long,ByVal callbackData As Long) As LongPrivate Declare Sub GdiplusShutdown lib "gdiplus.dll" (ByVal Token As Long)' GDI and GDI+ constantsPrivate Const PLAnes = 14            '  Number of planesPrivate Const BITSPIXEL = 12         '  Number of bits per pixelPrivate Const PATcopY = &HF00021     ' (DWORD) dest = patternPrivate Const PICTYPE_BITMAP = 1     ' Bitmap typePrivate Const InterpolationModeHighQualityBicubic = 7Private Const GDIP_WMF_PLACEABLEKEY = &H9AC6CDD7Private Const UnitPixel = 2' Initialises GDI PlusPublic Function InitGDIPlus() As Long    Dim Token    As Long    Dim gdipInit As Gdiplusstartupinput        gdipInit.Gdiplusversion = 1    Gdiplusstartup Token,gdipInit,ByVal 0&    InitGDIPlus = TokenEnd Function' Frees GDI PlusPublic Sub FreeGDIPlus(Token As Long)    GdiplusShutdown TokenEnd Sub' Loads the picture (optionally resized)Public Function LoadPictureGDIPlus(Picfile As String,Optional WIDth As Long = -1,Optional Height As Long = -1,Optional ByVal Backcolor As Long = vbWhite,Optional RetainRatio As Boolean = False) As IPicture    Dim hDC     As Long    Dim hBitmap As Long    Dim img     As Long            ' Load the image    If GdipLoadImageFromfile(StrPtr(Picfile),img) <> 0 Then        Err.Raise 999,"GDI+ Module","Error loading picture " & Picfile        Exit Function    End If        ' Calculate picture's wIDth and height if not specifIEd    If WIDth = -1 Or Height = -1 Then        GdipGetimageWIDth img,WIDth        GdipGetimageHeight img,Height    End If        ' Initialise the hDC    InitDC hDC,hBitmap,Backcolor,WIDth,Height    ' Resize the picture    gdipResize img,hDC,Height,RetainRatio    GdipdisposeImage img        ' Get the bitmap back    GetBitmap hDC,hBitmap    ' Create the picture    Set LoadPictureGDIPlus = CreatePicture(hBitmap)End Function' Initialises the hDC to drawPrivate Sub InitDC(hDC As Long,hBitmap As Long,Backcolor As Long,WIDth As Long,Height As Long)    Dim hBrush As Long            ' Create a memory DC and select a bitmap into it,fill it in with the backcolor    hDC = CreateCompatibleDC(ByVal 0&)    hBitmap = CreateBitmap(WIDth,GetDeviceCaps(hDC,PLAnes),BITSPIXEL),ByVal 0&)    hBitmap = SelectObject(hDC,hBitmap)    hBrush = CreateSolIDBrush(Backcolor)    hBrush = SelectObject(hDC,hBrush)    PatBlt hDC,PATcopY    DeleteObject SelectObject(hDC,hBrush)End Sub' Resize the picture using GDI plusPrivate Sub gdipResize(img As Long,hDC As Long,Height As Long,Optional RetainRatio As Boolean = False)    Dim Graphics   As Long      ' Graphics Object Pointer    Dim OrWIDth    As Long      ' Original Image WIDth    Dim OrHeight   As Long      ' Original Image Height    Dim OrRatio    As Double    ' Original Image Ratio    Dim DesRatio   As Double    ' Destination rect Ratio    Dim DestX      As Long      ' Destination image X    Dim DestY      As Long      ' Destination image Y    Dim DestWIDth  As Long      ' Destination image WIDth    Dim DestHeight As Long      ' Destination image Height        GdipCreateFromHDC hDC,Graphics    GdipSetInterpolationMode Graphics,InterpolationModeHighQualityBicubic        If RetainRatio Then        GdipGetimageWIDth img,OrWIDth        GdipGetimageHeight img,OrHeight                OrRatio = OrWIDth / OrHeight        DesRatio = WIDth / Height                ' Calculate destination coordinates        DestWIDth = IIf(DesRatio < OrRatio,Height * OrRatio)        DestHeight = IIf(DesRatio < OrRatio,WIDth / OrRatio,Height)'        DestX = (WIDth - DestWIDth) / 2'        DestY = (Height - DestHeight) / 2        DestX = 0        DestY = 0        GdipDrawImageRectRectI Graphics,img,DestX,DestY,DestWIDth,DestHeight,OrWIDth,OrHeight,UnitPixel,0    Else        GdipDrawImageRectI Graphics,Height    End If    GdipDeleteGraphics GraphicsEnd Sub' Replaces the old bitmap of the hDC,Returns the bitmap and Deletes the hDCPrivate Sub GetBitmap(hDC As Long,hBitmap As Long)    hBitmap = SelectObject(hDC,hBitmap)    DeleteDC hDCEnd Sub' Creates a Picture Object from a handle to a bitmapPrivate Function CreatePicture(hBitmap As Long) As IPicture    Dim IID_Idispatch As GUID    Dim Pic           As PICTDESC    Dim IPic          As IPicture        ' Fill in olE Idispatch Interface ID    IID_Idispatch.Data1 = &H20400    IID_Idispatch.Data4(0) = &HC0    IID_Idispatch.Data4(7) = &H46            ' Fill Pic with necessary parts    Pic.size = Len(Pic)        ' Length of structure    Pic.Type = PICTYPE_BITMAP  ' Type of Picture (bitmap)    Pic.hBmp = hBitmap         ' Handle to bitmap    ' Create the picture    oleCreatePictureIndirect Pic,IID_Idispatch,True,IPic    Set CreatePicture = IPicEnd Function' Returns a resized version of the picturePublic Function Resize(Handle As Long,PicType As PictureTypeConstants,Optional Backcolor As Long = vbWhite,Optional RetainRatio As Boolean = False) As IPicture    Dim img       As Long    Dim hDC       As Long    Dim hBitmap   As Long    Dim Wmfheader As wmfplaceablefileheader        ' Determine pictyre type    Select Case PicType    Case vbPicTypeBitmap         GdipCreateBitmapFromHBITMAP Handle,ByVal 0&,img    Case vbPicTypeMetafile         FillinWmfheader Wmfheader,Height         GdipCreateMetafileFromWmf Handle,False,Wmfheader,img    Case vbPicTypeEMetafile         GdipCreateMetafileFromEmf Handle,img    Case vbPicTypeIcon         ' Does not return a valID Image object         GdipCreateBitmapFromHICON Handle,img    End Select        ' Continue with resizing only if we have a valID image object    If img Then        InitDC hDC,Height        gdipResize img,RetainRatio        GdipdisposeImage img        GetBitmap hDC,hBitmap        Set Resize = CreatePicture(hBitmap)    End IfEnd Function' Fills in the wmfplacable headerPrivate Sub FillinWmfheader(Wmfheader As wmfplaceablefileheader,Height As Long)    Wmfheader.BoundingBox.Right = WIDth    Wmfheader.BoundingBox.Bottom = Height    Wmfheader.Inch = 1440    Wmfheader.Key = GDIP_WMF_PLACEABLEKEYEnd Sub

2. 调用Form1.frm

Private Declare Function GetSyscolor lib "user32" (ByVal nIndex As Long) As LongPrivate Sub Command1_Click() Dim Token As Long Dim C As Double  Dim i As Integer     C = Me.Backcolor If C < 0 Then C = GetSyscolor(C - &H80000000) Token = InitGDIPlus  Picture1(0).Picture = LoadPictureGDIPlus(App.Path & ".png",vbWhite) Picture1(1).Picture = LoadPictureGDIPlus(App.Path & ".png",vbCyan) Picture1(2).Picture = LoadPictureGDIPlus(App.Path & ".png",vbGreen) Picture1(3).Picture = LoadPictureGDIPlus(App.Path & ".png",C) FreeGDIPlus TokenEnd Sub

主要代码改动说明

1.Dim C As Long 修改为Dim C As Double (因Long类型数据范围不能满足存储color数据的需要，所以将变量C的数据类型改为Double，以便于存储color数据，如果不做修改，程序在调试时可正常运行，但在编译后运行会出现数据溢出的问题)，long类型与double类型的数据范围可自行查找vb数据类型资料来进行相关比较。

2. Picture1(0).autoSize 属性设计时改为True，当然也可在运行时通过代码实现。(因LoadPictureGDIPlus函数根据png图片的大小来进行透明处理，如果png图片大小比Picture1控件小，那么png图片与Picture1控件之间的区域将不能被透明处理)。有兴趣的朋友可进行相关测试查看效果。

下面为效果图

总结

以上是内存溢出为你收集整理的关于VB6中代码显示PNG图片的问题全部内容，希望文章能够帮你解决关于VB6中代码显示PNG图片的问题所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。