apiclipboard.cls

几个不错的VB例子

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ApiClipboard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' ##MODULE_DESCRIPTION This class is used to get information about and perform _
operations on the system clipboard

' ##SEE_ALSO The clipboard is assoicated with the %ApiWindow:EventVB~ApiWindow%

Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetClipboardOwner Lib "user32" () As Long

Private Declare Function GetClipboardViewer Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function SetClipboardViewer Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long

Public Enum enClipboardFormats
    CF_BITMAP = 2
    CF_DIB = 8
    CF_DIF = 5
    CF_ENHMETAFILE = 14
    CF_METAFILEPICT = 3
    CF_OEMTEXT = 7
    CF_PALETTE = 9
    CF_PENDATA = 10
    CF_RIFF = 11
    CF_SYLK = 4
    CF_TEXT = 1
    CF_TIFF = 6
    CF_UNICODETEXT = 13
    CF_WAVE = 12
End Enum

Public ParenthWnd As Long

Private myMemory As ApiGlobalmemory
Private mLastFormat As Long

Public Property Get BackedUp() As Boolean

    BackedUp = Not (myMemory Is Nothing)
    
End Property

'\\ --[Backup]------------------------------------------------------
'\\ Makes an in-memory copy of the clipboard's contents so that they
'\\ can be restored easily
'\\ ----------------------------------------------------------------
Public Sub Backup()

Dim lret As Long
Dim AllFormats As Collection
Dim lFormat As Long

'\\ Need to get all the formats first...
Set AllFormats = Me.ClipboardFormats

lret = OpenClipboard(ParenthWnd)
If Err.LastDllError > 0 Then
    Call ReportError(Err.LastDllError, "ApiClipboard:Backup", GetLastSystemError)
End If
If lret Then
    If AllFormats.Count > 0 Then
        '\\ Get the first format that holds any data
        For lFormat = 0 To AllFormats.Count - 1
            lret = GetClipboardData(lFormat)
            If lret > 0 Then
                Set myMemory = New ApiGlobalmemory
                Call myMemory.CopyFromHandle(lret)
                '\\ Keep a note of this format
                mLastFormat = lFormat
                Exit For
            End If
            'clipboard
        Next lFormat
    End If
    lret = CloseClipboard()
End If


End Sub

Public Property Get ClipboardFormats() As Collection

Dim lret As Long
Dim colFormats As Collection

lret = OpenClipboard(ParenthWnd)
If Err.LastDllError > 0 Then
    Call ReportError(Err.LastDllError, "ApiClipboard:Backup", GetLastSystemError)
End If
If lret > 0 Then
    Set colFormats = New Collection
    '\\ Get the first available format
    lret = EnumClipboardFormats(0)
    If Err.LastDllError > 0 Then
        Call ReportError(Err.LastDllError, "ApiClipboard:Backup", GetLastSystemError)
    End If
    While lret > 0
        colFormats.Add lret
        '\\ Get the next available format
        lret = EnumClipboardFormats(lret)
        If Err.LastDllError > 0 Then
            Call ReportError(Err.LastDllError, "ApiClipboard:Backup", GetLastSystemError)
        End If
    Wend
    '\\ Close the clipboard object to make it available to other apps.
    lret = CloseClipboard()
End If

Set ClipboardFormats = colFormats

End Property

'\\ --[Restore]-----------------------------------------------------
'\\ Takes the in-memory copy of the clipboard object and restores it
'\\ to the clipboard.
'\\ ----------------------------------------------------------------
Public Sub Restore()

Dim lret As Long

If Me.BackedUp Then
    lret = OpenClipboard(ParenthWnd)
    If Err.LastDllError > 0 Then
        Call ReportError(Err.LastDllError, "ApiClipboard:Restore", GetLastSystemError)
    End If
    If lret Then
        myMemory.AllocationType = GMEM_FIXED
        lret = SetClipboardData(mLastFormat, myMemory.Handle)
        myMemory.Free
        If Err.LastDllError > 0 Then
            Call ReportError(Err.LastDllError, "ApiClipboard:Backup", GetLastSystemError)
        End If
        lret = CloseClipboard()
        If Err.LastDllError > 0 Then
            Call ReportError(Err.LastDllError, "ApiClipboard:Backup", GetLastSystemError)
        End If
    End If
End If

End Sub

Public Property Get Text() As String

Dim sRet As String
If Clipboard.GetFormat(vbCFText) Then
    sRet = Clipboard.GetText()
End If

End Property

Private Sub Class_Terminate()

Set myMemory = Nothing

End Sub