|
|
首先谢谢各位大侠~~ 各位大侠，有一个模块代码，可实现在图片控件中显示excel表单元格中的网络地址对应的网络图片，在家里的32位excel中可用，到公司的64位系统就报错，提示：若要在64位系统上使用，请检查并更新Declare 语句，然后用 PtrSafe 属性标记它们。
我查找了站内相关问题， 解决方案是：
1.API的声明部分修改 参见版主@zhaogang1960 在2楼的回复 http://club.excelhome.net/thread-1097656-1-1.html，
我直接将Declare 改成 Declare PtrSafe。
2.此时出现错误： 类型不匹配
看答案知道是：调用API的时候定义变量时修改下，但是我不是很懂vb，不知道要修改哪些变量，希望看到的大神帮忙修改下，谢谢！
模块代码如下：
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 '将图片文件存储到字节数组中
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
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2017-3-18 14:23
楼主
