Enumerate All Currently Available Clipboard Formats

Category:

Miscellaneous

Type:

Snippets

Difficulty:

Advanced

Author:

Waty

Version Compatibility:

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' #VBIDEUtils#************************************************** ' * Programmer Name : Waty Thierry ' * Web Site : http://www.geocities.com/ResearchTriangle/6311/ ' * E-Mail : waty.thierry@usa.net ' * Date : 25/10/1999 ' * Time : 12:07 ' ************************************************************ ' * Comments: Determine every format available on the clipboard ' * ' * ' *********************************************************** Option Explicit ' Clipboard functions: Private Declare Function OpenClipboard Lib "user32" _ (ByVal hwnd As Long) As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function GetClipboardFormatName Lib "user32" _ Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, _ ByVal lpString As String, ByVal nMaxCount As Long) As Long Private Declare Function EnumClipboardFormats Lib "user32" _ (ByVal wFormat As Long) As Long Public Enum EPredefinedClipboardFormatConstants [_First] = 1 CF_TEXT = 1 CF_BITMAP = 2 CF_METAFILEPICT = 3 CF_SYLK = 4 CF_DIF = 5 CF_TIFF = 6 CF_OEMTEXT = 7 CF_DIB = 8 CF_PALETTE = 9 CF_PENDATA = 10 CF_RIFF = 11 CF_WAVE = 12 CF_UNICODETEXT = 13 CF_ENHMETAFILE = 14 CF_HDROP = 15 CF_LOCALE = 16 CF_MAX = 17 [_Last] = 17 End Enum

Code:

Public Function ClipboardFormats(Formats() As String)

Dim lr As Long
Dim iCtr As Integer

' *** Sample of use
 'Dim sCFs() As String
 'Dim iCtr As Integer

'ClipboardFormats sCFs
 'For iCtr = 0 To UBound(sCFs)
  '   Debug.Print sCFs(iCtr)
 'Next

ReDim Formats(0) As String

If (OpenClipboard(Me.hwnd)) Then
       lr = EnumClipboardFormats(0)
       If (lr <> 0) Then
           Do
            
             lr = EnumClipboardFormats(lr)
             If lr = 0 Then Exit Do
             ReDim Preserve Formats(iCtr) As String
             Formats(iCtr) = FormatName(lr)
             iCtr = iCtr + 1
           Loop
       End If
   End If

CloseClipboard
   
End Function

Private Property Get FormatName(ByVal lFormatID As Long) As _
   String

Dim lSize      As Long
Dim sBuf       As String
Dim lr         As Long

If (lFormatID >= EPredefinedClipboardFormatConstants.[_First] _
 And lFormatID <= EPredefinedClipboardFormatConstants.[_Last]) _
 Then
   ' For pre-defined formats, we have to make the text
   ' up ourselves:
   Select Case lFormatID
      Case CF_TEXT
         FormatName = "Text"
      Case CF_BITMAP
         FormatName = "Bitmap Picture"
      Case CF_METAFILEPICT
         FormatName = "Meta-File Picture"
      Case CF_SYLK
         FormatName = "Microsoft Symbolic Link (SYLK) data."
      Case CF_DIF
      FormatName = "Software Arts' Data Interchange information."
      Case CF_TIFF = 6
         FormatName = "Tagged Image File Format (TIFF) Picture"
      Case CF_OEMTEXT
         FormatName = "Text (OEM)"
      Case CF_DIB
         FormatName = "DIB Bitmap Picture"
      Case CF_PALETTE
         FormatName = "Colour Palette"
      Case CF_PENDATA
         FormatName = "Pen Data"
      Case CF_RIFF
         FormatName = "RIFF Audio data"
      Case CF_WAVE
         FormatName = "Wave File"
      Case CF_UNICODETEXT
         FormatName = "Text (Unicode)"
      Case CF_ENHMETAFILE
         FormatName = "Enhanced Meta-File Picture"
      Case CF_HDROP
         FormatName = "File List"
      Case CF_LOCALE
         FormatName = "Text Locale Identifier"
   End Select
Else
   ' For custom formats, we can ask the Clipboard for
   ' the registered name:
   lSize = 255
   sBuf = String$(lSize, 0)
   lr = GetClipboardFormatName(lFormatID, sBuf, lSize)
   If (lr <> 0) Then
      FormatName = Left$(sBuf, lr)
   End If
End If

End Property