截屏后，如何将系统剪贴板上的数据保存为JPG文件

cumulonimbus

全都那么牛B，让我等菜鸟羡慕不止。

592rmb

是啊，里面都是老大，希望各位老大能将自己所学写成教程，大家都可以从中吸收到自己所需，对高手们自己来说，也是整理一下自己的思维

小fisher

这个程序说起来也不复杂，涉及到两类API函数，一类是剪贴板函数，用于读取剪贴板中的位图句柄，另外一类是GDI+函数，用于位图到jpg文件的转换，具体代码如下：

1. Option Explicit
   
2. Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
   
3. Private Declare Function CloseClipboard Lib "user32" () As Long
   
4. Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
   
5. Private Const CF_BITMAP = 2
   
6. 
   
7. Private Type GUID
   
8. Data1 As Long
   
9. Data2 As Integer
   
10. Data3 As Integer
    
11. Data4(0 To 7) As Byte
    
12. End Type
    
13. 
    
14. Private Type GdiplusStartupInput
    
15. GdiplusVersion As Long
    
16. DebugEventCallback As Long
    
17. SuppressBackgroundThread As Long
    
18. SuppressExternalCodecs As Long
    
19. End Type
    
20. 
    
21. Private Type EncoderParameter
    
22. GUID As GUID
    
23. NumberOfValues As Long
    
24. type As Long
    
25. Value As Long
    
26. End Type
    
27. 
    
28. Private Type EncoderParameters
    
29. Count As Long
    
30. Parameter As EncoderParameter
    
31. End Type
    
32. 
    
33. Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, ByVal outputbuf As Long) As Long
    
34. Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
    
35. Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
    
36. Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
    
37. Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
    
38. Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hPal As Long, BITMAP As Long) As Long
    
39. 
    
40. Sub test()
    
41.     Select Case CliptoJPG("c:\test.jpg")
    
42.         Case 0:
    
43.             MsgBox "剪贴板图片已保存"
    
44.         Case 1:
    
45.             MsgBox "剪贴板图片保存失败"
    
46.         Case 2:
    
47.             MsgBox "剪贴板中无图片"
    
48.         Case 3:
    
49.             MsgBox "剪贴板无法打开，可能被其他程序所占用"
    
50.     End Select
    
51. End Sub
    
52. 
    
53. 
    
54. Private Function CliptoJPG(ByVal destfilename As String, Optional ByVal quality As Byte = 80) As Integer
    
55. '*****该函数用于取出剪贴板中图片转换为jpg文件另存到指定路径****
    
56. '参数说明：
    
57. '     destfilename:要保存的jpg文件的完整路径，必要参数；
    
58. '     quality: jpg文件的质量，0-100之间的数值，数值越大，图片质量越高
    
59. '返回值：
    
60. '     0-保存成功；1-保存失败；2-剪贴板中无位图数据；3-无法打开剪贴板
    
61. 
    
62.     Dim tSI As GdiplusStartupInput
    
63.     Dim lRes As Long
    
64.     Dim lGDIP As Long
    
65.     Dim lBitmap As Long
    
66.     Dim hBmp As Long
    
67.    
    
68.     '尝试打开剪贴板
    
69.     If OpenClipboard(0) Then
    
70.         '尝试取出剪贴板中位图的句柄
    
71.         hBmp = GetClipboardData(CF_BITMAP)
    
72.         '如果hBmp为0，说明剪贴板中没有存放图片
    
73.         If hBmp = 0 Then
    
74.             CliptoJPG = 2
    
75.             CloseClipboard
    
76.             Exit Function
    
77.         End If
    
78.         CloseClipboard
    
79.     Else   '如果openclipboard返回0(False)，说明剪贴板被其他程序所占用
    
80.         CliptoJPG = 3
    
81.         Exit Function
    
82.     End If
    
83.    
    
84.     '初始化 GDI+
    
85.     tSI.GdiplusVersion = 1
    
86.     lRes = GdiplusStartup(lGDIP, tSI, 0)
    
87.      
    
88.     If lRes = 0 Then
    
89.         '从句柄创建 GDI+ 图像
    
90.         lRes = GdipCreateBitmapFromHBITMAP(hBmp, 0, lBitmap)
    
91.          
    
92.         If lRes = 0 Then
    
93.             Dim tJpgEncoder As GUID
    
94.             Dim tParams As EncoderParameters
    
95.             
    
96.             '初始化解码器的GUID标识
    
97.             CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
    
98.             
    
99.             '设置解码器参数
    
100.             tParams.Count = 1
     
101.             With tParams.Parameter ' Quality
     
102.                 '得到Quality参数的GUID标识
     
103.                 CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
     
104.                 .NumberOfValues = 1
     
105.                 .type = 4
     
106.                 .Value = VarPtr(quality)
     
107.             End With
     
108.             
     
109.             '保存图像
     
110.             lRes = GdipSaveImageToFile(lBitmap, StrPtr(destfilename), tJpgEncoder, tParams)
     
111.             If lRes = 0 Then
     
112.                 CliptoJPG = 0  '转换成功
     
113.             Else
     
114.                 CliptoJPG = 1  '转换失败
     
115.             End If
     
116.             
     
117.             '销毁GDI+图像
     
118.             GdipDisposeImage lBitmap
     
119.         End If
     
120.          
     
121.         '销毁 GDI+
     
122.         GdiplusShutdown lGDIP
     
123.     End If
     
124. End Function

复制代码

kangatang

小fisher 发表于 2013-4-23 09:57
这个程序说起来也不复杂，涉及到两类API函数，一类是剪贴板函数，用于读取剪贴板中的位图句柄，另外一类是G ...

最近难觅fisher大师踪影，感谢莅临指导。

kangatang

ccwan 发表于 2013-3-28 16:11
支持一下，期待中

欢迎测试
http://club.excelhome.net/thread-1007556-1-1.html

kangatang

amesman 发表于 2013-4-2 20:03
交流交流，下面是一个截图软件:
http://www.crsky.com/soft/39507.html

欢迎测试
http://club.excelhome.net/thread-1007556-1-1.html

kangatang

cumulonimbus 发表于 2013-4-22 22:58
全都那么牛B，让我等菜鸟羡慕不止。

欢迎测试
http://club.excelhome.net/thread-1007556-1-1.html

xdwy81129

帖子上面的人全是神人呀，敬仰

dy_ysl

kangatang 发表于 2013-4-24 17:45
欢迎测试
http://club.excelhome.net/thread-1007556-1-1.html

抱歉，本帖要求阅读权限高于 255 才能浏览

kangatang

dy_ysl 发表于 2013-9-10 14:28
抱歉，本帖要求阅读权限高于 255 才能浏览

我把那个帖子的VBS代码加密了，所以进去了也看不到代码。这是我个人用的，否面影响就不再扩大了。