X = ClipBoard_SetData("This string will go to the Clipboard!")
'Use database order for string comparisons Option Compare Database Option Explicit Declare Function kb_OpenClipBoard% Lib "User" Alias _ "OpenClipBoard" (ByVal hwnd%) Declare Function kb_GlobalAlloc% Lib "Kernel" Alias _ "GlobalAlloc" (ByVal wFlags%, ByVal wBytes&) Declare Function kb_GlobalLock& Lib "Kernel" Alias _ "GlobalLock" (ByVal hMem%) Declare Function kb_lstrcpy& Lib "Kernel" Alias _ "lstrcpy" (ByVal lpString1 As Any, ByVal lpString2 As Any) Declare Function kb_GlobalUnLock% Lib "Kernel" Alias _ "GlobalUnLock" (ByVal hMem%) Declare Function kb_CloseClipBoard% Lib "User" Alias _ "CloseClipBoard"() Declare Function kb_EmptyClipBoard% Lib "USER" Alias _ "EmptyClipBoard" () Declare Function kb_SetClipboardData% Lib "User" Alias _ "SetClipboardData" (ByVal wFormat%, ByVal hMem%) Global Const GHND = &H42 Global Const CF_TEXT = 1 Global Const MAXSIZE = 4096 Function ClipBoard_SetData (MyString$) Dim hGlobalMemory%, lpGlobalMemory&, hClipMemory%, X% '------------------------------------------- ' Allocate moveable global memory. '------------------------------------------- hGlobalMemory% = kb_GlobalAlloc(GHND, Len(MyString$) + 1) '------------------------------------------- ' Lock the block to get a far pointer ' to this memory. '------------------------------------------- lpGlobalMemory& = kb_GlobalLock(hGlobalMemory%) '------------------------------------------- ' Copy the string to this global memory. '------------------------------------------- lpGlobalMemory& = kb_lstrcpy(lpGlobalMemory&, MyString$) '------------------------------------------- ' Unlock the memory. '------------------------------------------- If kb_GlobalUnLock(hGlobalMemory%) <> 0 Then MsgBox "Could not unlock memory location. Copy aborted." GoTo OutOfHere2 End If '------------------------------------------- ' Open the Clipboard to copy data to. '------------------------------------------- If kb_OpenClipBoard(0&) = 0 Then MsgBox "Could not open the Clipboard. Copy aborted." Exit Function End If '------------------------------------------- ' Clear the Clipboard. '------------------------------------------- X% = kb_EmptyClipBoard() '------------------------------------------- ' Copy the data to the Clipboard. '------------------------------------------- hClipMemory% = kb_SetClipboardData(CF_TEXT, hGlobalMemory%) OutOfHere2: If kb_CloseClipBoard() = 0 Then MsgBox "Could not close Clipboard." End If End Function Come gestire la ClipBoard (16 bit) |