Page 1 sur 1
Set Clipboard Text

Publié:
06 Nov 2007 à 09:10
par Michael DELIQUE
- Code : Tout sélectionner
Public Sub SetClipboardText_API(text As String)
%REM
'Variables API pour la fonction SetClipboardText_API
Declare Function CloseClipboard Lib "user32" Alias "CloseClipboard" () As Long
Declare Function NEMGetCurrentSubprogramWindow Lib "nnotesws.dll" () As Long
Declare Function SetClipboardData Lib "user32" Alias "SetClipboardData" (Byval wFormat As Long, Byval hMem As Long) As Long
Declare Function EmptyClipboard Lib "user32" Alias "EmptyClipboard" () As Long
Declare Function OpenClipboard Lib "user32" Alias "OpenClipboard" (Byval hwnd As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" Alias "GlobalAlloc" (Byval wFlags As Long, Byval dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" Alias "GlobalLock" (Byval hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" Alias "GlobalUnlock" (Byval hMem As Long) As Long
Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (Byval lpString1 As Long, Byval lpString2 As String) As Long
%END REM
'Déclaration Variables
Dim hwnd As Long
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim ret As Long
On Error Goto ErreurSetClipboardText_API
' Get a handle to current window
hwnd = NEMGetCurrentSubProgramWindow()
If hwnd Then
' Allocate memory
hGlobalMemory = GlobalAlloc(Clng(GMEM_MOVEABLE Or GMEM_ZEROINIT), Clng(Len(text)+1))
If hGlobalMemory Then
lpGlobalMemory = GlobalLock(hGlobalMemory)
If lpGlobalMemory Then
' Copy text to global memory
ret = lstrcpy(lpGlobalMemory, text)
Call GlobalUnlock(hGlobalMemory)
' Set clipboard contents
If OpenClipboard(hwnd) Then
ret = EmptyClipboard()
ret = SetClipboardData(CF_TEXT, hGlobalMemory)
ret = CloseClipboard()
End If
Else
Error 9999,"Can't allocated global memory pointer."
End If
Else
Error 9999,"Can't allocated global memory handle."
End If
Else
Error 9999,"Can't get window handle."
End If
Exit Sub
ErreurSetClipboardText_API:
Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Exit Sub
End Sub