VB如何用IPicture 来显示图片?

[gdcyx]

VB如何用IPicture 来显示图片?

[Hotus]

picture1.picture=loadpicture("c:\1.bmp")

[gdcyx]

1.引用olelib.tlb
2.模块中贴入下面代码：
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Const PictureID = &H746C&
Private Type PictureHeader
Magic As Long
Size As Long
End Type

Public Function Array2Picture(aBytes() As Byte) As IPicture
Dim oIPS As IPersistStream
Dim oStream As IStream
Dim hGlobal As Long
Dim LPTR As Long
Dim lSize As Long
Dim Hdr As PictureHeader



lSize = UBound(aBytes) - LBound(aBytes) + 1
hGlobal = GlobalAlloc(GHND, lSize + Len(Hdr))
If hGlobal Then
LPTR = GlobalLock(hGlobal)
Hdr.Magic = PictureID
Hdr.Size = lSize
MoveMemory ByVal LPTR, Hdr, Len(Hdr)
MoveMemory ByVal LPTR + Len(Hdr), aBytes(0), lSize
GlobalUnlock hGlobal

Set oStream = CreateStreamOnHGlobal(hGlobal, True)
Set Array2Picture = New StdPicture
Set oIPS = Array2Picture
oIPS.Load oStream
Set oStream = Nothing

End If
End Function

3.用Array2Picture函数把字节流转换成图片

我在数组里的是一个PNG格式的图片,调用上述方法后出现Automation error Catastrophic failure 的错误,
数组内容:
89 50 4E 47 0D 0A 1A 0A 00 00 00 0D 49 48 44 52 00 00 00 82 00 00 00 35 04 03 00 00 00 7F E2 2E 03 00 00 00 30 50 4C 54 45 FF FF FF EF EF EF 5F 5F 5F 8F 8F 8F BF BF BF 0F 0F 0F 3F 3F 3F 7F 7F 7F CF CF CF 2F 2F 2F DF DF DF 1F 1F 1F 65 9F 9F AF AF AF 4F 4F 4F 6F 6F 6F 03 A7 70 12 00 00 03 FB 49 44 41 54 78 9C ED 55 4D 88 5B 55 14 3E F9 6D 7E 67 B2 30 D0 D1 85 81 1A 5C 09 59 98 8D A0 04 64 16 0A 82 93 F8 A5 93 BC C9 8F E2 B3 42 15 06 71 FC 43 CA 74 11 CA 2C C4 F1 E7 0D 4A BB 88 E2 40 45 C4 5A 88 2B 7F 22 38 85 4A D5 D8 12 AA 2E 74 36 41 4A 45 67 13 50 91 C1 73 EE 7D EF E5 E5 39 A3 D0 A5 CC 59 BC 7B EF B9 E7 7C E7 FF 3E A2 03 3A A0 FF A4 CC 0D EA 1D 99 3F B6 F6 82 6C DE CB DD 88 3A F0 11 84 E8 9D 4B DF 15 1F DC 53 24 71 F5 5A 0F C6 23 85 BD EE DE 3F 71 9A 95 AF 02 26 7A 02 D3 D8 4B E8 B2 BA 02 1E DA E3 2E A9 8C 9F A5 D1 A9 14 1B 31 81 26 85 BF F4 C9 A4 47 A8 1D B9 3F 43 89 97 50 7D CE 0F 90 CE BF 7A E7 5B 7A 9B 6F 7E A3 EC 64 42 A8 FE B5 EA 91 79 19 B8 C3 CE EF 09 B6 36 4D 3F 96 BF 75 B6 73 18 50 8A 7D 40 9F DE E5 EF 2B AE CC 45 94 4B EE 21 86 CF 2E 3D 75 7C C9 3D 8E E1 E6 2D 60 2D 6A 0E DA B1 18 8C AF 0A 13 99 27 BC 36 9F 61 74 A3 EF 9C 22 B8 CD BD 89 42 B3 2F A0 B6 32 C3 C9 10 FA 35 43 4B 26 7E 77 65 C2 BF 48 4C 16 3E 74 18 A9 8D AD 09 76 B1 66 6F 3A 92 8B AA EC D2 58 25 18 7F F2 EE F0 95 5D 8B 97 59 43 DB 7D DC 51 6A AD 4E 00 02 A8 38 86 CA EC A8 82 4B 62 10 6C 7D 8F 4F 5F E4 52 1A 4F 33 23 AE FC 8C 61 3A 2E 61 9D 24 3A 84 FA 84 11 B6 94 B1 22 0A 69 A2 35 F6 A8 A7 6F 23 58 97 05 17 E0 35 2E CA 78 2D 70 0B BC BD 38 86 72 0B 3B 02 87 33 27 E7 74 9F 75 D4 12 A8 72 7D 6B 77 79 C4 CD D7 0F 8F 37 7A 1A DE A6 15 70 FD 83 06 B6 79 1F AA 0A 4A 53 3B 25 D1 C5 5A 24 65 3F E6 BA 11 42 97 73 66 4D 21 14 99 47 9D 5D C5 4B 4A 95 2D 61 50 7E 84 12 27 58 BA 21 F1 3C F0 B3 2D 1D 95 98 F3 53 08 61 53 24 8F DF AA 22 DB CA C9 47 05 B4 D1 41 9B A3 5E 54 42 A7 4C A7 3D 93 E2 F1 BC E9 C9 C3 65 2E E7 80 4D 85 54 FE AC AE CA A1 5C B7 A2 32 5A 41 47 F2 5E 7B 8D E3 61 A2 AC 89 05 FB 9C CE A3 B6 85 02 C5 D7 D3 22 9F 6E 09 73 16 EC 7A B8 A1 F2 11 3D 47 D3 94 82 31 A0 D8 08 DA B7 C0 D7 EC C0 42

如何解决?

[li_net]

顶一下

[kxyzjm]

顶

[hpygzhx520]

Dim RenICO As IPicture
Set RenICO = LoadResPicture(200, vbResIcon)'假设从资源文件提取
set picture1.picture=renico

[tianhuo_soft]

Dim P_ICO As IPicture
Set P_ICO = LoadResPicture(200, vbResIcon)
set pit1.picture=P_ICO

[power9908]

学习了！

[嗷嗷叫的老马]

踢老魏一脚~~~~~

[迈克揉索芙特]

貌似VB的IPicture不支持PNG格式的图片,两种方法：
1.转换格式
2.用GDI+

[gdcyx]

能给出代码吗？

[eslbs]

将StdPicture写入Byte数组及读出
'--------------------------------------------------------
' Procedure : SaveImage
' Purpose : Saves a StdPicture object in a byte array.
'--------------------------------------------------------
'
Public Function SaveImage( _
ByVal image As StdPicture) As Byte()
Dim abData() As Byte
Dim oPersist As IPersistStream
Dim oStream As IStream
Dim lSize As Long
Dim tStat As STATSTG

' Get the image IPersistStream interface
Set oPersist = image

' Create a stream on global memory
Set oStream = CreateStreamOnHGlobal(0, True)

' Save the picture in the stream
oPersist.Save oStream, True

' Get the stream info
oStream.Stat tStat, STATFLAG_NONAME

' Get the stream size
lSize = tStat.cbSize * 10000

' Initialize the array
ReDim abData(0 To lSize - 1)

' Move the stream position to
' the start of the stream
oStream.Seek 0, STREAM_SEEK_SET

' Read all the stream in the array
oStream.Read abData(0), lSize

' Return the array
SaveImage = abData

' Release the stream object
Set oStream = Nothing

End Function

'--------------------------------------------------------
' Procedure : LoadImage
' Purpose : Creates a StdPicture object from a byte array.
'--------------------------------------------------------
'
Public Function LoadImage( _
ImageBytes() As Byte) As StdPicture
Dim oPersist As IPersistStream
Dim oStream As IStream
Dim lSize As Long

' Calculate the array size
lSize = UBound(ImageBytes) - LBound(ImageBytes) + 1

' Create a stream object
' in global memory
Set oStream = CreateStreamOnHGlobal(0, True)

' Write the header to the stream
oStream.Write &H746C&, 4&

' Write the array size
oStream.Write lSize, 4&

' Write the image data
oStream.Write ImageBytes(LBound(ImageBytes)), lSize

' Move the stream position to
' the start of the stream
oStream.Seek 0, STREAM_SEEK_SET

' Create a new empty picture object
Set LoadImage = New StdPicture

' Get the IPersistStream interface
' of the picture object
Set oPersist = LoadImage

' Load the picture from the stream
oPersist.Load oStream

' Release the streamobject
Set oStream = Nothing

End Function

[eslbs]

http://cnzx219.spaces.live.com/blog/cns!b181744d93a2b752!118.entry

[redloveqq]

picture1.picture=loadpicture("D:\1.bmp")
D:\1.bmp 图片存放的路径

[gdcyx]

我要显示的是PNG格式的图片

[eslbs]

15楼的代码错误太多了

下面这个可以运行

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, 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 As Long
Dim gdip_pngImage As Long
Dim gdip_Graphics As Long

Private Sub Form_Activate()
If GdipCreateFromHDC(Me.hDC, gdip_Graphics) <> Ok Then
MsgBox "出现错误！", vbCritical, "错误"
GdiplusShutdown gdip_Token
End
End If

GdipLoadImageFromFile StrConv("C:\Show.png", vbUnicode), gdip_pngImage '加载文件
End Sub

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

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

Private Sub Form_Paint()
If GdipDrawImage(gdip_Graphics, gdip_pngImage, 0, 0) <> Ok Then Debug.Print "显示失败。。。"
End Sub

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

http://cache.baidu.com/c?word=gdiploadimagefromfile&url=http%3A//post%2Ebaidu%2Ecom/f%3Fkz%3D214574476&p=c27bd015d9c159fc57ee91275451&user=baidu

[迈克揉索芙特]

vb 如何使用 PNG 透明格式的图片
Private Declare Function GdiplusStartup Lib "gdiplus.dll" ( _
ByRef token As Long, _
ByRef inputX As GdiplusStartupInput, _
ByVal Output As Long _
) As Status

Private Declare Sub GdiplusShutdown Lib "gdiplus.dll" (ByVal token As Long)

Private Declare Function GdipCreateFromHDC Lib "gdiplus.dll" ( _
ByVal hdc As Long, ByRef graphics As Long _
) As Status


Private Declare Function GdipDrawImage Lib "gdiplus.dll" ( _
ByVal graphics As Long, ByVal Image As Long, _
ByVal X As Single, ByVal Y As Single _
) As Status



Private Declare Function GdipLoadImageFromFile Lib "gdiplus.dll" ( _
ByVal FileName As Long, ByRef Image As Long _
) As Status

Private Declare Function GdipDisposeImage Lib "gdiplus.dll" _
(ByVal Image As Long) As Status

需要声明的结构：

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

具体做法如下：

Dim m_lngGraphics as long
Dim m_lngInstance as long
Dim m_lngPic as long

Private Sub Form_Load() 'GDI+初始化
Dim udtData As GdiplusStartupInput

Randomize

udtData.GdiplusVersion = 1

If GdiplusStartup(app.hInstance, udtData, 0) Then
MsgBox "GDI+ could not be initialized", vbCritical
Exit Sub
End If

If GdipCreateFromHDC(Me.hdc, m_lngGraphics) Then
MsgBox "Graphics object could not be created", vbCritical
Exit Sub
End If

GdipLoadimagefromfile "c:\1.png" , m_lngPic
GdipImageDraw m_lngGraphics,m_lngPic
End Sub

[gdcyx]

我的图片是存在数组里的，上述方法只能从文件读取，如何从数组里读书？

[awperpvip]

xuexi

[东方之珠]

从其他映象中取得:

Dim RenICO As IPicture
Set RenICO = Image1.Picture
Set picture1.picture=renico

[eslbs]

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, 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 As Long
Dim gdip_pngImage As Long
Dim gdip_Graphics As Long


Private Sub Form_Activate()
If GdipCreateFromHDC(Me.hDC, gdip_Graphics) <> Ok Then
MsgBox "出现错误！", vbCritical, "错误"
GdiplusShutdown gdip_Token
End
End If

Dim oStream As IStream
Dim ImageBytes() As Byte
Dim filename As String
filename = App.Path & "\test.png"
Open filename For Binary Access Read As #1
ReDim ImageBytes(LOF(1) - 1)
Get #1, , ImageBytes
Close #1
CreateStreamOnHGlobal ImageBytes(0), True, oStream
Dim iStatus As GpStatus '
iStatus = GdipLoadImageFromStream(oStream, gdip_pngImage) '加载文件
Set oStream = Nothing

'GdipLoadImageFromFile StrConv(App.Path & "\test.png", vbUnicode), gdip_pngImage '加载文件
End Sub

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

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

Private Sub Form_Paint()
If GdipDrawImage(gdip_Graphics, gdip_pngImage, 0, 0) <> Ok Then Debug.Print "显示失败。。。"
End Sub

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

15楼的方法修改了一下 可以加载png数组了。
不过需要楼主下载一个 gdi+.tlb