VB and VBA Users Source Code: Controlling the clipboard using API calls (inc. clear, copy and query)
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Controlling the clipboard using API calls (inc. clear, copy and query)
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Wednesday, February 28, 2001
Hits:
1217
Category:
Windows API
Article:
Listed below are a number of useful clipboard API routines. These include routines to open, close and clear the clipboard; plus query/copy information on the clipboard. There is a simple demonstration routine at the bottom of the post which illustrates how to copy text to and from the clipboard. Option Explicit 'Data structures Private Type POINTAPI x As Long y As Long End Type Private Type DROPFILES pFiles As Long pt As POINTAPI fNC As Long fWide As Long End Type 'Global Memory Flags Private Const GMEM_FIXED = &H0 Private Const GMEM_MOVEABLE = &H2 Private Const GMEM_NOCOMPACT = &H10 Private Const GMEM_NODISCARD = &H20 Private Const GMEM_ZEROINIT = &H40 Private Const GMEM_MODIFY = &H80 Private Const GMEM_DISCARDABLE = &H100 Private Const GMEM_NOT_BANKED = &H1000 Private Const GMEM_SHARE = &H2000 Private Const GMEM_DDESHARE = &H2000 Private Const GMEM_NOTIFY = &H4000 Private Const GMEM_LOWER = GMEM_NOT_BANKED Private Const GMEM_VALID_FLAGS = &H7F72 Private Const GMEM_INVALID_HANDLE = &H8000 Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT) Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT) 'Clipboard Formats Private Const CF_TEXT = 1 Private Const CF_BITMAP = 2 Private Const CF_METAFILEPICT = 3 Private Const CF_SYLK = 4 Private Const CF_DIF = 5 Private Const CF_TIFF = 6 Private Const CF_OEMTEXT = 7 Private Const CF_DIB = 8 Private Const CF_PALETTE = 9 Private Const CF_PENDATA = 10 Private Const CF_RIFF = 11 Private Const CF_WAVE = 12 Private Const CF_UNICODETEXT = 13 Private Const CF_ENHMETAFILE = 14 Private Const CF_HDROP = 15 Private Const CF_LOCALE = 16 Private Const CF_MAX = 17 'Clipboard APIs Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function EmptyClipboard Lib "user32" () As Long Private Declare Function SetClipboardData Lib "user32" (ByVal lFormat As Long, ByVal hMem As Long) As Long Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal lFormat As Long) As Long Private Declare Function GetClipboardData 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 GetOpenClipboardWindow Lib "user32" () As Long 'Other APIs (Memory management) Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long Private Declare Function DragQueryPoint Lib "shell32.dll" (ByVal hDrop As Long, lpPoint As POINTAPI) As Long Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long 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 Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long 'Returns a dialogs caption Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long 'Returns Active window handle (use Me.Hwnd in VB) Private Declare Function GetActiveWindow Lib "user32" () As Long 'Purpose : Clears the data stored on the clipboard 'Inputs : N/A 'Outputs : N/A 'Author : Andrew Baker 'Date : 26/02/2001 21:21 'Notes : 'Assumptions : Sub ClipboardClear() Dim lReturn As Long If OpenClipboard(GetActiveWindow) Then 'Opened clipboard 'Empty then close clipboard Call EmptyClipboard Call CloseClipboard End If End Sub 'Purpose : Copies text to the clipboard 'Inputs : sText The text to copy 'Outputs : If the function succeeds, the return value is the handle to the data, else ' the return value is 0. 'Author : Andrew Baker 'Date : 26/02/2001 21:21 'Notes : 'Assumptions : Function ClipboardCopyText(ByVal sText As String) As Long Dim lLenText As Long, lhwndMem As Long, lRet As Long Dim lptrMem As Long sText = sText & vbNullChar lLenText = Len(sText) lhwndMem = GlobalAlloc(GHND, lLenText) If lhwndMem Then 'Copy string into the locked memory. lptrMem = GlobalLock(lhwndMem) lRet = lstrcpy(lptrMem, sText) 'unlocked memory before passing it to clipboard lRet = GlobalUnlock(lhwndMem) 'Open the clipboard If OpenClipboard(&H29550D2C) Then 'Opened clipboard If EmptyClipboard Then 'Emptied clipboard 'Put our text onto the clipboard ClipboardCopyText = SetClipboardData(CF_TEXT, lhwndMem) 'Close the clipboard Call CloseClipboard End If End If End If End Function 'Purpose : Copies file(s) to the clipboard. 'Inputs : asFiles A 1d string array of file path names 'Outputs : Returns True on success 'Author : Andrew Baker 'Date : 26/02/2001 21:21 'Notes : 'Assumptions : Public Function ClipboardCopyFiles(asFiles() As String) As Boolean Dim sData As String Dim tDropFiles As DROPFILES Dim lhwndGlobal As Long Dim lptrGlobal As Long Dim lThisFile As Long 'Open and clear existing crud off clipboard. If OpenClipboard(GetActiveWindow) Then EmptyClipboard 'Build double-null terminated list of asFiles. For lThisFile = LBound(asFiles) To UBound(asFiles) sData = sData & (asFiles(lThisFile) & vbNullChar) Next sData = sData & vbNullChar 'Allocate and get pointer to global memory, 'then copy file list to it. lhwndGlobal = GlobalAlloc(GHND, Len(tDropFiles) + Len(sData)) If lhwndGlobal Then lptrGlobal = GlobalLock(lhwndGlobal) 'Build DROPFILES structure in global memory. tDropFiles.pFiles = Len(tDropFiles) Call CopyMem(ByVal lptrGlobal, tDropFiles, Len(tDropFiles)) Call CopyMem(ByVal (lptrGlobal + Len(tDropFiles)), ByVal sData, Len(sData)) Call GlobalUnlock(lhwndGlobal) 'Copy Data to clipboard, and return success. If SetClipboardData(CF_HDROP, lhwndGlobal) Then ClipboardCopyFiles = True End If End If 'Clean up Call CloseClipboard End If End Function 'Purpose : Copies file(s) from the clipboard. 'Inputs : asFiles See outputs 'Outputs : asFiles A zero based, 1d string array of file path names ' Returns True on success 'Author : Andrew Baker 'Date : 26/02/2001 21:21 'Notes : 'Assumptions : Public Function ClipboardPasteFiles(asFiles() As String) As Long Dim lhwndDrop As Long, lNumFiles As Long, lThisFile As Long Dim sDescription As String, sFilename As String Dim tPos As POINTAPI Const MAX_PATH As Long = 260 If IsClipboardFormatAvailable(CF_HDROP) Then 'Clipboard contains desired format, open clipboard. If OpenClipboard(GetActiveWindow) Then 'Get handle to Dropped Filelist data, and number of asFiles. lhwndDrop = GetClipboardData(CF_HDROP) lNumFiles = DragQueryFile(lhwndDrop, -1&, "", 0) 'Allocate space for return and working variables. ReDim asFiles(0 To lNumFiles - 1) As String sFilename = Space(MAX_PATH) 'Retrieve each Filename in Dropped Filelist. For lThisFile = 0 To lNumFiles - 1 Call DragQueryFile(lhwndDrop, lThisFile, sFilename, Len(sFilename)) asFiles(lThisFile) = zTrimNull(sFilename) Next 'Clean up Call CloseClipboard End If 'Assign return value equal to number of asFiles dropped. ClipboardPasteFiles = lNumFiles End If End Function 'Purpose : Returns a ID for a give custom clipboard format. 'Inputs : sFormatName The name of the custom format 'Outputs : Returns the ID for the custom format 'Author : Andrew Baker 'Date : 26/02/2001 21:21 'Notes : eg. ClipboardGetIDForFormat("HTML Format") 'Assumptions : Function ClipboardGetIDForFormat(ByVal sFormatName As String) As Long Dim lFormat As Long If Right$(sFormatName, 1) <> vbNullChar Then sFormatName = sFormatName & vbNullChar End If lFormat = RegisterClipboardFormat(sFormatName) If (lFormat > &HC000&) Then ClipboardGetIDForFormat = lFormat End If End Function 'Purpose : Returns the data on the clipboard 'Inputs : [lFormat] The format of the data ' [bReturnString] If true the data is returned as a string, ' else data is returned as a byte array 'Outputs : Returns the data in the requested format 'Author : Andrew Baker 'Date : 26/02/2001 21:21 'Notes : 'Assumptions : Function ClipboardGetData(Optional ByVal lFormat As Long = CF_TEXT, Optional bReturnString As Boolean = True) As Variant Dim lhwndMem As Long Dim lSize As Long Dim lPtr As Long Dim abData() As Byte If (OpenClipboard(GetActiveWindow)) Then 'Check if this data format is available: If (IsClipboardFormatAvailable(lFormat) <> 0) Then 'Get the memory handle to the data lhwndMem = GetClipboardData(lFormat) If (lhwndMem <> 0) Then 'Get the size of this memory block lSize = GlobalSize(lhwndMem) If (lSize > 0) Then 'Get a pointer to the locked memory lPtr = GlobalLock(lhwndMem) If (lPtr <> 0) Then 'Resize the byte array to hold the data ReDim abData(0 To lSize - 1) As Byte 'Copy from the pointer into the array CopyMem abData(0), ByVal lPtr, lSize 'Unlock the memory Call GlobalUnlock(lhwndMem) If bReturnString Then 'Return the data as a string ClipboardGetData = StrConv(abData, vbUnicode) If Right$(ClipboardGetData, 1) = vbNullChar Then ClipboardGetData = Left$(ClipboardGetData, Len(ClipboardGetData) - 1) End If Else 'Return the data as a byte array ClipboardGetData = abData End If End If End If End If End If CloseClipboard DoEvents End If End Function 'Support function. 'Trims a string after first null character Private Function zTrimNull(ByVal sValue As String) As String Dim lPosNull As Long lPosNull = InStr(sValue, vbNullChar) If lPosNull Then 'Trim before null character zTrimNull = Left$(sValue, lPosNull - 1) Else zTrimNull = Trim$(sValue) End If End Function 'Purpose : Returns the caption and window handle of the current clipboard owner. 'Inputs : [lHwnd] See Outputs 'Outputs : [lHwnd] The handle of the window that has ownership of the clipboard ' Returns the caption of the window that owns the clipboard. 'Author : Andrew Baker 'Date : 26/02/2001 21:21 'Notes : If the clipboard has been openend using a NULL (or zero) window handle ' when calling the OpenClipboard function, the clipboard is opened but is ' not associated with a window. In this the function will return an empty string. 'Assumptions : Function ClipboardOwner(Optional lHwnd As Long) As String lHwnd = GetOpenClipboardWindow If lHwnd Then ClipboardOwner = DialogGetCaption(lHwnd) End If End Function 'Purpose : Returns the window caption of a specified window. 'Inputs : lHwnd The handle of the window to determine the caption of. 'Outputs : Returns the window caption of a specified window. 'Author : Andrew Baker 'Date : 26/02/2001 21:21 'Notes : 'Assumptions : Function DialogGetCaption(lHwnd As Long) As String Const clMaxLen As Long = 255 Dim lLen As Long, sValue As String * clMaxLen lLen = GetWindowText(lHwnd, sValue, clMaxLen) If lLen Then DialogGetCaption = Left$(sValue, lLen) End If End Function 'Demonstration routine 'PLEASE NOTE: The clipboard will temporarily as soon as OpenClipboard API is called. 'While the clipboard is held open (i.e. until CloseClipboard is called) all copy operations 'which give an "Out of Memory" error and prevent you from copying data to the clipboard. Sub Test() Dim sValue As String sValue = "Andrew" If ClipboardCopyText(sValue) Then 'Copied data to clipboard Debug.Print ClipboardGetData(CF_TEXT, True) Else Debug.Print "Failed to copy text" End If 'Empty the clipboard ClipboardClear If OpenClipboard(GetActiveWindow) Then 'Now get the caption of the window which owns the clipboard (i.e. this app) Debug.Print ClipboardOwner 'Release the clipboard Call CloseClipboard End If End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
