Greg,
I'll try doing it properly and give you all of the code, not piecemeal (I
keep forgetting that you don't have the book yet!)
Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type PICTDESC
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, _
inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0)
As Long
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" ( _
ByVal filename As Long, bitmap As Long) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" ( _
ByVal bitmap As Long, _
hbmReturn As Long, _
ByVal background As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" ( _
ByVal image As Long) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" ( _
ByVal token As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
PicDesc As PICTDESC, _
RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
IPic As IPicture) As Long
Public Function LoadImage(ByVal strFName As String) As IPicture
Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As Long
Dim hGdiImage As Long
Dim hBitmap As Long
uGdiInput.GdiplusVersion = 1
If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
Set LoadImage = ConvertToIPicture(hBitmap)
GdipDisposeImage hGdiImage
End If
GdiplusShutdown hGdiPlus
End If
End Function
Public Function ConvertToIPicture(ByVal hPic As Long) As IPicture
Dim uPicInfo As PICTDESC
Dim IID_IDispatch As GUID
Dim IPic As IPicture
Const PICTYPE_BITMAP = 1
With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
With uPicInfo
.Size = Len(uPicInfo)
.Type = PICTYPE_BITMAP
.hPic = hPic
.hPal = 0
End With
OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
Set ConvertToIPicture = IPic
End Function
--
HTH
Bob
(there's no email, no snail mail, but somewhere should be gmail in my addy)
"Greg Maxey" wrote in message
...
Bob,
Thanks for posting back. I think I am getting close, but still not there.
I added the two functions and changed my callback as shown below. I used
an image located on my hard drive because I know how to identify it with a
string. When I try to run the code, I get and error on this line:
Dim uGdiInput As GdiplusStartupInput
Compile error user defined type not defined.
I assume that I am missing a reference, but don't know which one.
Questions:
What reference do I need to load in the project?
How would I change "C:\Test.pgn" in the callback to represent a file name
that I have already placed in the Open XML File file CustomUI\images
folder?
Thanks.
Sub GetImage(control As IRibbonControl, ByRef image)
Set image = LoadImage("C:\Nose.pgn")
End Sub
Public Function LoadImage(ByVal strFName As String) As IPicture
Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As Long
Dim hGdiImage As Long
Dim hBitmap As Long
uGdiInput.GdiplusVersion = 1
If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
Set LoadImage = ConvertToIPicture(hBitmap)
GdipDisposeImage hGdiImage
End If
GdiplusShutdown hGdiPlus
End If
End Function
Public Function ConvertToIPicture(ByVal hPic As Long) As IPicture
Dim uPicInfo As PICTDESC
Dim IID_IDispatch As GUID
Dim IPic As IPicture
Const PICTYPE_BITMAP = 1
With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
With uPicInfo
.Size = Len(uPicInfo)
.type = PICTYPE_BITMAP
.hPic = hPic
.hpal = 0
End With
OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
Set ConvertToIPicture = IPic
End Function
Bob Phillips wrote:
Oops, you also need the ConvertToPicture procedure
Public Function ConvertToIPicture(ByVal hPic As Long) As IPicture
Dim uPicInfo As PICTDESC
Dim IID_IDispatch As GUID
Dim IPic As IPicture
Const PICTYPE_BITMAP = 1
With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
With uPicInfo
.Size = Len(uPicInfo)
.Type = PICTYPE_BITMAP
.hPic = hPic
.hPal = 0
End With
OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
Set ConvertToIPicture = IPic
End Function
"Bob Phillips" wrote in message
...
Yes it does, an IPicture object.
Public Function LoadImage(ByVal strFName As String) As IPicture
Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As Long
Dim hGdiImage As Long
Dim hBitmap As Long
uGdiInput.GdiplusVersion = 1
If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0
Then GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
Set LoadImage = ConvertToIPicture(hBitmap)
GdipDisposeImage hGdiImage
End If
GdiplusShutdown hGdiPlus
End If
End Function
--
HTH
Bob
(there's no email, no snail mail, but somewhere should be gmail in my
addy)
"Greg Maxey" wrote in
message ...
Bob,
Maybe I should and that looks promising. Unfortunaetly I don't
know how. Based on what you have shown, I assume that there is another
procedure involved name LoadImage. What does it look like? Where
does it go? What I have is a Open Office Format file that I opened in
Office
2007 Custom UI Editor. I used the picture icon on the editor to
load a custom picture named "CustomImage" in the images folder. I
can use this image on a control if I use the attribute
image="CustomImage" I read on one of the many blogs that I have
reviewed over the last
couple days that the getImage callback only accepts a valid office
conrol Id or a IPicture object. Does the LoadImage("CustomImage")
process you suggest have some conversion process to process the
image to a IPicture object? Thanks
Bob Phillips wrote:
Greg,
Shouldn't you be loading it?
Sub GetImage(Control As IRibbonControl, ByRef image)
Select Case Control.ID
Case "gallery1"
image = "ContentControlBuildingBlockGallery"
Case "gallery2"
Set image = LoadImage("CustomeImage" )
Case Else
'Do Nothing
End Select
End Sub
"Greg Maxey" wrote in
message ...
Hi,
First post here. I consider myself a dabbler not a programmer. So if
you can help, please help gently ;-)
Off an on for the past year or so I have been puzzling (sometimes
fretting)
over how to use the ribbon attribute getImage with a VBA callback
to dispaly
a custom image on a Word ribbon control. I have seen code
examples using C+,
.Net, VB, etc., which I don't have and don't know anything about,
that make
me believe that it can be done. When I try a VBA
callback like:
Sub GetImage(Control As IRibbonControl, ByRef image)
Select Case Control.ID
Case "gallery1"
image = "ContentControlBuildingBlockGallery" 'This works
Case "gallery2"
image = "CustomeImage" 'Where "CustomImage" is a png format
image file 'stored in the Open Office File format zip container
images folder. This doesn't work
Case Else
'Do Nothing
End Select
End Sub
Word throws an error stating "CustomImage" is not a valid office
control id.
The key it seems is a process that takes a *.png format image file
and converts it into a IPicture object that Word at least thinks
is a valid office
control id and then displays that image on the ribbon.
I have ordered Ken Puls book RibbonX hoping it will provide a
cookbook explanation of how this is done.
I am awaiting the arrival of the book, but I would certainly
appreciate learning how it is done.
Thanks.
--
Greg Maxey - Word MVP
My web site http://gregmaxey.mvps.org
Word MVP web site http://word.mvps.org
--
Greg Maxey - Word MVP
My web site http://gregmaxey.mvps.org
Word MVP web site http://word.mvps.org
--
Greg Maxey - Word MVP
My web site http://gregmaxey.mvps.org
Word MVP web site http://word.mvps.org