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.
Any help is well appreciated.
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA"
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 EPredefinedClipboardFormat
[_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 CopyEntirePictureToClipboa
' #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 : CopyEntirePictureToClipboa
' * 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
If (lhDC <> 0) Then
' Create a bitmap compatible with the object we're
' copying from:
lhBmp = CreateCompatibleBitmap(obj
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
CopyEntirePictureToClipboa
Else
CopyEntirePictureToClipboa
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 : GetClipboardIDForCustomFor
' * 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.NewIn
' 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 >= EPredefinedClipboardFormat
' 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(lFo
If (lR <> 0) Then
FormatName = Left$(sBuf, lR)
End If
End If
End Property
Public Function GetClipboardIDForCustomFor
' #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 : GetClipboardIDForCustomFor
' * Parameters :
' * ByVal sName As String
' **************************
' * Comments : Read a custom clipboard format
' *
' *
' **************************
Dim wFormat As Long
wFormat = RegisterClipboardFormat(sN
If (wFormat > &HC000&) Then
GetClipboardIDForCustomFor
End If
End Function
Public Function GetClipboardDataAsString(B
' #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))
' Check if this data format is available:
If (IsClipboardFormatAvailabl
' 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