Re: Daten in Zwischenablage kopieren
06.12.2002 19:36:23
Thomas Risi
Hallo HaraldIch würde dazu eine Klasse erstellen ...
Code für Klasse (CClipboard):
Option ExplicitPrivate Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData_ Lib "user32" Alias "SetClipboardData" ( _
ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" ( _
ByVal wFormat As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" ( _
ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem 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 Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByVal strDest As Any, ByVal lpSource As Any, ByVal Length As Long)
Private Const CF_TEXT = 1
Private Const GMEM_FIXED = &H0
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_NOCOMPACT = &H10
Private Const GMEM_NODISCARD = &H20
Private Const GMEM_ZEROINIT = &H40
Private Const GMEM_MODIFY = &H80
Private Const GMEM_DISCARDABLE = &H100
Private Const GMEM_NOT_BANKED = &H1000
Private Const GMEM_SHARE = &H2000
Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_NOTIFY = &H4000
Private Const GMEM_LOWER = GMEM_NOT_BANKED
Private Const GMEM_VALID_FLAGS = &H7F72
Private Const GMEM_INVALID_HANDLE = &H8000
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
Public Sub SetClipboardData(ByVal Text As String)
Dim wLen As Long
Dim hMemory As Long
Dim lpMemory As Long
OpenClipboard 0&
EmptyClipboard
wLen = Len(Text) + 1
Text = Text & Chr$(0)
hMemory = GlobalAlloc(GHND, wLen + 1)
lpMemory = GlobalLock(hMemory)
MoveMemory lpMemory, Text, wLen
GlobalUnlock hMemory
SetClipboardData_ CF_TEXT, lpMemory
CloseClipboard
GlobalFree hMemory
End Sub
Der Aufruf könnte dann etwa so erfolgen:
Option ExplicitDim Clipboard As New CClipboard
Sub Test()
Dim Text$: Text = "Testwert"
Clipboard.SetClipboardData Text
End Sub
Code eingefügt mit Syntaxhighlighter 1.15
Gruß
Thomas
Risi Thomas Softwareentwicklung