Solved

Save data from clipboard to a file.

Posted on 1998-10-09
3
546 Views
Last Modified: 2013-11-26
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.
0
Comment
Question by:mr_krishna
  • 2
3 Comments
 
LVL 14

Expert Comment

by:waty
ID: 1439039
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

0
 
LVL 12

Expert Comment

by:mark2150
ID: 1439040
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

0
 
LVL 12

Accepted Solution

by:
mark2150 earned 50 total points
ID: 1439041
Did it work?

M
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now