8.4 Adding Additional Formats

only for RuBoard - do not distribute or recompile

Since it sounds so easy to add support for bitmaps, let's go ahead and do it. The first thing we want to do is add the bitmap format to the registry. The previous script already has the entry we need:

 [HKEY_CLASSES_ROOT\CLSID\{5BE98B48-FD84-11D2-9FE5-00550076E06F}\DataFormats\GetSet] @ = "2,1,16,3"

As stated earlier, these values correspond to < format , aspect , medium , direction >, in this case CF_BITMAP , DVASPEC

T_CONTENT , TYMED_GDI , and DATADIR_GET OR ed with DATADIR_SET .

Next, we need to modify QueryGetData in order to recognize the new format. When the shell asks if we can provide bitmaps, we need to be able to tell it "yes." Example 8.5 contains the modified version of the method.

Example 8.5. QueryGetData with Bitmap Format Added

 Public Function QueryGetDataVB(ByVal this As IDataObject, _                                pformatetc As FORMATETC) As Long     QueryGetDataVB = DV_E_FORMATETC     'Text     If (pformatetc.cfFormat And CF_TEXT) And _        (pformatetc.dwAspect = DVASPECT_CONTENT) And _        (pformatetc.TYMED = TYMED_HGLOBAL) Then         QueryGetDataVB = S_OK     End If  'Bitmap     If (pformatetc.cfFormat And CF_BITMAP) And _        (pformatetc.dwAspect = DVASPECT_CONTENT) And _        (pformatetc.TYMED = TYMED_GDI) Then         QueryGetDataVB = S_OK     End If  End Function

Good news: we don't have to do a thing with EnumFormatEtc . Everything there is already in place.

This leaves us with GetData . Since we are providing data in two formats now, it might be a good idea to clean up our implementation somewhat. We can move all of the code that deals with the text format into a Private method called GetText . All the code for bitmaps can go into GetBitmap . Now our GetData implementation, which is shown in Example 8.6, is a little more streamlined. We can now add formats without getting in the way of the implementation.

Example 8.6. GetData with Bitmap Support

 Public Function GetDataVB(ByVal this As IDataObject, _                            pformatetcIn As FORMATETC, _                            pmedium As STGMEDIUM) As Long     GetDataVB = DV_E_FORMATETC          If (pformatetcIn.cfFormat And CF_TEXT) And _        (pformatetcIn.dwAspect = DVASPECT_CONTENT) And _        (pformatetcIn.TYMED = TYMED_HGLOBAL) Then              GetDataVB = GetText(this, pmedium)              End If          If (pformatetcIn.cfFormat And CF_BITMAP) And _        (pformatetcIn.dwAspect = DVASPECT_CONTENT) And _        (pformatetcIn.TYMED = TYMED_GDI) Then              GetDataVB = GetBitmap(this, pmedium)              End If      End Function

Of course, now we have to actually provide the data for both of our formats. We'll look at GetText first (see Example 8.7), simply because it makes the chapter more suspenseful that way. Anyway, we have already discussed this code. There is nothing new, other than the fact that its implementation has been moved outside of GetData .

Example 8.7. GetText

 Private Function GetText(ByVal pDataObject As IDataObject, _                           pmedium As STGMEDIUM) As Long     GetText = DV_E_FORMATETC          Dim b(  ) As Byte     Dim dataObj As clsDataHandler     Dim hGlobalMem As HGLOBAL     Dim pGlobalMem As Long     Dim szType As String     Dim szMsg As String          Set dataObj = pDataObject          'Get Animal type.     szType = Space(255)     GetPrivateProfileString "Animal", _                             "Type", _                             "Unknown", _                             szType, _                             Len(szType), _                             dataObj.FileName     'Allocate global memory.     hGlobalMem = GlobalAlloc(GMEM_MOVEABLE, 1024)          'Get a pointer to the global memory.     pGlobalMem = GlobalLock(hGlobalMem)         'Copy Animal type into global memory.     szType = TrimNull(szType)     szMsg = "The " & szType & " is on the clipboard." & vbCrLf          b = StrConv(szMsg, vbFromUnicode) & vbNullChar     CopyMemory ByVal pGlobalMem, b(0), UBound(b) + 1     'Unlock global memory.     GlobalUnlock hGlobalMem          pmedium.pData = hGlobalMem     pmedium.TYMED = TYMED_HGLOBAL     Set pmedium.pUnkForRelease = pDataObject          Set dataObj = Nothing          GetText = S_OK      End Function

Now, the moment we have all been waiting for. Inside of the resource file that contains the icons for our icon handler (Chapter 5) and the dialog for our property sheet extension (Chapter 6), there are five bitmaps. These bitmaps are all pictures of O'Reilly books that have animals on the cover matching our .rad file animal types. The resource identifiers are defined like so:

 Private Const IDB_ARMADILLO = 101 Private Const IDB_CAT = 102 Private Const IDB_COW = 103 Private Const IDB_DOG = 104 Private Const IDB_FISH = 105

Now that you have this bit of background information, we can look at the GetBitmap function. Don't get excited, though. The function is so simple it's almost anti-climatic. Example 8.8 contains the listing.

Example 8.8. GetBitmap

 Private Declare Function LoadBitmap Lib "user32" Alias _      "LoadBitmapA" (ByVal hInstance As Long, _      ByVal lpBitmapName As Long) As Long  Private Function GetBitmap(ByVal pDataObject As IDataObject, _                             pmedium As STGMEDIUM) As Long     GetPicture = DV_E_FORMATETC          Dim dataObj As clsDataHandler     Dim szType As String     Dim lBitmap As Long          Set dataObj = pDataObject          'Get Animal type.     szType = Space(255)     GetPrivateProfileString "Animal", _                             "Type", _                             "Unknown", _                             szType, _                             Len(szType), _                             dataObj.FileName     szType = TrimNull(szType)          Select Case UCase$(szType)         Case "ARMADILLO"             lBitmap = IDB_ARMADILLO         Case "CAT"             lBitmap = IDB_CAT         Case "COW"             lBitmap = IDB_COW         Case "DOG"             lBitmap = IDB_DOG         Case "FISH"             lBitmap = IDB_FISH         Case Else             Exit Function     End Select          pmedium.pData = LoadBitmap(App.hInstance, lBitmap)     pmedium.tymed = TYMED_GDI     Set pmedium.pUnkForRelease = pDataObject           Set dataObj = Nothing          GetPicture = S_OK End Function

GetBitmap 's first duty is to retrieve a reference back to our data object and get the name of the .rad file that has just been copied . Then, based on the type of animal, the local variable lBitmap is assigned to one of the resource identifiers representing the picture of an animal.

Providing the bitmap to the shell is as simple as calling LoadBitmap with the resource identifier of the animal that we want.

It should be mentioned that the declaration of LoadBitmap has been modified somewhat. The datatype of the last parameter has been changed from String to Long in order to allow us to pass the resource identifier to the function. We're not going to talk about why this works. Just know that it does.

Lastly, the tymed member of the STGMEDIUM structure needs to be set to TYMED_GDI in order to inform the shell that the data is a GDI componentin other words, a handle to a bitmap.

Now, we have two formats available for one copy operation. The original text string will be available to any program that can handle CF_TEXT data, and, as Figure 8.4 illustrates, programs that can manipulate CF_BITMAP data are provided for as well.

Figure 8.4. Armadillo data in CF_BITMAP format

only for RuBoard - do not distribute or recompile