OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Thread Tools Search this Thread Display Modes
Old 19-12-2007, 15:00
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
Join Date: Mar 2005
Posts: 836
Default [useful code] Clipboard reading and writing

Here go the two handy functions to read and write the text contents of clipboard in unicode directly into/from VBA variables.

Reading of clipboard into a string variable
myStr = ClipboardGetUnicode()

Writing a string variable to the clipboard
bSucceed = ClipboardSetUnicode( myStr ) 'in case you need a status of the operation
ClipboardSetUnicode myStr 'just put it there

you can put the code text into a new module and name it mClipboard for convenience
Option Explicit

Private Declare Function OpenClipboard& Lib "user32" (ByVal hWnd&)
Private Declare Function SetClipboardData& Lib "user32" (ByVal Format&, ByVal hMem&)
Private Declare Function GetClipboardData& Lib "user32" (ByVal Format&)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function EmptyClipboard& Lib "user32" ()
Private Declare Function GlobalAlloc& Lib "kernel32" (ByVal Flags&, ByVal amount&)
Private Declare Function GlobalLock& Lib "kernel32" (ByVal hMem&)
Private Declare Function GlobalUnlock& Lib "kernel32" (ByVal hMem&)
Private Declare Function lstrlenW& Lib "kernel32" (ByVal lpStrW&)
private Declare Sub memmove Lib "ntdll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef source As Any, ByVal Length&)


Public Function ClipboardSetUnicode(text$) As Boolean
   Dim hMem&, pMem&, L&
   On Error Resume Next
   L = LenB(text): If L = 0 Then Exit Function
   If OpenClipboard(AppWindow.Handle) Then
      If EmptyClipboard Then
         hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, L + 2)
         If hMem Then
            pMem = GlobalLock(hMem)
            If pMem Then
               memmove ByVal pMem, ByVal StrPtr(text), L + 2
               GlobalUnlock hMem
               SetClipboardData CF_UNICODETEXT, hMem
               ClipboardSetUnicode = True
            End If
         End If
      End If
   End If
End Function

Public Function ClipboardGetUnicode() As String
   Dim hMem&, tLen&
   On Error Resume Next
   If OpenClipboard(AppWindow.Handle) Then
      hMem = GetClipboardData(CF_UNICODETEXT)
      If hMem Then
         tLen = lstrlenW(hMem)
         If tLen Then
            ClipboardGetUnicode = Space$(tLen)
            memmove ByVal StrPtr(ClipboardGetUnicode), ByVal hMem, tLen * 2
         End If
      End If
   End If
End Function

Last edited by wOxxOm; 02-03-2008 at 11:46.
Reply With Quote

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
[useful code] sortDelimitedText wOxxOm CorelDRAW/Corel DESIGNER VBA 0 19-12-2007 14:51
BrowserForFolder dialog box wOxxOm CorelDRAW/Corel DESIGNER VBA 2 19-12-2007 09:25

All times are GMT -5. The time now is 05:19.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2023, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com