VB读取PNG格式图片解决办法

VB读取PNG格式图片
我想在VB下读取PNG格式图片，比如，一个100*50的图片，然后分析他的像素点

但是VB的图片控件不能直接读取PNG格式的，听说gdiplus.dll可以实现

Dim a As GpStatus
a = GdipLoadImageFromFile("F:\1.png", vbUnicode)

可是a的值确实OutOfMemory，实在没辙

大家有没有什么好的建议，本人菜鸟，只想实现最简单的功能

VB.NET code

Option ExplicitPrivate Type GdiplusStartupInput   GdiplusVersion As Long              ' Must be 1 for GDI+ v1.0, the current version as of this writing.   DebugEventCallback As Long          ' Ignored on free builds   SuppressBackgroundThread As Long    ' FALSE unless you're prepared to call                                       ' the hook/unhook functions properly   SuppressExternalCodecs As Long      ' FALSE unless you want GDI+ only to use                                       ' its internal image codecs.End TypePrivate Enum GpStatus   ' aka Status   Ok = 0   GenericError = 1   InvalidParameter = 2   OutOfMemory = 3   ObjectBusy = 4   InsufficientBuffer = 5   NotImplemented = 6   Win32Error = 7   WrongState = 8   Aborted = 9   FileNotFound = 10   ValueOverflow = 11   AccessDenied = 12   UnknownImageFormat = 13   FontFamilyNotFound = 14   FontStyleNotFound = 15   NotTrueTypeFont = 16   UnsupportedGdiplusVersion = 17   GdiplusNotInitialized = 18   PropertyNotFound = 19   PropertyNotSupported = 20End EnumPrivate Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, outputbuf As Long) As LongPrivate Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As GpStatusPrivate Declare Function GdipDrawImage Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single) As GpStatusPrivate Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, graphics As Long) As GpStatusPrivate Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatusPrivate Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, Image As Long) As GpStatusPrivate Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As GpStatusDim gdip_Token As LongDim gdip_pngImage As LongDim gdip_Graphics As LongPrivate Sub Command1_Click()Dim a As GpStatusa = GdipLoadImageFromFile("F:\1.png", vbUnicode)End SubPrivate Sub Form_Load()Dim GpInput As GdiplusStartupInputGpInput.GdiplusVersion = 1If GdiplusStartup(gdip_Token, GpInput, 0) <> 0 Then    MsgBox "加载GDI+失败！", vbCritical, "加载错误"    EndElse    MsgBox "加载GDI+成功！", vbCritical, "加载成功"End IfEnd Sub

[解决办法]
'添加 Command1 CommonDialog1
'请注意 GDI+不支持长文件名

Option Explicit
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Enum GpStatus
Ok = 0
GenericError = 1
InvalidParameter = 2
OutOfMemory = 3
ObjectBusy = 4
InsufficientBuffer = 5
NotImplemented = 6
Win32Error = 7
WrongState = 8
Aborted = 9
FileNotFound = 10
ValueOverflow = 11
AccessDenied = 12
UnknownImageFormat = 13
FontFamilyNotFound = 14
FontStyleNotFound = 15
NotTrueTypeFont = 16
UnsupportedGdiplusVersion = 17
GdiplusNotInitialized = 18
PropertyNotFound = 19
PropertyNotSupported = 20
End Enum
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus

Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As GpStatus
Private Declare Function GdipDrawImage Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single) As GpStatus
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, graphics As Long) As GpStatus
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, Image As Long) As GpStatus
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As GpStatus
Dim gdip_Token&, gdip_pngImage&, gdip_Graphics&, Picname$
Private Sub Form_Load()
Dim GpInput As GdiplusStartupInput
GpInput.GdiplusVersion = 1
If GdiplusStartup(gdip_Token, GpInput) <> Ok Then MsgBox "GDI初始失败！": Unload Me
Picture1.AutoRedraw = True
If GdipCreateFromHDC(Picture1.hDC, gdip_Graphics) <> Ok Then GdiplusShutdown gdip_Token: Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
GdipDisposeImage gdip_pngImage
GdipDeleteGraphics gdip_Graphics
GdiplusShutdown gdip_Token
End
End Sub

Private Sub Command1_Click()
On Error GoTo errhandler
With CommonDialog1
.CancelError = True
.InitDir =app.path '"e:\pictures\pngpicture"
.Filter = "PNG图片(*.PNG)|*.png"
.ShowOpen
End With
Picname = GetShortName(CommonDialog1.filename)
GdipLoadImageFromFile StrConv(Picname, vbUnicode), gdip_pngImage
If GdipDrawImage(gdip_Graphics, gdip_pngImage, 0, 0) <> Ok Then MsgBox "显示失败"
Picture1.Refresh
errhandler:
If Err > 0 Then Exit Sub
End Sub

Public Function GetShortName(ByVal sLongFileName As String) As String
Dim lRetVal&, sShortPathName$
sShortPathName = Space(255)
Call GetShortPathName(sLongFileName, sShortPathName, 255)
If InStr(sShortPathName, Chr(0)) > 0 Then
GetShortName = Trim(Mid(sShortPathName, 1, InStr(sShortPathName, Chr(0)) - 1))
Else
GetShortName = Trim(sShortPathName)
End If
End Function

查看更多 下一篇