Domino 9 und frühere Versionen > ND6: Entwicklung
Probleme beim kopieren Feldes in die Zwischenablage
brathaenchen:
Hi Leute!
Hab ein kleines Problem. Ich möchte gerne ein Feld in die Zwischenablage kopieren. Dafür hab ich ein lib mit dem ClipBoard.lss hier aus dem Bord importiert. Alles funktioniert bestens.
Allerdings nur beim ersten mal. Wenn mal nochmal auf den Button klickt ist die Zwischenablage leer. Beim 3. mal geht es dann wieder und so weiter. Hatte jemand das Problem schonmal?
Hier mein Code:
Aufruf:
Sub Click(Source As Button)
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim clsClipboard As WindowsClipboard
Set uidoc = workspace.CurrentDocument
Set doc = uidoc.Document
Set clsClipBoard = New WindowsClipboard()
clsClipboard.Contents = doc.DasFeld(0)
End Sub
Die entsprechende Lib
'ClipBoard:
Option Public
%REM
=============================================================================================
Library: ClipBoard
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Beschreibung :
Diese Bibliothek stellt eine Klasse zur Verfügung um Strings in die Zwischenablage zu schreiben oder zu lesen.
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Klassen:
Bezeichnung Beschreibung
WindowsClipboard Daten in die Zwischenablage schreiben oder daraus lesen
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Benötigte Routinen und Bibliotheken:
Routine Bibliothek
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Erstellt am 02.02.2004 durch Axel Matthies
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Letzte Änderung am:
=============================================================================================
%ENDREM
Declare Private Function GetClipboardData Lib "User32" (Byval wFormat As Long) As Long
Declare Private Function SetClipboardData Lib "user32" (Byval wFormat As Long, Byval hData As Long) As Long
Declare Private Function OpenClipboard Lib "User32" Alias "OpenClipboard" (Byval hwnd As Long) As Long
Declare Private Function CloseClipboard Lib "User32" Alias "CloseClipboard" () As Long
Declare Private Function GlobalLock Lib "kernel32" Alias "GlobalLock" (Byval hMem As Long) As Long
Declare Private Function GlobalUnlock Lib "kernel32" Alias "GlobalUnlock" (Byval hMem As Long) As Long
Declare Private Function GlobalAlloc Lib "kernel32" (Byval wFlags As Long, Byval dwBytes As Long) As Long
Declare Private Function GlobalFree Lib "kernel32" (Byval hMem As Long) As Long
Declare Private Function EmptyClipboard Lib "user32" () As Long
Declare Private Function lstrcpyLP2Str Lib "kernel32" Alias "lstrcpyA" (Byval lpString1 As String, _
Byval lpString2 As Long) As Long
Declare Private Function lstrlenLP Lib "kernel32" Alias "lstrlenA" (Byval lpString As Long) As Long
Declare Private Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Byval strDest As Any, _
Byval lpSource As Any, Byval Length As Any)
Declare Private Function GetFocus Lib "User32" Alias "GetFocus" () As Long
Private Const CF_TEXT = 1
Private Const GMEM_MOVABLE = &H2&
Private Const GMEM_DDESHARE = &H2000&
Class WindowsClipboard
Public Property Get Contents As String
Dim hClipboard As Long
Dim LpStrl As Long
Dim Resultl As Long
Dim Clipboardstr As String
If (OpenClipboard(0&) <> 0) Then
hClipboard = GetClipboardData(CF_TEXT)
If (hClipboard <> 0) Then
LpStrl = GlobalLock(hClipboard)
Clipboardstr = Space$(lstrlenLP(LpStrl))
Resultl = lstrcpyLP2Str(Clipboardstr, LpStrl)
GlobalUnlock(hClipboard)
Else
Clipboardstr = "NULL"
End If
Call CloseClipboard()
Else
Clipboardstr = ""
End If
Contents = Clipboardstr
End Property
Public Property Set Contents As String
Dim lSize As Long
Dim hMem As Long
Dim pMemory As Long
Dim temp As Variant
lSize = Len(Contents)+1
hMem = GlobalAlloc(GMEM_MOVABLE Or GMEM_DDESHARE, lSize)
If hMem = 0 Or Isnull(hMem) Then Exit Property
pMemory = GlobalLock(hMem)
If pMemory = 0 Or Isnull(pMemory) Then
GlobalFree(hMem)
Exit Property
End If
Call MoveMemory(pMemory, Contents, lSize)
Call GlobalUnlock(hMem)
If (OpenClipboard(0&) <> 0) Then
If (EmptyClipboard() <> 0) Then
temp = SetClipboardData(CF_TEXT, hMem)
End If
temp = CloseClipboard()
End If
GlobalFree(hMem)
End Property
End Class
Jemand eine Idee woran es liegt? Finde den fehler einfach nicht. Danke im Vorraus
Axel:
Hi,
ich hab's bei mir mal probiert und ich habe den gleichen Effekt. Den Grund dafür kann ich auf die Schnelle auch nicht finden. Den Grundcode habe ich mir seinerzeit aus den Internet gefischt. Bei Test ist mir das nicht aufgefallen.
Sorry, aber im Moment werde ich auf Zeitgründen nicht dazukommen, dass genauer zu ergründen. Sobald ich genaueres weiß, werde ich es hier im Forum kundtun.
Axel
brathaenchen:
hmmm schade ich bräuchte dringend eine Lösung...
Keiner eine Idee?
TMC:
Breaking Par hatte da auch mal was.
http://www.breakingpar.com/bkp/home.nsf/0/87256B280015193F87256CFA00581AB2
TMC:
Hier noch eine andere Umsetzung:
--- Code: ---Const GMEM_MOVEABLE = &H40
Const GMEM_ZEROINIT = &H2
Const CF_TEXT = &H01
Const SRCCOPY = &HCC0020
Declare Function OpenClipboard Lib "user32" Alias "OpenClipboard" (Byval hwnd As Long) As Long
Declare Function CloseClipboard Lib "user32" Alias "CloseClipboard" () As Long
Declare Function EmptyClipboard Lib "user32" Alias "EmptyClipboard" () As Long
Declare Function SetClipboardData Lib "user32" Alias "SetClipboardData" (Byval wFormat As Long, Byval hMem 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
Declare Function NEMGetCurrentSubprogramWindow Lib "nnotesws.dll" () As Long
Sub SetClipboardText(text As String)
Dim hwnd As Long
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim ret As Variant
On Error Goto error_handler
hwnd = NEMGetCurrentSubProgramWindow()
If hwnd Then
hGlobalMemory = GlobalAlloc(Clng(GMEM_MOVEABLE Or GMEM_ZEROINIT), Clng(Len(text)+1))
If hGlobalMemory Then
lpGlobalMemory = GlobalLock(hGlobalMemory)
If lpGlobalMemory Then
ret = lstrcpy(lpGlobalMemory, text)
Call GlobalUnlock(hGlobalMemory)
If OpenClipboard(hwnd) Then
ret = EmptyClipboard()
ret = SetClipboardData(CF_TEXT, hGlobalMemory)
ret = CloseClipboard()
End If
Else
Msgbox "Can't allocated global memory pointer.", 32, "Error"
End If
Else
Msgbox "Can't allocated global memory handle.", 32, "Error"
End If
Else
Msgbox "Can't get window handle.", 32, "Error"
End If
Exit Sub
error_handler:
Print "Error: " + Error$(Err)
Resume Next
End Sub
--- Ende Code ---
Macht allerdings keinen so guten Eindruck. Zumindest gefällt mir auf den ersten Blick der Resume Next nicht im ErrorHandler. Weiter hab ich mir das noch nicht angesehen, stammt von einer gruseligen Script-Sammlung-DB von mir.
Navigation
[0] Themen-Index
[#] Nächste Seite
Zur normalen Ansicht wechseln