设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

从剪切板复制与粘贴

2015-4-18 09:05| 发布者: tmtony| 查看: 2022| 评论: 1|原作者: tmtony|来自: Office中国论坛

摘要: '摘自 Allen Browne 的技巧 Declare Function abOpenClipboard Lib User32 Alias OpenClipboard (ByVal Hwnd As Long) As Long Declare Function abCloseClipboard Lib User32 Alias CloseClipboard () As Long De ...
'摘自 Allen Browne 的技巧
Declare Function abOpenClipboard Lib "User32" Alias "OpenClipboard" (ByVal Hwnd As Long) As Long
Declare Function abCloseClipboard Lib "User32" Alias "CloseClipboard" () As Long
Declare Function abEmptyClipboard Lib "User32" Alias "EmptyClipboard" () As Long
Declare Function abIsClipboardFormatAvailable Lib "User32" Alias "IsClipboardFormatAvailable" (ByVal wFormat As Long) As Long
Declare Function abSetClipboardData Lib "User32" Alias "SetClipboardData" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function abGetClipboardData Lib "User32" Alias "GetClipboardData" (ByVal wFormat As Long) As Long
Declare Function abGlobalAlloc Lib "Kernel32" Alias "GlobalAlloc" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function abGlobalLock Lib "Kernel32" Alias "GlobalLock" (ByVal hMem As Long) As Long
Declare Function abGlobalUnlock Lib "Kernel32" Alias "GlobalUnlock" (ByVal hMem As Long) As Boolean
Declare Function abLstrcpy Lib "Kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function abGlobalFree Lib "Kernel32" Alias "GlobalFree" (ByVal hMem As Long) As Long
Declare Function abGlobalSize Lib "Kernel32" Alias "GlobalSize" (ByVal hMem As Long) As Long
Const GHND = &H42
Const CF_TEXT = 1
Const APINULL = 0To copy to the clipboard:

'复制到粘贴表
Function Text2Clipboard(szText As String)
    Dim wLen As Integer
    Dim hMemory As Long
    Dim lpMemory As Long
    Dim retval As Variant
    Dim wFreeMemory As Boolean

    ' Get the length, including one extra for a CHR$(0) at the end.
    wLen = Len(szText) + 1
    szText = szText & Chr$(0)
    hMemory = abGlobalAlloc(GHND, wLen + 1)
    If hMemory = APINULL Then
        MsgBox "Unable to allocate memory."
        Exit Function
    End If
    wFreeMemory = True
    lpMemory = abGlobalLock(hMemory)
    If lpMemory = APINULL Then
        MsgBox "Unable to lock memory."
        GoTo T2CB_Free
    End If

    ' Copy our string into the locked memory.
    retval = abLstrcpy(lpMemory, szText)
    ' Don't send clipboard locked memory.
    retval = abGlobalUnlock(hMemory)

    If abOpenClipboard(0&) = APINULL Then
        MsgBox "Unable to open Clipboard.  Perhaps some other application is using it."
        GoTo T2CB_Free
    End If
    If abEmptyClipboard() = APINULL Then
        MsgBox "Unable to empty the clipboard."
        GoTo T2CB_Close
    End If
    If abSetClipboardData(CF_TEXT, hMemory) = APINULL Then
        MsgBox "Unable to set the clipboard data."
        GoTo T2CB_Close
    End If
    wFreeMemory = False

T2CB_Close:
    If abCloseClipboard() = APINULL Then
        MsgBox "Unable to close the Clipboard."
    End If
    If wFreeMemory Then GoTo T2CB_Free
    Exit Function

T2CB_Free:
    If abGlobalFree(hMemory) <> APINULL Then
        MsgBox "Unable to free global memory."
    End If
End Function

'从剪切板粘贴:

Function Clipboard2Text()
    Dim wLen As Integer
    Dim hMemory As Long
    Dim hMyMemory As Long

    Dim lpMemory As Long
    Dim lpMyMemory As Long

    Dim retval As Variant
    Dim wFreeMemory As Boolean
    Dim wClipAvail As Integer
    Dim szText As String
    Dim wSize As Long

    If abIsClipboardFormatAvailable(CF_TEXT) = APINULL Then
        Clipboard2Text = Null
        Exit Function
    End If

    If abOpenClipboard(0&) = APINULL Then
        MsgBox "Unable to open Clipboard.  Perhaps some other application is using it."
        GoTo CB2T_Free
    End If

    hMemory = abGetClipboardData(CF_TEXT)
    If hMemory = APINULL Then
        MsgBox "Unable to retrieve text from the Clipboard."
        Exit Function
    End If
    wSize = abGlobalSize(hMemory)
    szText = Space(wSize)

    wFreeMemory = True

    lpMemory = abGlobalLock(hMemory)
    If lpMemory = APINULL Then
        MsgBox "Unable to lock clipboard memory."
        GoTo CB2T_Free
    End If

    ' Copy our string into the locked memory.
    retval = abLstrcpy(szText, lpMemory)
    ' Get rid of trailing stuff.
    szText = Trim(szText)
    ' Get rid of trailing 0.
    Clipboard2Text = Left(szText, Len(szText) - 1)
    wFreeMemory = False

CB2T_Close:
    If abCloseClipboard() = APINULL Then
        MsgBox "Unable to close the Clipboard."
    End If
    If wFreeMemory Then GoTo CB2T_Free
    Exit Function

CB2T_Free:
    If abGlobalFree(hMemory) <> APINULL Then
        MsgBox "Unable to free global clipboard memory."
    End If
End Function






相关阅读

发表评论

最新评论

引用 t小宝 2010-7-17 16:07
这么好的东西竟没人顶?

查看全部评论(1)

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-4-25 12:48 , Processed in 0.094810 second(s), 24 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回顶部