Save image in clipboard directly to a file using API

>>Is there a way to make it accept any image from the clipboard?
What types of images? From what I see at MSDN, standard formats for images only include bitmap/dib and similar.  If formats such as png/gif/jpeg/etc are on the clipboard, they might just be stored as-is and can just be output to file but I have no idea. :-)

I've modified my original example to support rgbquads (palettes) so now it'll retrieve/save 2/16/256 color bitmaps and hopefully correct your problems. It's working fine for different bit-depths copied to clipboard from both mspaint and photoshop (cs2). However, there could be possible errors on some calculations.



Option Explicit

Private Type RGBQUAD
   rgbBlue As Byte
   rgbGreen As Byte
   rgbRed As Byte
   rgbReserved As Byte
End Type

Private Type BITMAPINFOHEADER
   biSize As Long
   biWidth As Long
   biHeight As Long
   biPlanes As Integer
   biBitCount As Integer
   biCompression As Long
   biSizeImage As Long
   biXPelsPerMeter As Long
   biYPelsPerMeter As Long
   biClrUsed As Long
   biClrImportant As Long
End Type

Private Type BITMAPFILEHEADER
   bfType As Integer
   bfSize As Long
   bfReserved1 As Integer
   bfReserved2 As Integer
   bfOffBits As Long
End Type

Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Const CF_DIB As Long = 8
Private Sub Command1_Click()
   If (OpenClipboard(Me.hwnd) <> 0) Then
       If (IsClipboardFormatAvailable(CF_DIB) <> 0) Then
           Dim hDIB As Long
           Dim bi As BITMAPINFOHEADER
           Dim bi_ptr As Long
           Dim bitmapbits_ptr As Long
           Dim bitmapbits() As Byte
           Dim bfh As BITMAPFILEHEADER
           Dim rgbquads() As RGBQUAD
           'get handle to DIB
           hDIB = GetClipboardData(CF_DIB)
           'get pointer to BI structure
           bi_ptr = GlobalLock(hDIB)
           'copy structure locally so we can access it
           Call CopyMemory(bi, ByVal bi_ptr, LenB(bi))
           'determine size of palette (rgbquads) and copy them locally
           Select Case bi.biBitCount
               Case 1  'b/w
                   bi.biClrUsed = 2
               Case 4
                   bi.biClrUsed = 16
               Case 8
                   bi.biClrUsed = 256
               Case Else
                   bi.biClrUsed = 0
           End Select
           If (bi.biClrUsed > 0) Then
               ReDim rgbquads(bi.biClrUsed - 1) As RGBQUAD
               Call CopyMemory(rgbquads(0), ByVal bi_ptr + LenB(bi), (bi.biClrUsed * 4))
           End If
           'get pointer to bitmap bits
           bitmapbits_ptr = bi_ptr + LenB(bi) + (bi.biClrUsed * 4)
           'get size of img
           If (bi.biSizeImage = 0) Then
               bi.biSizeImage = (bi.biWidth * bi.biHeight) * (bi.biBitCount / 8)
           End If
           'get our data
           ReDim bitmapbits(bi.biSizeImage - 1) As Byte
           Call CopyMemory(bitmapbits(0), ByVal bitmapbits_ptr, bi.biSizeImage)
           'write our bmp
           bfh.bfType = &H4D42 'BM
           bfh.bfOffBits = LenB(bfh) + LenB(bi) + (bi.biClrUsed * 4) - 2
           bfh.bfSize = bfh.bfOffBits + bi.biSizeImage

           '//////// just for testing
           Dim f As String
           f = "f:\" & CLng(Timer) & ".bmp"
           Open f For Binary As 1
               'this is the order to save the data but we don't save
               'the rgbquads (palette) for 24/32 bit since they don't
               'have palettes
               Put #1, , bfh
               Put #1, , bi
               If (bi.biClrUsed > 0) Then
                   Put #1, , rgbquads
               End If
               Put #1, , bitmapbits
               
           Close 1
           On Error Resume Next
           Me.Picture1 = LoadPicture(f)
           Kill f
           '//////////////////////////
           
           'cleanup
           Call GlobalUnlock(hDIB)
       End If
       Call CloseClipboard
   End If
End Sub