Link to home
Start Free TrialLog in
Avatar of mr_krishna
mr_krishna

asked on

Save data from clipboard to a file.

My BMP is in Clipboard. I want to save it in a file. But i am unable to do it. Is there anyway to save an clipboard data into a stand alone file.
Any help is well appreciated.
Avatar of waty
waty
Flag of Belgium image

Here are some functions to handle the clipboard :

Use particularly : GetClipboardDataAsString, modify a little bit to save to a file

' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 7/10/98
' * Time             : 16:59
' * Module Name      : Clipboard_Module
' * Module Filename  : Clipboard.bas
' **********************************************************************
' * Comments         : Clipboard functions
' *
' *
' **********************************************************************

Option Explicit

' General functions:
Private Type RECT
   Left     As Long
   Top      As Long
   Right    As Long
   Bottom   As Long
End Type

' GDI functions:
Private Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

' Creates a memory DC
Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long

' Creates a bitmap in memory:
Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

' Places a GDI Object into DC, returning the previous one:
Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As Long

' Deletes a GDI Object:
Declare Function DeleteObject Lib "GDI32" (ByVal hObject As Long) As Long

' 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 SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) 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 EmptyClipboard Lib "user32" () As Long
Private Declare Function CountClipboardFormats Lib "user32" () As Long
Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long

' Memory functions:
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy 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

Public Function CopyEntirePictureToClipboard(ByRef objFrom As Object) As Boolean
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 7/10/98
   ' * Time             : 16:59
   ' * Module Name      : Clipboard_Module
   ' * Module Filename  : Clipboard.bas
   ' * Procedure Name   : CopyEntirePictureToClipboard
   ' * Parameters       :
   ' *                    ByRef objFrom As Object
   ' **********************************************************************
   ' * Comments         : Copy the entire contents of a PictureBox to the clipboard
   ' *
   ' *
   ' **********************************************************************
   
   Dim lhDC       As Long
   Dim lhBmp      As Long
   Dim lhBmpOld   As Long

   ' Create a DC compatible with the object we're copying
   ' from:
   lhDC = CreateCompatibleDC(objFrom.hDC)
   If (lhDC <> 0) Then
      ' Create a bitmap compatible with the object we're
      ' copying from:
      lhBmp = CreateCompatibleBitmap(objFrom.hDC, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY)
      If (lhBmp <> 0) Then
         ' Select the bitmap into the DC we have created,
         ' and store the old bitmap that was there:
         lhBmpOld = SelectObject(lhDC, lhBmp)

         ' Copy the contents of objFrom to the bitmap:
         BitBlt lhDC, 0, 0, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY, objFrom.hDC, 0, 0, SRCCOPY

         ' Remove the bitmap from the DC:
         SelectObject lhDC, lhBmpOld

         ' Now set the clipboard to the bitmap:
         EmptyClipboard
         OpenClipboard 0
         SetClipboardData CF_BITMAP, lhBmp
         CloseClipboard

         ' We don't delete the Bitmap here - it is now owned
         ' by the clipboard and Windows will delete it for us
         ' when the clipboard changes or the program exits.
      End If

      ' Clear up the device context we created:
      DeleteObject lhDC
     
      CopyEntirePictureToClipboard = True
     
   Else
      CopyEntirePictureToClipboard = False
     
   End If

End Function

Private Property Get FormatName(ByVal lFormatID As Long) As String
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 7/10/98
   ' * Time             : 17:00
   ' * Module Name      : Clipboard_Module
   ' * Module Filename  : Clipboard.bas
   ' * Procedure Name   : GetClipboardIDForCustomFormat
   ' * Parameters       :
   ' *                    ByVal sName As String
   ' **********************************************************************
   ' * Comments         : Determine every format available on the clipboard,
   ' * including custom formats
   ' * Returns the format name for a clipboard format id:
   ' *
   ' **********************************************************************
   
   
   ' *** Sample of use
   'Private Sub Command1_Click()
   'Dim lR As Long
   'Dim iCount As Long
   '
   '    List1.Clear
   '
   '    If (OpenClipboard(Me.hWnd)) Then
   '        lR = EnumClipboardFormats(0)
   '        If (lR <> 0) Then
   '            Do
   '                iCount = iCount + 1
   '                List1.AddItem FormatName(lR)
   '                List1.ItemData(List1.NewIndex) = lR
   '                lR = EnumClipboardFormats(lR)
   '            Loop While lR <> 0
   '        End If
   '    End If
   '    CloseClipboard
   '
   'End Sub

   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

Public Function GetClipboardIDForCustomFormat(ByVal sName As String) As Long
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 7/10/98
   ' * Time             : 17:00
   ' * Module Name      : Clipboard_Module
   ' * Module Filename  : Clipboard.bas
   ' * Procedure Name   : GetClipboardIDForCustomFormat
   ' * Parameters       :
   ' *                    ByVal sName As String
   ' **********************************************************************
   ' * Comments         : Read a custom clipboard format
   ' *
   ' *
   ' **********************************************************************

   Dim wFormat    As Long
   
   wFormat = RegisterClipboardFormat(sName & Chr$(0))
   If (wFormat > &HC000&) Then
      GetClipboardIDForCustomFormat = wFormat
   End If

End Function

Public Function GetClipboardDataAsString(ByVal hwndOwner As Long, ByVal lFormatID As Long) As String
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 7/10/98
   ' * Time             : 17:00
   ' * Module Name      : Clipboard_Module
   ' * Module Filename  : Clipboard.bas
   ' * Procedure Name   : GetClipboardDataAsString
   ' * Parameters       :
   ' *                    ByVal hwndOwner As Long
   ' *                    ByVal lFormatID As Long
   ' **********************************************************************
   ' * Comments         : Get from clipboard a custom format
   ' *
   ' *
   ' **********************************************************************

   Dim bData()    As Byte
   Dim hMem       As Long
   Dim lSize      As Long
   Dim lPtr       As Long

   ' Open the clipboard for access:
   If (OpenClipboard(hwndOwner)) Then
      ' Check if this data format is available:
      If (IsClipboardFormatAvailable(lFormatID) <> 0) Then
         ' Get the memory handle to the data:
         hMem = GetClipboardData(lFormatID)
         If (hMem <> 0) Then
            ' Get the size of this memory block:
            lSize = GlobalSize(hMem)
            If (lSize > 0) Then
               ' Get a pointer to the memory:
               lPtr = GlobalLock(hMem)
               If (lPtr <> 0) Then
                  ' Resize the byte array to hold the data:
                  ReDim bData(0 To lSize - 1) As Byte
                  ' Copy from the pointer into the array:
                  CopyMemory bData(0), ByVal lPtr, lSize
                  ' Unlock the memory block:
                  GlobalUnlock hMem

                  ' Now return the data as a string:
                  GetClipboardDataAsString = StrConv(bData, vbUnicode)

               End If
            End If
         End If
      End If
      CloseClipboard
   End If

End Function

Avatar of mark2150
mark2150

There is a *much* simpler method. Have an *invisible* picture object on your form. Have it AutoSize = True, AutoRedraw = True, Visible = False

Paste from the clipboard to the invisible object and then save to file from there. There is no direct save clipboard method:

Picture1.Picture = Clipboard.GetData()
SavePicture Picture1.Image, "C:\dummy.bmp"

This code was tested and works. Is *MUCH* simpler than WATY's method.

M

ASKER CERTIFIED SOLUTION
Avatar of mark2150
mark2150

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial