Option Compare Database
Option Explicit
‚———————————————————————————-
‚ Einsatz:
‚ dim Clipboard as new ClpBrd
‚
‚ Methoden:
‚ Clipboard.SetData <Data>
‚
‚ Daten in die Zwischenablage kopieren…
‚
‚ <Data>= String-Konstante oder String-Variable
‚ Beispiel:
‚ X$= DLookUp(„[Feld]“,“[Tabelle]“,SQL$)
‚ Clipboard.SetData X$
‚ oder
‚ Clipboard.SetData „Testtext“
‚
‚ X$ = Clipboard.GetData()
‚
‚ Daten aus der Zwischenablage holen…
‚
‚ X$= String-Variable oder direkt im Ausdruck
‚ Beispiel:
‚ X$= Clipboard.GetData()
‚ oder
‚ rs(„Feld“)= „Test: “ & Clipboard.GetData()
‚
‚ Clipboard.Clear
‚
‚ Löscht den aktuellen Inhalt der Zwischenablage…
‚
‚
‚ Clipboard.ClpBrdEmpty()
‚
‚ True, wenn Zwischenablage leer ist, sonst False
‚
‚———————————————————————————-
‚API-Funktionen für Clipboard…
Private Declare Function CountClipboardFormats Lib „user32“ () As Long
Private Declare Function IsClipboardFormatAvailable Lib „user32“ (ByVal wFormat As Long) As Long
Private Declare Function OpenClipboard Lib „user32“ (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib „user32“ () As Long
Private Declare Function SetClipboardData Lib „user32“ (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib „user32“ (ByVal wFormat As Long) As Long
Private Declare Function EmptyClipboard Lib „user32“ () As Long
‚API-Funktionen für Speicher-Operationen…
Private Declare Function GlobalUnlock Lib „kernel32“ (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib „kernel32“ (ByVal hMem 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 lStrCpy Lib „kernel32“ Alias „lstrcpy“ (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Const GHND = &H42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 32768
Sub Clear()
Dim lngRetVal As Long
If OpenClipboard(0&) <> 0 Then
lngRetVal = EmptyClipboard()
lngRetVal = CloseClipboard()
End If
End Sub
Function ClpBrdEmpty() As Boolean
Dim lngRetVal As Long
lngRetVal = CountClipboardFormats()
ClpBrdEmpty = (lngRetVal = 0) Or (IsClipboardFormatAvailable(CF_TEXT) = 0)
End Function
Function GetData()
Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim strCBData As String
Dim lngRetVal As Long
strCBData = „“
If ClpBrdEmpty() Then
Beep
MsgBox „ClpBrd/Get: Zwischenablage ist leer…“, vbCritical
Exit Function
End If
If IsClipboardFormatAvailable(CF_TEXT) = 0 Then
Beep
MsgBox „ClpBrd/Get: Zwischenablage enthält keinen Text…“, vbCritical
Exit Function
End If
If OpenClipboard(0&) = 0 Then
Beep
MsgBox „ClpBrd/Get: Zwischenablage kann nicht geöffnet werden…“, vbCritical
Exit Function
End If
hClipMemory = GetClipboardData(CF_TEXT)
If IsNull(hClipMemory) Then
Beep
MsgBox „ClpBrd/Get: Fehler beim Lesen der Zwischenablage…“
strCBData = „“
GoTo EndeFunc
End If
lpClipMemory = GlobalLock(hClipMemory)
If Not IsNull(lpClipMemory) Then
strCBData = Space$(MAXSIZE)
lngRetVal = lStrCpy(strCBData, lpClipMemory)
lngRetVal = GlobalUnlock(hClipMemory)
On Error Resume Next
strCBData = Mid(strCBData, 1, InStr(1, strCBData, Chr$(0), 0) – 1)
If Err <> 0 Then
Beep
MsgBox „ClpBrd/Get: Ungültiges Format …“, vbCritical
strCBData = „“
End If
Else
Beep
MsgBox „ClpBrd/Get: Fehler beim Kopieren aus Zwischenablage…“, vbCritical
End If
EndeFunc:
lngRetVal = CloseClipboard()
GetData = strCBData
End Function
Function SetData(strCBData As String) As Boolean
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim hClipMemory As Long
Dim lngRetVal As Long
SetData = False
hGlobalMemory = GlobalAlloc(GHND, Len(strCBData) + 1)
lpGlobalMemory = GlobalLock(hGlobalMemory)
lpGlobalMemory = lStrCpy(lpGlobalMemory, strCBData)
If GlobalUnlock(hGlobalMemory) <> 0 Then
Beep
MsgBox „ClpBrd/Set: Fehler beim Kopieren in die Zwischenablage…“, vbCritical
GoTo EndeFunc
End If
If OpenClipboard(0&) = 0 Then
Beep
MsgBox „ClpBrd/Set: Zwischenablage konnte nicht geöffnet werden…“, vbCritical
GoTo EndeFunc
End If
lngRetVal = EmptyClipboard()
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
SetData = True
EndeFunc:
If CloseClipboard() = 0 Then
Beep
MsgBox „ClpBrd/Set: Fehler beim Zugriff auf die Zwischenablage…“, vbCritical
SetData = False
End If
End Function