Results 1 to 4 of 4

Thread: Clipboard

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2003
    Posts
    305

    Clipboard

    Hey,why wont this work to copy file to clipboard thanks!

    VB Code:
    1. Option Explicit
    2.  
    3. ' Required data structures
    4. Private Type POINTAPI
    5. x As Long
    6. y As Long
    7. End Type
    8.  
    9. ' Clipboard Manager Functions
    10. Private Declare Function EmptyClipboard Lib "user32" () As Long
    11. Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
    12. Private Declare Function CloseClipboard Lib "user32" () As Long
    13. Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    14. Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    15. Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
    16.  
    17. ' Other required Win32 APIs
    18. Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
    19. Private Declare Function DragQueryPoint Lib "shell32.dll" (ByVal hDrop As Long, lpPoint As POINTAPI) As Long
    20. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    21. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
    22. Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    23. Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    24. Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    25.  
    26. ' Predefined Clipboard Formats
    27. Private Const CF_TEXT = 1
    28. Private Const CF_BITMAP = 2
    29. Private Const CF_METAFILEPICT = 3
    30. Private Const CF_SYLK = 4
    31. Private Const CF_DIF = 5
    32. Private Const CF_TIFF = 6
    33. Private Const CF_OEMTEXT = 7
    34. Private Const CF_DIB = 8
    35. Private Const CF_PALETTE = 9
    36. Private Const CF_PENDATA = 10
    37. Private Const CF_RIFF = 11
    38. Private Const CF_WAVE = 12
    39. Private Const CF_UNICODETEXT = 13
    40. Private Const CF_ENHMETAFILE = 14
    41. Private Const CF_HDROP = 15
    42. Private Const CF_LOCALE = 16
    43. Private Const CF_MAX = 17
    44.  
    45. ' New shell-oriented clipboard formats
    46. Private Const CFSTR_SHELLIDLIST As String = "Shell IDList Array"
    47. Private Const CFSTR_SHELLIDLISTOFFSET As String = "Shell Object Offsets"
    48. Private Const CFSTR_NETRESOURCES As String = "Net Resource"
    49. Private Const CFSTR_FILEDESCRIPTOR As String = "FileGroupDescriptor"
    50. Private Const CFSTR_FILECONTENTS As String = "FileContents"
    51. Private Const CFSTR_FILENAME As String = "FileName"
    52. Private Const CFSTR_PRINTERGROUP As String = "PrinterFriendlyName"
    53. Private Const CFSTR_FILENAMEMAP As String = "FileNameMap"
    54.  
    55. ' Global Memory Flags
    56. Private Const GMEM_FIXED = &H0
    57. Private Const GMEM_MOVEABLE = &H2
    58. Private Const GMEM_NOCOMPACT = &H10
    59. Private Const GMEM_NODISCARD = &H20
    60. Private Const GMEM_ZEROINIT = &H40
    61. Private Const GMEM_MODIFY = &H80
    62. Private Const GMEM_DISCARDABLE = &H100
    63. Private Const GMEM_NOT_BANKED = &H1000
    64. Private Const GMEM_SHARE = &H2000
    65. Private Const GMEM_DDESHARE = &H2000
    66. Private Const GMEM_NOTIFY = &H4000
    67. Private Const GMEM_LOWER = GMEM_NOT_BANKED
    68. Private Const GMEM_VALID_FLAGS = &H7F72
    69. Private Const GMEM_INVALID_HANDLE = &H8000
    70. Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
    71. Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
    72.  
    73. Private Type DROPFILES
    74. pFiles As Long
    75. pt As POINTAPI
    76. fNC As Long
    77. fWide As Long
    78. End Type
    79.  
    80.  
    81. Public Function ClipboardCopyFiles(Files() As String) As Boolean
    82.  
    83. Dim data As String
    84. Dim df As DROPFILES
    85. Dim hGlobal As Long
    86. Dim lpGlobal As Long
    87. Dim i As Long
    88.  
    89. ' Open and clear existing crud off clipboard.
    90. If OpenClipboard(0&) Then
    91. Call EmptyClipboard
    92.  
    93. ' Build double-null terminated list of files.
    94. For i = LBound(Files) To UBound(Files)
    95. data = data & Files(i) & vbNullChar
    96. Next
    97. data = data & vbNullChar
    98.  
    99. ' Allocate and get pointer to global memory,
    100. ' then copy file list to it.
    101. hGlobal = GlobalAlloc(GHND, Len(df) + Len(data))
    102. If hGlobal Then
    103. lpGlobal = GlobalLock(hGlobal)
    104.  
    105. ' Build DROPFILES structure in global memory.
    106. df.pFiles = Len(df)
    107. Call CopyMem(ByVal lpGlobal, df, Len(df))
    108. Call CopyMem(ByVal (lpGlobal + Len(df)), ByVal data, Len(data))
    109. Call GlobalUnlock(hGlobal)
    110.  
    111. ' Copy data to clipboard, and return success.
    112. If SetClipboardData(CF_HDROP, hGlobal) Then
    113. ClipboardCopyFiles = True
    114. End If
    115. End If
    116.  
    117. ' Clean up
    118. Call CloseClipboard
    119. End If
    120.  
    121. End Function
    122.  
    123. Public Function ClipboardPasteFiles(Files() As String) As Long
    124.  
    125. Dim hDrop As Long
    126. Dim nFiles As Long
    127. Dim i As Long
    128. Dim desc As String
    129. Dim filename As String
    130. Dim pt As POINTAPI
    131. Const MAX_PATH As Long = 260
    132.  
    133. ' Insure desired format is there, and open clipboard.
    134. If IsClipboardFormatAvailable(CF_HDROP) Then
    135. If OpenClipboard(0&) Then
    136.  
    137. ' Get handle to Dropped Filelist data, and number of files.
    138. hDrop = GetClipboardData(CF_HDROP)
    139. nFiles = DragQueryFile(hDrop, -1&, "", 0)
    140.  
    141. ' Allocate space for return and working variables.
    142. ReDim Files(0 To nFiles - 1) As String
    143. filename = Space(MAX_PATH)
    144.  
    145. ' Retrieve each filename in Dropped Filelist.
    146. For i = 0 To nFiles - 1
    147. Call DragQueryFile(hDrop, i, filename, Len(filename))
    148. Files(i) = TrimNull(filename)
    149. Next
    150.  
    151. ' Clean up
    152. Call CloseClipboard
    153. End If
    154.  
    155. ' Assign return value equal to number of files dropped.
    156. ClipboardPasteFiles = nFiles
    157. End If
    158.  
    159. End Function
    160.  
    161. Private Function TrimNull(ByVal sTmp As String) As String
    162.  
    163. Dim nNul As Long
    164.  
    165. '
    166. ' Truncate input sTmpg at first Null.
    167. ' If no Nulls, perform ordinary Trim.
    168. '
    169. nNul = InStr(sTmp, vbNullChar)
    170. Select Case nNul
    171. Case Is > 1
    172. TrimNull = Left(sTmp, nNul - 1)
    173. Case 1
    174. TrimNull = ""
    175. Case 0
    176. TrimNull = Trim(sTmp)
    177. End Select
    178.  
    179. End Function
    180.  
    181. Private Sub Form_Load()
    182. ClipboardCopyFiles ("c:\test.exe")
    183. End Sub

  2. #2

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2003
    Posts
    305
    any 1

  3. #3
    Addicted Member VB6Coder's Avatar
    Join Date
    Apr 2001
    Location
    Northampton, UK
    Posts
    185

    Re: Clipboard

    It's your Form_Load that's the problem. You are passing a String into the ClipboardCopyFiles procedure when it wants an Array.

    Try this:
    VB Code:
    1. Public Sub Form_Load()
    2.  
    3.     Dim astrArray(0) As String
    4.    
    5.     astrArray(0) = "c:\test.exe"
    6.     Call ClipboardCopyFiles(astrArray)
    7.  
    8. End Sub()

  4. #4
    Frenzied Member Robbo's Avatar
    Join Date
    Jan 2001
    Location
    Bradford
    Posts
    1,143

    Re: Clipboard

    did that work, please put resolved in the header so people like me dont have a look and reopen a thread cheers, oh merry xmas
    -----------------------------------------------
    "The hall is rented,"
    "the orchestra is engaged,"
    "its now time to see if you can dance!"
    Q, Q-Who, Star Trek The Next Generation
    -----------------------------------------------
    General Work day

    -----------------------------------------------
    DOS, Win 95, Win 98 SE, Win ME, Win NT 4.0 SP6a, Windows 2000 SP3, Window XP SP1, Windows 7, Windows 8/8.1, Windows 10, Office 97 Pro, Office 2000 Pro, Office 2010, Office 2013, Office 2016, Office 2019, Visual Basic 6 (SP5), SQL, Oracle

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width