Copy to ClipBoard

[abertisch]

Permet de mettre dans le presse papier et de lire dans le presse papier

Code : Tout sélectionner

Option Public
Option Declare

Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (Byval lpString1 As String, Byval lpString2 As Long) As Long
Declare Function lstrcpy1 Lib "kernel32" Alias "lstrcpy" (Byval lpString1 As Long, Byval lpString2 As String) As Long
Declare Function SetClipboardData Lib "User32" (Byval wFormat As Long, Byval hMem As Long) As Long
Declare Function OpenClipboard Lib "User32" (Byval hwnd As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function GetClipboardData Lib "User32" (Byval wFormat As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (Byval wFlags&, Byval dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (Byval hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (Byval hMem As Long) As Long
Declare Function GlobalSize Lib "kernel32" (Byval hMem As Long) As Long

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

Public Function ClipBoard_SetData(MyString As String)
'-----------------------------------------------------------------------------------------------------------
' Description   :     Allows to put a text in the window's clipboard
'------------------------------------------------------------------------------------------------------------   
   Dim hGlobalMemory As Long, lpGlobalMemory As Long
   Dim hClipMemory As Long, X As Long
   
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1) ' Allocate movable global memory.
   lpGlobalMemory = GlobalLock(hGlobalMemory)' Lock the block to get a far pointer to this memory.
   lpGlobalMemory = lstrcpy1(lpGlobalMemory,MyString) ' Copy the string to this global memory
   
   If GlobalUnlock(hGlobalMemory) <> 0 Then ' Unlock the memory.
      Msgbox "Could not unlock memory location. Copy aborted."
      Goto OutOfHere2
   End If
   
   If OpenClipboard(0&) = 0 Then ' Open the Clipboard to copy data to.
      Msgbox "Could not open the Clipboard. Copy aborted."
      Exit Function
   End If
   
   X = EmptyClipboard() ' Clear the Clipboard. .
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory) ' Copy the data to the Clipboard
OutOfHere2:
   If CloseClipboard() = 0 Then
      Msgbox "Could not close Clipboard."
   End If
End Function

Public Function ClipBoard_GetData()
'------------------------------------------------------------------------------------------------------------
' Description   :     Allows to get a text from the window's clipboard
'------------------------------------------------------------------------------------------------------------   
   Dim hClipMemory As Long, lpClipMemory As Long
   Dim MyString As String, RetVal As Long
   
   If OpenClipboard(0&) = 0 Then
      Msgbox "Cannot open Clipboard. Another app. may have it open"
      Exit Function
   End If
   
   hClipMemory = GetClipboardData(CF_TEXT) ' Obtain the handle to the global memory block that is referencing the text.
   If Isnull(hClipMemory) Then
      Msgbox "Could not allocate memory"
      Goto OutOfHere
   End If
   
   lpClipMemory = GlobalLock(hClipMemory) ' Lock Clipboard memory so we can reference the actual data string
   If Not Isnull(lpClipMemory) Then
      MyString = Space$(MAXSIZE)
      RetVal = lstrcpy(MyString, lpClipMemory)
      RetVal = GlobalUnlock(hClipMemory)
      MyString = Mid(MyString, 1, Instr( 1,MyString, Chr$(0), 0) - 1) ' Peel off the null terminating character.
   Else
      Msgbox "Could not lock memory to copy string from."
   End If
OutOfHere:
   RetVal = CloseClipboard()
   ClipBoard_GetData = MyString
End Function