Send Information to the Clipboard

[srvaldez]

I need help converting to FB the code found at https://msdn.microsoft.com/en-us/vba/ac ... 2147217396
this is my attempt but when executed the clipboard only has "he"
please note that I am not familiar with Wstring and whether I am using the datatype correctly, all help is much appreciated.

what's the function name to get the unicode string length?

Code: Select all

#define unicode

#include "windows.bi"

Public Sub SetClipboard(sUniText As LPCWSTR)
    Dim iStrPtr As Long ptr
    Dim iLen As Long
    Dim iLock As LPWSTR
'    Const GMEM_MOVEABLE As Long = &H2
'    Const GMEM_ZEROINIT As Long = &H40
'    Const CF_UNICODETEXT As Long = &HD
    OpenClipboard 0&
    EmptyClipboard
    iLen = len(sUniText) + 2& ''LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpyW (iLock, sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Sub

Public Function GetClipboard() As String
    Dim iStrPtr As Long ptr
    Dim iLen As Long
    Dim iLock As LPWSTR
    Dim sUniText As wString ptr
'    Const CF_UNICODETEXT As Long = 13&
    OpenClipboard 0&
    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            *sUniText = String(iLen , NULL) ''String(iLen \ 2& - 1&, NULL)
            lstrcpyW ((sUniText), iLock)
            GlobalUnlock iStrPtr
        End If
        GetClipboard = *sUniText
    End If
    CloseClipboard
End Function

dim as wstring ptr s = allocate(250)
*s = "hello"

SetClipboard(s)

deallocate(s)

[MrSwiss]

Well afaik, you can get text from clipboard *formatted* the way you
choose. Either ANSI or UNICODE, therefore WString use is not mandatory.
(I'd use ANSI, because a FB String does the job.)
dodicat has done that sort of thing, in quite many examples ... search
the forum for them.

Supported formatting options: dataexchange/clipboard
Btw: why are you looking at Office related Doc's.? You probably want:
desktop/applications ... (I can't make "head or tail" from VB code).

[srvaldez]

the only problem was getting the unicode string length, but the following seems OK

Code: Select all

#include "windows.bi"
#include "Afx\AfxStr.inc"

Sub SetClipboard(ByRef myText as CWSTR)
   dim as CWSTR sUniText
   Dim iStrPtr As Long ptr
   Dim iLen As Long
   Dim iLock As LPWSTR
   sUniText = myText
   OpenClipboard 0&
   EmptyClipboard
   iLen = len(sUniText)*2 + 2&
   iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
   iLock = GlobalLock(iStrPtr)
   lstrcpyW (iLock, sUniText)
   GlobalUnlock iStrPtr
   SetClipboardData CF_UNICODETEXT, iStrPtr
   CloseClipboard
End Sub

Public Function GetClipboard() As CWSTR
    Dim iStrPtr As Long ptr
    Dim iLen As Long
    Dim iLock As LPWSTR
    dim as CWSTR sUniText
'    Const CF_UNICODETEXT As Long = 13&
    OpenClipboard 0&
    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String(iLen , NULL) ''String(iLen \ 2& - 1&, NULL)
            lstrcpyW ((sUniText), iLock)
            GlobalUnlock iStrPtr
        End If
        GetClipboard = sUniText
    End If
    CloseClipboard
End Function

[dodicat]

I only have rough and ready clipboard stuff with unicode.
I use Poseidon ide for this tester.

Code: Select all

 


#include "windows.bi"
#include "crt.bi"
Function get_clipboard() As String
        If IsClipboardFormatAvailable(CF_TEXT) = 0 Then Return "Error"
        If OpenClipboard(0) = 0 Then Return "Error"
        Function = *Cast(zstring Ptr,GetClipboardData(CF_TEXT))
        CloseClipboard()
End Function

Sub SaveToClipBoard(Text As String)       'write Text to the clipboard
   Var Num=GlobalAlloc(GMEM_MOVEABLE,Len(Text)+1)
   memcpy(GlobalLock(num), @text[0], Len(Text)+1)
   Var Chars=GlobalLock(Num)
    GlobalUnlock(Num)
    OpenClipboard(0)
    EmptyClipboard()
    SetClipboardData(CF_TEXT,Chars)
    CloseClipboard()
End Sub



Function get_clipboardW() As wString ptr
    dim as wstring * 10 e="ERROR"
        If IsClipboardFormatAvailable(CF_UNICODETEXT) = 0 Then Return @e
        If OpenClipboard(0) = 0 Then Return @e
        Function = Cast(wstring Ptr,GetClipboardData(CF_UNICODETEXT))
        CloseClipboard()
End Function

Sub SaveToClipBoardW(Text As wString)       'write uText to the clipboard
   Var Num=GlobalAlloc(GMEM_MOVEABLE,(wcslen(@Text)+1)*sizeof(wstring))
   memcpy(GlobalLock(num), @text, (wcslen(@Text)+1)*sizeof(wstring))
   var Chars=GlobalLock(Num)
    GlobalUnlock(Num)
    OpenClipboard(0)
    EmptyClipboard()
    SetClipboardData(CF_UNICODETEXT,Chars)
    CloseClipboard()
End Sub

dim as string g="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
SaveToClipBoard g

print get_clipboard
print
dim as wstring * 1000 us

us="По оживлённым берегам" +wchr(10)
us+="Громады стройные теснятся" +wchr(10)
us+="Дворцов и башен; корабли" +wchr(10)
us+="Толпой со всех концов земли"+wchr(10)
us+="К богатым пристаням стремятся;"



SaveToClipBoardW (us)
print *get_clipboardW()


print
print "As ascii"
Savetoclipboard(us)
print Get_clipboard()


sleep
  

PS
I tested your code , I have the afx files)
same result for thr Russian unicode

[srvaldez]

thank you dodicat :)

[jj2007]

You should stick to CF_UNICODETEXT. The OS translates UTF-16 to the system's local codepage, and will set the Ansi text accordingly - best scenario from a user's viewpoint. If you are interested in the topic, read The Old New Thing

[PaulSquires]

the only problem was getting the unicode string length, but the following seems OK

Code: Select all

#include "windows.bi"
#include "Afx\AfxStr.inc"

Sub SetClipboard(ByRef myText as CWSTR)
   dim as CWSTR sUniText
   Dim iStrPtr As Long ptr
   Dim iLen As Long
   Dim iLock As LPWSTR
   sUniText = myText
   OpenClipboard 0&
   EmptyClipboard
   iLen = len(sUniText)*2 + 2&
   iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
   iLock = GlobalLock(iStrPtr)
   lstrcpyW (iLock, sUniText)
   GlobalUnlock iStrPtr
   SetClipboardData CF_UNICODETEXT, iStrPtr
   CloseClipboard
End Sub

Public Function GetClipboard() As CWSTR
    Dim iStrPtr As Long ptr
    Dim iLen As Long
    Dim iLock As LPWSTR
    dim as CWSTR sUniText
'    Const CF_UNICODETEXT As Long = 13&
    OpenClipboard 0&
    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String(iLen , NULL) ''String(iLen \ 2& - 1&, NULL)
            lstrcpyW ((sUniText), iLock)
            GlobalUnlock iStrPtr
        End If
        GetClipboard = sUniText
    End If
    CloseClipboard
End Function

Since you are already using Jose's WinFBX then you might as well avail of his clipboard routines in AfxWin:
AfxGetClipboardText
AfxSetClipboardText
AfxGetClipboardData
AfxSetClipboardData
AfxClearClipboard

[srvaldez]

thank you Paul for the tip :-)