ApiClipboard

'\\ APIClipboard class ---------------------------
Option Explicit
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", APIDispenser.LastSystemError)
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", APIDispenser.LastSystemError)
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", APIDispenser.LastSystemError)
  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", APIDispenser.LastSystemError)
    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", APIDispenser.LastSystemError)
  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", APIDispenser.LastSystemError)
    End If
    lRet = CloseClipboard()
    If Err.LastDllError > 0 Then
      Call ReportError(Err.LastDllError, "ApiClipboard:Backup", APIDispenser.LastSystemError)
    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_Initialize()
End Sub

Private Sub Class_Terminate()
Set myMemory = Nothing
End Sub

'\\ APIGlobalmemory class ------------------------
Option Explicit
Private mMyData() As Byte
Private mMyDataSize As Long
Private mHmem As Long

Private mAllocationType As enGlobalmemoryAllocationConstants
Public Property Let AllocationType(ByVal newType As enGlobalmemoryAllocationConstants)
mAllocationType = newType
End Property
Public Property Get AllocationType() As enGlobalmemoryAllocationConstants
  AllocationType = mAllocationType
  
End Property

Private Sub CopyDataToGlobal()
Dim lRet As Long
If mHmem > 0 Then
  lRet = GlobalLock(mHmem)
  If lRet > 0 Then
    Call CopyMemory(ByVal mHmem, mMyData(0), mMyDataSize)
    Call GlobalUnlock(mHmem)
  End If
End If
End Sub
Public Sub CopyFromHandle(ByVal hMemHandle As Long)
Dim lRet As Long
Dim lPtr As Long
lRet = GlobalSize(hMemHandle)
If lRet > 0 Then
  mMyDataSize = lRet
  lPtr = GlobalLock(hMemHandle)
  If lPtr > 0 Then
    ReDim mMyData(0 To mMyDataSize - 1) As Byte
    CopyMemory mMyData(0), ByVal lPtr, mMyDataSize
    Call GlobalUnlock(hMemHandle)
  End If
End If
End Sub
Public Sub CopyToHandle(ByVal hMemHandle As Long)
Dim lSize As Long
Dim lPtr As Long
'\\ Don't copy if its empty
If Not Me.IsEmpty Then
  lSize = GlobalSize(hMemHandle)
  '\\ Don't attempt to copy if zero size...
  If lSize > 0 Then
    If lPtr > 0 Then
      CopyMemory ByVal lPtr, mMyData(0), lSize
      Call GlobalUnlock(hMemHandle)
    End If
  End If
End If
End Sub

'\\ --[Handle]------------------------------------------------------
'\\ Returns a Global Memroy handle that is valid and filled with the
'\\ info held in this object's private byte array
'\\ ----------------------------------------------------------------
Public Property Get Handle() As Long
If mHmem = 0 Then
  If mMyDataSize > 0 Then
    mHmem = GlobalAlloc(AllocationType, mMyDataSize)
  End If
End If
Call CopyDataToGlobal
Handle = mHmem
End Property
Public Property Get IsEmpty() As Boolean
  IsEmpty = (mMyDataSize = 0)
End Property
Public Sub Free()
If mHmem > 0 Then
  Call GlobalFree(mHmem)
  mHmem = 0
  mMyDataSize = 0
  ReDim mMyData(0) As Byte
End If
End Sub
Private Sub Class_Terminate()
If mHmem > 0 Then
  Call GlobalFree(mHmem)
End If
End Sub