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

<sub>'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</sub>






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

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.

[Axel]

Hi,

ich hab gerade festgestellt, dass ich meinen Code doch in einer DB einsetze (es lebe die Dokumentation, vor allem die nicht vorhandene    ) und die ist mir gerade mit dem gleichen Problem vor die Füsse gefallen.

Ich werde mit in den nächsten Tagen schlau machen und nach einer funktionierenden Lösung Ausschau halten.

Natürlich werde ich sie hier dann zur Verfügung stellen. Also noch ein bisschen Geduld.


Axel

[brathaenchen]

hmm und wie rufe ich den Code auf?

[Axel]

Hi,

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

Diesen Zeilen kopierst du in den Declarations - Abschnitt deines Buttons.

Code

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

Dieses Zeilen kopierst du einfach in den Options - Abschnitt. Er fügt dann das automatisch das als Routine ein. Die kannst du dann einfahcin deinem Code aufrufen.

Beisp.:
...
strText = "Das wird in die Zwischenablage kopiert"
Call SetClipboardText(strText)
...


Axel

[Axel]

Breaking Par hatte da auch mal was.

http://www.breakingpar.com/bkp/home.nsf/0/87256B280015193F87256CFA00581AB2

Achtung!! Das ist der Code der jetzt Probleme macht. Das hatte ich damals als Vorlage genommen und fast (oder gar 1:1 ) übernommen.


Axel

[Axel]

Hi,

ich habe inzwischen eine funktionsfähige Klasse gefunden und hier

Klasse für Zwischenablage

zur Verfügung gestellt.


Axel