[AccessD] copy string to clipboard

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of John W. Colby
Sent: Thursday, August 18, 2005 11:00 AM
To: 'Access Developers discussion and problem solving'
Subject: RE: [AccessD] copy string to clipboard


Where is the matching ClipGetText?

John W. Colby
www.ColbyConsulting.com 

------------------------
It's another simple API call...

Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As
Long) As Long

I've even got a simple class to take care of text to and from the clipboard
<g>

'*************************** clsClipBoard *************

Option Compare Database
Option Explicit



' Obtaining Clipboard Data using API
' (needed for VBA since no Clipboard Object) -- can also paste the data to a
control
' *************************************************************

' ******* Place following in declarations *********
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As
Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As
Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As
Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal
dwBytes 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 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

Const GHND = &H42
Const CF_TEXT = 1
Const MAXSIZE = 4096

Function GetTextData() As String
   Dim hClipMemory As Long
   Dim lpClipMemory As Long
   Dim MyString As String
   Dim RetVal As Long

   If OpenClipboard(0&) = 0 Then
      MsgBox "Cannot open Clipboard. Another app. may have it open", ,
"Clipboard"

      Exit Function
   End If

   ' Obtain the handle to the global memory
   ' block that is referencing the text.
   hClipMemory = GetClipboardData(CF_TEXT)
   If IsNull(hClipMemory) Then
      MsgBox "Could not allocate memory", , "Clipboard"
   Else
   
      ' Lock Clipboard memory so we can reference
      ' the actual data string.
      lpClipMemory = GlobalLock(hClipMemory)
   
      If Not IsNull(lpClipMemory) Then
   
         MyString = SPACE$(MAXSIZE)
         RetVal = lstrcpy(MyString, lpClipMemory)
         RetVal = GlobalUnlock(hClipMemory)
   
         ' Peel off the null terminating character.
         MyString = uMid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
      Else
         MsgBox "Could not lock memory to copy string from.", , "Clipboard"
      End If
   
   End If

   RetVal = CloseClipboard()
   GetTextData = MyString

End Function

Sub SetTextData(MyString As String)
   Dim hGlobalMemory As Long, lpGlobalMemory As Long
   Dim hClipMemory As Long, x As Long

   ' Allocate movable global memory.
   '-------------------------------------------
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

   ' Lock the block to get a far pointer
   ' to this memory.
   lpGlobalMemory = GlobalLock(hGlobalMemory)

   ' Copy the string to this global memory.
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

   ' Unlock the memory.
   If GlobalUnlock(hGlobalMemory) <> 0 Then
      MsgBox "Could not unlock memory location. Copy aborted.", ,
"Clipboard"
   Else
      ' Open the Clipboard to copy data to.
      If OpenClipboard(0&) = 0 Then
         MsgBox "Could not open the Clipboard. Copy aborted.", , "Clipboard"
         Exit Sub
      End If
   
      ' Clear the Clipboard.
      x = EmptyClipboard()
   
      ' Copy the data to the Clipboard.
      hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
   End If

   If CloseClipboard() = 0 Then
      MsgBox "Could not close Clipboard.", , "Clipboard"
   End If

End Sub
   
'********************************************