Now that the Visual Designers are beginning to let us to use ActiveX controls, we will need some techniques to use them fully. Two needed objects are IPicture and IFont. I'm going to discuss about IPicture.
ActiveX controls that allow you to set icons or images require that you pass and IPicture object to them, not just the handle of the icon or image. The following code shows how you can create such object with PB.
$IID_IDispatch = GUID$("{00020400-0000-0000-c000-000000000046}")
%PICTYPE_UNINITIALIZED = -1
%PICTYPE_NONE = 0
%PICTYPE_BITMAP = 1
%PICTYPE_METAFILE = 2
%PICTYPE_ICON = 3
%PICTYPE_ENHMETAFILE = 4
type tag_bmp
hbitmap as dword
hpal as dword
end type
type tag_wmf
hmeta as dword
xExt as long
yExt as long
end type
type tag_icon
hicon as dword
end type
type tag_emf
hemf as dword
end type
union u_PictDesc
tbmp as tag_bmp
twmf as tag_wmf
ticon as tag_icon
temf as tag_emf
end union
type PICTDESC
cbSizeOfStruct as dword
picType as dword
u as u_PICTDESC
end type
declare function OleCreatePictureIndirect lib "OLEPRO32.DLL" alias "OleCreatePictureIndirect" ( _
byref pPictDesc as PICTDESC, byref riid as guid, byval fOwn as integer, byref ppvObj as dword) as dword
' =============================================================================================
' Puts the address of an object in a variant and marks it as containing a dispatch variable
' =============================================================================================
FUNCTION MakeDispatchVariant (BYVAL lpObj AS DWORD, BYREF vObj AS VARIANT) AS LONG
LOCAL lpvObj AS VARIANTAPI PTR ' Pointer to a VARIANTAPI structure
LET vObj = EMPTY ' Make sure is empty to avoid memory leaks
IF lpObj = 0 THEN EXIT FUNCTION ' Null pointer
lpvObj = VARPTR(vObj) ' Get the VARIANT address
@lpvObj.vt = %VT_DISPATCH ' Mark it as containing a dispatch variable
@lpvObj.vd.pdispVal = lpObj ' Set the dispatch pointer address
FUNCTION = -1
END FUNCTION
' =============================================================================================
local udtPictDesc as PICTDESC
local hIcon as dword
local ppvObj as dword
local riid as guid
local hr as dword
' Load icon from resource file
hIcon = LoadIcon(GetModuleHandle(""), "MYICON")
if hIcon then
udtPictDesc.cbSizeOfStruct = sizeof(PICTDESC)
udtPictDesc.picType = %PICTYPE_ICON
udtPictDesc.u.ticon.hicon = hIcon
riid = $IID_IDispatch
hr = OleCreatePictureIndirect(udtPictDesc, riid, -1, ppvObj)
end if
If successful, ppvObj will contain the address of the dispatch interface of an IPicture object. Make a dispatch variant from it using the function MakeDispatchVariant and you are ready to pass it to the control.
For example, to set an icon in the print preview window of the UltraGrid control, and assuming that oPv is the object variable that we are using to call the methods and properties of the Print Preview dialog...
local vPic as variant
MakeDispatchVariant(ppvObj, vPic)
object let oPv.PreviewWindowIcon = vPic
vPic = empty
IUnknown_Release ppvObj
This will set our icon in the print preview window of UltraGrid.
If we want to use a bitmap we will use LoadImage:
hBmp = LoadImage(....)
if hBmp then
udtPictDesc.cbSizeOfStruct = sizeof(PICTDESC)
udtPictDesc.picType = %PICTYPE_BITMAP
udtPictDesc.u.tbmp.hbitmap = hBmp
riid = $IID_IDispatch
hr = OleCreatePictureIndirect(udtPictDesc, riid, -1, ppvObj)
end if
To release the IPicture object's interface, use a function like this, passing to it the pointer returned by OleCreatePictureIndirect, e.g. IUnknown_Release ppvObj.
' =============================================================================================
' Helper function to calculate the VTable address.
' =============================================================================================
FUNCTION TB_VTableAddress (BYVAL pthis AS DWORD, BYVAL dwOffset AS DWORD) AS DWORD
LOCAL ppthis AS DWORD PTR
LOCAL pvtbl AS DWORD PTR
LOCAL ppmethod AS DWORD PTR
ppthis = pthis
pvtbl = @ppthis
ppmethod = pvtbl + dwOffset
FUNCTION = @ppmethod
END FUNCTION
' =============================================================================================
' =============================================================================================
' Decrements the reference count for the calling interface on a object. If the reference count
' on the object falls to 0, the object is freed from memory.
' Return Value:
' Returns the resulting value of the reference count, which is used for diagnostic/testing
' purposes only.
' =============================================================================================
FUNCTION IUnknown_Release (BYVAL pthis AS DWORD) AS DWORD
LOCAL HRESULT AS DWORD
LOCAL pmethod AS DWORD
pmethod = TB_VTableAddress (pthis, 8)
CALL DWORD pmethod USING IUnknown_Release (pthis) TO HRESULT
FUNCTION = HRESULT
END FUNCTION
' =============================================================================================
If you want to use PB automation to get/set the properties of this object or call his methods, then declare a dispatch variable and set it:
local oPic as dispatch
local vPic as variant
MakeDispatchVariant(ppvObj, vPic)
set oPic = vPic
vPic = empty
Now, with oPic, you can call methods and properties, e.g. OBJECT GET Pic.Handle to vHandle.
In this case, to release the object you will use SET oPic = NOTHING, instead of IUnknwon_Release ppvObj.
The properties and methods of this object are Handle, hPal, Type, Width, Height, Render, CurDC, SelectPicture, KeepOriginalFormat, ictureChanged, SaveAsFile, GetAttributes, hDC.
Note: The third parameter of OleCreatePictureIndirect has this meaning:
"If TRUE, the picture object is to destroy its picture when the object is destroyed. If FALSE, the caller is responsible for destroying the picture."
Documentation:
PICTDESC structure:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/com/htm/ctst_a2z_53 j7.asp (http://msdn.microsoft.com/library/default.asp?url=/library/en-us/com/htm/ctst_a2z_53j7.asp)
OleCreatePictureIndirect:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/com/htm/ofn_oa2k_9y yc.asp (http://msdn.microsoft.com/library/default.asp?url=/library/en-us/com/htm/ofn_oa2k_9yyc.asp)
PS. I'm going to explore the IFont object and then integrate the code in the FF_COM32.INC file to allow to use it easily.
This is the code needed to create an IFont object.
type FONTDESC
cbSizeOfStruct as dword
lpstrName as dword
cySize as cur
sWeight as integer
sCharset as integer
fItalic as long
fUnderline as long
fStrikethrough as long
end type
declare function OleCreateFontIndirect lib "OLEPRO32.DLL" alias "OleCreateFontIndirect" ( _
byref pFontDesc as FONTDESC, byref riid as guid, byref ppvObj as dword) as dword
local udtFontDesc as FONTDESC
local strFontName as string
local riid as guid
local ppvObj as dword
riid = $IID_IDispatch
strFontName = ucode$("Verdana")
udtFontDesc.cbSizeOfStruct = sizeof(FONTDESC)
udtFontDesc.lpstrName = strptr(strFontName)
udtFontDesc.cySize = 8
udtFontDesc.sWeight = 0
udtFontDesc.sCharset = %ANSI_CHARSET
udtFontDesc.fItalic = 0
udtFontDesc.fUnderline = 0
udtFontDesc.fStrikethrough = 0
OleCreateFontIndirect(udtFontDesc, riid, ppvObj)
Now you have a way to set the fonts and images of an ActiveX control.