【原创 / 源码】直接粘贴剪贴版的位图数据到Image控件 - Office中国论坛/Access中国论坛

Option Compare Database

Option Explicit

Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long

Declare Function CloseClipboard Lib "user32" () As Long

Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _

(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Public Const CF_TEXT = 1

Public Const CF_BITMAP = 2

Public Const CF_METAFILEPICT = 3

Public Const CF_DIB = 8

Public Const CF_ENHMETAFILE = 14

Public Sub PasteToImage(ByRef imgDest As Image)

Dim hBMP As Long

Dim arrData() As Byte

Dim biClrUsed As Long, biSizeImage As Long

OpenClipboard Application.hWndAccessApp

hBMP = GetClipboardData(CF_DIB)

CloseClipboard

If hBMP <> 0 Then

      ReDim arrData(39)

      CopyMemory ByVal VarPtr(arrData(0)), ByVal hBMP, 40



      biClrUsed = ReadBytes(arrData, 32, 2)

      biSizeImage = ReadBytes(arrData, 20, 4)



      ReDim arrData(39 + biClrUsed * 8 + biSizeImage)



      CopyMemory ByVal VarPtr(arrData(0)), ByVal hBMP, 40 + biClrUsed * 8 + biSizeImage



      imgDest.PictureData = arrData

End If

End Sub

'以下均为二进制数据读取函数

Public Function Byt2Lng(ByRef a() As Byte, ByVal p As Long) As Long

If a(p + 3) <= 127 Then

      Byt2Lng = ((CLng(a(p + 3)) * 256 + a(p + 2)) * 256 + a(p + 1)) * 256 + a(p)

Else

      Byt2Lng = -1 - (((CLng(Not a(p + 3)) * 256 + (Not a(p + 2))) * 256 + (Not a(p + 1))) * 256 + (Not a(p)))

End If

End Function

Public Function Byt2Int(ByRef a() As Byte, ByVal p As Long) As Integer

If a(p + 1) <= 127 Then

      Byt2Int = CInt(a(p + 1)) * 256 + a(p)

Else

      Byt2Int = CInt(Not a(p + 1)) * 256 + (Not a(p)) + 1

End If

End Function

Public Function ReadBytes(a() As Byte, p As Long, t As Integer) As Long

If t = 1 Then

      ReadBytes = a(p)

ElseIf t = 2 Then

      ReadBytes = Byt2Int(a, p)

ElseIf t = 4 Then

      ReadBytes = Byt2Lng(a, p)

End If

End Function

以下是引用esmile在2005-8-21 16:27:00的发言：

非常不错!

恭喜恭喜!!!

真正的精品!

如果再能实现可以自动在屏屏幕上选择截图,自然妙不可言.

强烈支持!!

以下是引用esmile在2005-8-21 16:55:00的发言：

是呀,重在交流与学习,共同进步呀.

大家所知,我们的免费付出,才有别人的免费付出,大家才会共同进步.

技术有了,关健还是在运用.运用好了,才会真正不免费, 是吗?

以下是引用esmile在2005-8-21 23:51:00的发言：

兄弟说得非常有理！

爽快! 有话说话!

这个问题也是一网友在其他论坛上贴出来的,我偶尔在中国论坛上发现你刚好也在研究图片与粘贴板的函数与原理,故有此一问,想不到问题会结从而至,这也本是好现象.

所谓本职工作,如果真是"代劳"的话,我想我也不会在晚上搞到四点还在研究你的程序与WINDOWS粘贴板的有关在网上贴的高深莫测的天文。

你的源码我也找了很多文章，如果我当时真能搞定，我完全没必要这样做？

仁兄已经做出了大成就，何不顺水推舟呢？

哈哈！

有关技术方面的事，其实早有高人已经做出来了，我不过是步其后尘罢了。

说来自己惭愧罢了。[em04]

以下是引用tmtony在2005-8-21 15:19:00的发言：

精品迭出!!

以下是引用esmile在2005-8-22 12:30:00的发言：

LucasLynn兄，言重了。

上这个论坛本就是互帮互助，免费共享，不然也不会来这里。

我见仁兄多次贴出源码，自是有此海量。

放出自己得意之作已经很不错了，

如果以自己专长能帮到有需要之人，作用更是无可比拟。

LucasLynn，如不见嫌，咱们交个朋友，如何？