Private Declare Function GetClipboardFormatName Lib
"user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal
lpString As String, ByVal nMaxCount As Long) As Long
Private Sub
Command1_Click() Dim FormatID As Long Dim BufferLen As Long
Dim Buffer As String * 80 For FormatID = 50000 To 60000 ’一般有效的 ID
在该区内 BufferLen = GetClipboardFormatName(FormatID, Buffer, 80) If
BufferLen $#@62; 0 Then If InStr(UCase(Left(Buffer, BufferLen)), "HTML")
$#@62; 0 Then MsgBox FormatID & ":" & Buffer End If
Next End Sub
Private Declare Function OpenClipboard Lib "USER32"
(ByVal hWnd As Long) As Long Privat eclare Function CloseClipboard Lib
"USER32" () As Long Private Declare Function GetClipboardData Lib "USER32"
(ByVal wFormat As Long) As Long Private Declare Function
IsClipboardFormatAvailable Lib "USER32" (ByVal wFormat As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "USER32" Alias
"RegisterClipboardFormatA" (ByVal lpString As String) As Long Private
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As
Long Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long)
As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Function
GetClipboardIDForCustomFormat(ByVal sName As String) As Long Dim wFormat
As Long wFormat = RegisterClipboardFormat(sName & Chr$(0)) If
(wFormat $#@62; &HC000&) Then GetClipboardIDForCustomFormat =
wFormat End If End Function
Public Function
GetClipboardDataAsString(ByVal hWndOwner As Long, ByVal lFormatID As Long) As
String Dim bData() As Byte Dim hMem As Long Dim lSize As Long
Dim lPtr As Long
If (OpenClipboard(hWndOwner)) Then If
(IsClipboardFormatAvailable(lFormatID) $#@60;$#@62; 0) Then hMem =
GetClipboardData(lFormatID) If (hMem $#@60;$#@62; 0) Then lSize
= GlobalSize(hMem) If (lSize $#@62; 0) Then lPtr =
GlobalLock(hMem) If (lPtr $#@60;$#@62; 0) Then
ReDim bData(0 To lSize - 1) As Byte CopyMemory
bData(0), ByVal lPtr, lSize GlobalUnlock hMem
GetClipboardDataAsString = StrConv(bData, vbUnicode)
End If End If End If End If
CloseClipboard End If
End Function
Private Sub
Command1_Click() Dim lID As Long Dim sText As String
’ 如果没有
IE4,可以使用 "RTF Format" lID = GetClipboardIDForCustomFormat("HTML Format")
If (lID $#@60;$#@62; 0) Then sText =
GetClipboardDataAsString(Me.hWnd, lID) Text1.Text = sText End If