2
要收到賞金，請提供工作代碼的答案。謝謝。如何將stdole.StdPicture轉換爲其他類型？
我有一個類型爲vbPicTypeIcon的stdole.StdPicture對象。我需要將其轉換爲Type vbPicTypeBitmap。由於項目限制，我需要使用Win32或VBA來完成這項工作。我正試圖將文件的圖標加載到命令欄按鈕。這是我到目前爲止。它產生了一個可愛的黑色方塊:)我對圖形領域非常陌生，所以如果這是一個基本問題，請原諒我。
Option Explicit
Private Const vbPicTypeBitmap As Long = 1
Private Const vbPicTypeIcon As Long = 3
Private Const SHGFI_ICON As Long = &H100&
Private Const SHGFI_SMALLICON As Long = &H1&
Private Type PICTDESC
cbSize As Long
pictType As Long
hIcon As Long
hPal As Long
End Type
Private Type typSHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * 260
szTypeName As String * 80
End Type
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Declare Function SHGetFileInfoA Lib "shell32.dll" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As typSHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, ipic As stdole.IPictureDisp) As Long
Public Sub Test()
Dim btn As Office.CommandBarButton
Dim lngRslt As Long
Dim lngAppInstc As Long
Dim strFilePath As String
Dim tFI As typSHFILEINFO
Dim pic As stdole.IPictureDisp
Set btn = TestEnv.GetTestButton
lngAppInstc = Excel.Application.Hinstance
strFilePath = TestEnv.GetTestFile
If LenB(strFilePath) = 0& Then
Err.Raise 70&
End If
SHGetFileInfoA strFilePath, 0&, tFI, LenB(tFI), SHGFI_ICON Or SHGFI_SMALLICON
Set pic = IconToPicture(tFI.hIcon)
btn.Picture = pic
Exit_Proc:
On Error Resume Next
If tFI.hIcon Then
lngRslt = DestroyIcon(tFI.hIcon)
End If
Exit Sub
Err_Hnd:
MsgBox Err.Description, vbCritical Or vbMsgBoxHelpButton, Err.Number, Err.HelpFile, Err.HelpContext
Resume Exit_Proc
Resume
End Sub
Private Function IconToPicture(ByVal hIcon As Long) As stdole.IPictureDisp
'Modified from code by Francesco Balena on DevX
Dim pic As PICTDESC
Dim guid(0 To 3) As Long
Dim pRtnVal As stdole.IPictureDisp
pic.cbSize = LenB(pic)
'pic.pictType = vbPicTypeBitmap
pic.pictType = vbPicTypeIcon
pic.hIcon = hIcon
' this is the IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
' we use an array of Long to initialize it faster
guid(0) = &H7BF80980
guid(1) = &H101ABF32
guid(2) = &HAA00BB8B
guid(3) = &HAB0C3000
' create the picture,
' return an object reference right into the function result
OleCreatePictureIndirect pic, guid(0), True, pRtnVal
Set IconToPicture = pRtnVal
End Function
我下面的代碼，在需要時清理，只使用API和不正是你想要的。樣本中只有一個表格和一個圖片框才能證明其有效。 – jac
嗨Beaner，有很多編輯，所以你可能錯過了它。但解決方案必須在VBA中工作。 VBA沒有優化校準。不幸的是我爲什麼要問這個問題:)抱歉有任何混淆。 – Oorang
您可能錯過了它，但picturebox不再是轉換的一部分。我將它放在那裏以顯示示例中的轉換圖像。就像我說的，我沒有時間清理代碼。現在它已經被清理了一些，我完全刪除了picturebox以消除混淆。轉換是所有WinAPI – jac