求助各位大侠：图片控件里怎样调用网络图片？

boysoft · 发表于 2016-1-29 15:42

求助各位大侠：
如附件，点不同的按钮，指定的图片控件(2种都行)就显示对应单元格里所指网址的图像。

liucqa · 发表于 2016-1-29 18:06

下载图片，把格式转成bmp，然后image加载

小fisher · 发表于 2016-1-29 22:05

本帖最后由小fisher 于 2016-2-1 15:58 编辑

pictures.rar (19.31 KB, 下载次数: 415)
分享一个加载网络图片的通用函数

Option Explicit
'内存函数
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree 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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
'OLE函数
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As Any) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As Any, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
'GDIplus函数
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, ByVal outputbuf As Long) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Private Declare Function GdipLoadImageFromStream Lib "GDIPlus" (ByVal stream As IUnknown, Image As Long) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Const GMEM_MOVEABLE = &H2
Public Function LoadWebImage(url As String) As StdPicture
Dim hMem As Long
Dim nSize As Long
Dim lpData As Long
Dim bufferBytes() As Byte
Dim istm As stdole.IUnknown
Dim lToken As Long
Dim lGSI As GdiplusStartupInput
Dim IID_IDispatch(15) As Byte
Dim pic As PicBmp
Dim lImage As Long, hBmp As Long
Dim httpRequest
Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5.1") '创建WinHttpRequest对象
With httpRequest
.Open "get", url, False '获取URL内容
.Send
If Left(.GetResponseHeader("Content-Type"), 6) = "image/" Then '如果URL为图片
'############nSize = .GetResponseHeader("Content-Length") '获取网络图片的字节长度
'##########ReDim bufferBytes(nSize - 1)
bufferBytes = .ResponseBody '将图片文件存储到字节数组中
nSize = UBound(bufferBytes) + 1 '获取网络图片的字节长度###########
hMem = GlobalAlloc(GMEM_MOVEABLE, nSize) '分配一块全局内存
lpData = GlobalLock(hMem) '获取内存句柄
CopyMemory lpData, VarPtr(bufferBytes(0)), nSize '将图片文件的字节复制到全局内存中
lGSI.GdiplusVersion = 1
If GdiplusStartup(lToken, lGSI, 0) = 0 Then '初始化GDI+
If CreateStreamOnHGlobal(hMem, 1, istm) = 0 Then '从全局内存创建流
GdipLoadImageFromStream istm, lImage '将流中内容加载为GDI+ Image图形对象
GdipCreateHBITMAPFromBitmap lImage, hBmp, &HFFFFFF '从Image获取Bitmap句柄
GdipDisposeImage lImage '释放Image对象
'以下代码从Bitmap句柄生成一个StdPicture对象
CLSIDFromString StrPtr("{00020400-0000-0000-C000-000000000046}"), IID_IDispatch(0)
With pic
.Size = Len(pic)
.Type = 1
.hBmp = hBmp
.hPal = 0
End With
OleCreatePictureIndirect pic, IID_IDispatch(0), 1, LoadWebImage
End If
GdiplusShutdown lToken '关闭GDI+
End If
GlobalUnlock hMem
GlobalFree hMem '释放全局内存
End If
End With
End Function

复制代码

boysoft · 发表于 2016-2-1 10:43

谢谢大神，已给鲜花了

boysoft · 发表于 2016-2-1 11:29

本帖最后由 boysoft 于 2016-2-1 13:29 编辑

小fisher 发表于 2016-1-29 22:05
分享一个加载网络图片的通用函数

普通的网络图片的问题解决了。
我用http://s.jiathis.com/qrcode.php?url=http://club.excelhome.net
生成一个网址的二维码图片，这个程序就会出错。如下图

大侠能否想想办法，解决这个问题

小fisher · 发表于 2016-2-1 16:01

本帖最后由小fisher 于 2016-2-1 16:02 编辑

3楼代码已经修改好了（改动的部分用#####标出），主要是有些图片的ResponseHeader中不包含"Content-Length"字段，现在改为将返回的字节直接赋值给变长数组，通过数组的最大下标获得图片的字节长度注意，3楼附件未更新，使用时请自行修改

boysoft · 发表于 2016-2-1 20:30

小fisher 发表于 2016-2-1 16:01
3楼代码已经修改好了（改动的部分用#####标出），主要是有些图片的ResponseHeader中不包含"Content-Length" ...

太感谢了，把今天的最后一朵鲜花献给您了！真乃高人也

boysoft · 发表于 2016-2-3 15:57

本帖最后由 boysoft 于 2016-2-3 16:04 编辑

小fisher 发表于 2016-2-1 16:01
3楼代码已经修改好了（改动的部分用#####标出），主要是有些图片的ResponseHeader中不包含"Content-Length" ...

大侠：又出现问题了，能否再帮我看看

您修改后的程序运行通过了，但在excel2010中运行又出现以下错误。
点调试，黄色块出现在.send处：

With httpRequest
.Open "get", url, False '获取URL内容
.send

另外：再给我添加一个函数可以吗？要把image控件中的图像保存到文件中。

小fisher · 发表于 2016-2-4 08:54

boysoft 发表于 2016-2-3 15:57
大侠：又出现问题了，能否再帮我看看

您修改后的程序运行通过了，但在excel2010中运行又出现以下错误 ...

这个问题可能与网站有关吧，请把相应的图片网址发过来。
要保存文件，只需要把bufferBytes里的字节以二进制写到指定文件中即可
.... '前面的httpRequest的创建、打开、发送，即3楼代码的第50-54行
bufferBytes = .ResponseBody
Dim iFreeFile As Integer
Open “这里写上要保存的文件名” for Binary as iFreeFile
Put iFreeFile,, bufferBytes
Close iFreeFile

注意，这个代码没检查文件是否已经存在，实际应用时需根据情况添加检查，以免意外覆盖

zengzongfa · 发表于 2016-10-14 16:02

小fisher 发表于 2016-1-29 22:05
分享一个加载网络图片的通用函数

流弊，太强大了

		自动登录	找回密码
密码			免费注册

[求助] 求助各位大侠：图片控件里怎样调用网络图片？

评分

评分

评分