Advertisement
3_2004-2005 Miscellaneous #143212

All Clipboard Formats

It gives you possibility using all existing clipboard formats in VB. It is designed as ActiveX Control so you can use it in ASPs as well. Standard implementation of: - plain text - rich text format But also: - Biff5 - OEM text - DIF - UNICODETEXT - SYLK (The most powerfull) - CSV

AI

AI Summary: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Source Code
original-source
Public Sub CopyTLP(strText As String, strSylk As String)
Dim wLenT As Integer
Dim hMemoryT As Long
Dim lpMemoryT As Long
Dim wLenS As Integer
Dim hMemoryS As Long
Dim lpMemoryS As Long
Dim retval As Variant

  If OpenClipboard(APINULL) Then
    Call EmptyClipboard
    
    wLenT = Len(strText) + 1
    strText = strText & vbNullChar
    
    hMemoryT = GlobalAlloc(GHND, wLenT + 1)
  
    If hMemoryT Then
      lpMemoryT = GlobalLock(hMemoryT)
      retval = lstrcpy(lpMemoryT, strText)
      Call GlobalUnlock(hMemoryT)
      retval = SetClipboardData(CF_TEXT, hMemoryT)
    End If
    
    wLenS = Len(strSylk) + 1
    strSylk = strSylk & vbNullChar
    
    hMemoryS = GlobalAlloc(GHND, wLenS + 1)
  
    If hMemoryS Then
      lpMemoryS = GlobalLock(hMemoryS)
      retval = lstrcpy(lpMemoryS, strSylk)
      Call GlobalUnlock(hMemoryS)
      retval = SetClipboardData(CF_SYLK, hMemoryS)
    End If
  End If
  Call CloseClipboard
End Sub
Public Sub CopyText(strText As String)
  'ExecuteCopy strText, CF_TEXT
  Clipboard.GetText vbCFText
End Sub
Public Sub CopyRTF(strText As String)
  'ExecuteCopy strText, CF_TEXT
  Clipboard.GetText vbCFRTF
End Sub
Public Sub CopyOEMText(strText As String)
  ExecuteCopy strText, CF_OEMTEXT
End Sub
Public Sub CopyDIF(strText As String)
  ExecuteCopy strText, CF_DIF
End Sub
Public Sub CopyUNICODETEXT(strText As String)
  ExecuteCopy strText, CF_UNICODETEXT
End Sub
Public Sub CopySYLK(strText As String)
  ExecuteCopy strText, CF_SYLK
End Sub
Public Sub CopyXlTable(strText As String)
Dim wCBformat As Long
wCBformat = RegisterClipboardFormat("XlTable")
If wCBformat <> 0 Then
  ExecuteCopy strText, wCBformat
End If
End Sub
Public Sub CopyBiff5(strText As String)
Dim wCBformat As Long
wCBformat = RegisterClipboardFormat("BIFF5")
If wCBformat <> 0 Then
  ExecuteCopy strText, wCBformat
End If
End Sub
Public Sub CopyCsv(strText As String)
Dim wCBformat As Long
wCBformat = RegisterClipboardFormat("Csv")
If wCBformat <> 0 Then
  ExecuteCopy strText, wCBformat
End If
End Sub
Private Sub ExecuteCopy(strText As String, clipFormat As Long)
Dim wLen As Integer
Dim hMemory As Long
Dim lpMemory As Long
Dim retval As Variant

  If OpenClipboard(APINULL) Then
    Call EmptyClipboard
    
    wLen = Len(strText) + 1
    strText = strText & vbNullChar
    
    hMemory = GlobalAlloc(GHND, wLen + 1)
  
    If hMemory Then
      lpMemory = GlobalLock(hMemory)
      'Call CopyMem(ByVal lpMemory, strText, wLen)
      retval = lstrcpy(lpMemory, strText)
      Call GlobalUnlock(hMemory)
      
       retval = SetClipboardData(clipFormat, hMemory)
    End If
  End If
  Call CloseClipboard
End Sub
Public Function Paste()
Paste = Clipboard.GetText(1)
End Function
Function CanPaste() As Boolean
  If IsClipboardFormatAvailable(CF_TEXT) Then
    CanPaste = True
  ElseIf IsClipboardFormatAvailable(CF_UNICODETEXT) Then
    CanPaste = True
  ElseIf IsClipboardFormatAvailable(CF_OEMTEXT) Then
    CanPaste = True
  ElseIf IsClipboardFormatAvailable(CF_DIF) Then
    CanPaste = True
  End If
End Function
Original Comments (3)
Recovered from Wayback Machine