8.4 Adding Additional Formats

only for RuBoard - do not distribute or recompile

8.4 Adding Additional Formats

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
figs/vshl.0804.gif
only for RuBoard - do not distribute or recompile