VB读取PNG格式图片

[Suese]

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

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

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

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

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

Option Explicit
Private 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 Type
Private 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 = 20
End Enum
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, outputbuf As Long) As Long
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 As Long
Dim gdip_pngImage As Long
Dim gdip_Graphics As Long

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

Private Sub Form_Load()
Dim GpInput As GdiplusStartupInput
GpInput.GdiplusVersion = 1

If GdiplusStartup(gdip_Token, GpInput, 0) <> 0 Then
    MsgBox "加载GDI+失败！", vbCritical, "加载错误"
    End
Else
    MsgBox "加载GDI+成功！", vbCritical, "加载成功"
End If
End Sub

[daisy8675]

mark

[东方之珠]

up

[cbm6666]

'添加 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

[cbm6666]

还要一个 Picture1

[__starGonnaSnow]

Public Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal Filename As Long, imacall As Long) As GpStatus

用的时候 GdipLoadImageFromFile strptr("c:\aaa.png"),img

[duanllll]

sdfsdf

[wq1282]

虽然给出的代码有效且简单，但是显示出来的PNG图片和原来的比例不是1:1的，被放大了。。