【原创 / 源码】直接粘贴剪贴版的位图数据到Image控件

LucasLynn

与上次发过的《复制Image控件图像到剪贴板》不同的是，这次刚好是个反向操作，将你在剪贴板中的位图数据，直接显示在Image控件中。





调用示例：

Private Sub Command1_Click()

    PasteToImage Me.Image0

End Sub

模块段代码：

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

[此贴子已经被作者于2005-9-21 23:03:40编辑过]

tmtony

精品迭出!!

LucasLynn

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

非常不错!

恭喜恭喜!!!

真正的精品!

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

强烈支持!!

是不是加上PhotoShop滤镜功能，再加上DirectX截图功能，最好还有显示器直接拍照功能，会更加妙不可言？

我乐意和遇到技术难点的朋友分享经验，但我不是免费软件开发商，谢谢。

[此贴子已经被作者于2005-8-21 16:33:26编辑过]

LucasLynn

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



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

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

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

交流学习和找人代劳是两码事，如果你有兴趣关于这个主题交流学习的，我可以贴一堆相关的文档和资料上来“交流”，以供你“学习”。而不是为你“代劳”完成本来属于你自己的工作。而且交流需要的是自己的实际经验，经过消化后充分理解的知识，而不是自己都还没看懂的转贴文章。如果这也算交流，那么大家整天对着贴一篇篇高深莫测的文章，但是却不能解决一个实际问题，我想这也不是交流学习的目的。

我这个人说话比较直，不喜欢拐弯抹角，就说你前次提到的复制剪贴板到图形控件的问题，作为论坛上的交流学习，提供你那几份源码参考已经是极限，何况你自己又找到了剪贴板的相关文章，完全可以也应该自己完成，最多遇到某个技术难点过不去，再共同探讨如何解决。我代你完成这一工作本来已经超出了交流学习的范围，再提更多的要求就不应该了。

LucasLynn

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



兄弟说得非常有理！

爽快! 有话说话!

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

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

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

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

哈哈！

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

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

我这人在网上说话比较呛人，毕竟现实生活中已经活得很累，不想躲在Internet后面了，还要装作很有涵养，为此也得罪过不少人。还望海涵。

secowu

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

精品迭出!!

牧人：好样了

               

secowu

我这人在网上说话比较呛人，毕竟现实生活中已经活得很累，不想躲在Internet后面了，还要装作很有涵养，为此也得罪过不少人。还望海涵。＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝牧人：          有气度，有个性，好好