截屏并压缩保存为jpg图片
时 间:2019-01-03 11:18:35
作 者:易勋 ID:35404 城市:上海
摘 要:通过模拟按键截屏,然后压缩保存为jpg图片
正 文:
函数:
Option Compare Database Option Explicit Public Declare Sub Sleep Lib "Kernel32" (ByVal dwmilliseconds As Long) Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Const KEYEVENTF_KEYUP = &H2 Private Const VK_SNAPSHOT = &H2C Private Const VK_MENU = &H12 '剪贴板函数 Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function GetClipboardData Lib "user32" (ByVal Format As Long) As Long 'OLE函数 Private Type Clsid Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Long, pclsid As Clsid) As Long 'GDI函数 Private Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long End Type Private Type EncoderParameter Guid As Clsid NumberOfValues As Long type As Long value As Long End Type Private Type EncoderParameters count As Long Parameter As EncoderParameter End Type Private Const CLSID_JPG As String = "{557CF401-1A04-11D3-9A73-0000F81EF32E}" Private Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}" Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, bitmap As Long) As Long Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As Clsid, encoderParams As Any) As Long Public Function ScreenSaveAs(FilePath As String) As Boolean '剪贴板图片保存JPG文件 Dim hMem As Long Dim bitmap As Long Dim GDI_Token As Long Dim GpInput As GdiplusStartupInput Dim ReturnValue As Long Dim Params As EncoderParameters Dim Quality As Long ScreenSaveAs = False GetScreen DoEvents Sleep 100 '获取剪贴板BMP数据的Handle OpenClipboard 0& hMem = GetClipboardData(2) CloseClipboard If hMem = 0 Then MsgBox "未找到截屏数据": Exit Sub '初始化GDI+ GpInput.GdiplusVersion = 1 ReturnValue = GdiplusStartup(GDI_Token, GpInput) If ReturnValue <> 0 Then MsgBox "初始化GDI+失败!": Exit Function '创建GDI+的bitmap对象 GdipCreateBitmapFromHBITMAP hMem, 0, bitmap 'JPG压缩参数设置 Quality = 50 With Params .count = 1 With .Parameter .Guid = GetEncoderClsid(EncoderQuality) .NumberOfValues = 1 .type = 4 .value = VarPtr(Quality) End With End With GdipSaveImageToFile bitmap, StrPtr(CurrentProject.Path & "\001.jpg"), GetEncoderClsid(CLSID_JPG), Params GdipDisposeImage bitmap GdiplusShutdown GDI_Token ScreenSaveAs = True End Function Private Function GetScreen() keybd_event VK_MENU, 0, 0, 0 keybd_event VK_SNAPSHOT, 0, 0, 0 keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0 keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0 End Function Private Function GetEncoderClsid(CLSIDString As String) As Clsid CLSIDFromString StrPtr(CLSIDString), GetEncoderClsid End Function
调用方法:
ScreenSaveAs "路径并/文件名.jpg"
Access软件网官方交流QQ群 (群号:54525238) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access源码示例】VBA...(10.12)
- Access累乘示例,Acce...(10.09)
- 数值8.88,把整数8去掉,转...(10.08)
- 【Access自定义函数】一个...(09.30)
- 【Access选项卡示例】Ac...(09.09)
- 【Access源码示例】按输入...(09.02)
- 【Access日期区间段查询】...(08.29)
- 【Access日期区间段查询】...(08.27)
- Access怎样才能实现日期时...(08.21)
学习心得
最新文章
- 获取文件修改日期的函数(10.18)
- Access快速开发平台--lis...(10.17)
- Access快速开发平台--普通用...(10.14)
- 【Access源码示例】VBA代码...(10.12)
- Access累乘示例,Access...(10.09)
- 数值8.88,把整数8去掉,转化成...(10.08)
- 用ACCESS开发的销售数据分析软...(10.06)
- 【中秋及国庆优惠】Access培训...(10.05)
- 2024欢度国庆--庆祝国庆华诞7...(10.01)
- 【Access自定义函数】一个繁简...(09.30)