ClipBoard16




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)










( clipboard16.html )- by Paolo Puglisi - Modifica del 17/12/2023