IPicture

[Jose Roca]

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.

Code Select Expand


$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...

Code Select Expand


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:

Code Select Expand


  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.

Code Select Expand


' =============================================================================================
' 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:

Code Select Expand


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

OleCreatePictureIndirect:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/com/htm/ofn_oa2k_9y  yc.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.

[Jose Roca]

This is the code needed to create an IFont object.

Code Select Expand


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.