截屏并压缩保存为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群 (群号:483923997) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access窗体导出PDF】...(04.08)
- 【Access窗体导出PDF】...(04.07)
- Access两种方式实现即时更...(03.01)
- Access隐藏与显示lacc...(01.12)
- 【Access高效办公】将每个...(12.23)
- Access21点游戏源代码(12.13)
- 【Access窗体导出Exce...(11.15)
- 【Access开发】Acces...(11.14)
- 通过Access宏录入数据到选...(11.10)
学习心得
最新文章
- Access VBA语句If Me...(04.24)
- 【Access修改记录示例】编辑选...(04.22)
- 【Access表名称命名建议】将A...(04.20)
- Access学习笔记--用Acce...(04.19)
- 【Access重复项查询示例】将A...(04.17)
- Access快速开发平台企业版--...(04.16)
- 【Access模块示例】通过模块代...(04.15)
- Access查询里面分组合计功能添...(04.13)
- 【Access删除查询】删除数字最...(04.12)
- 显示文件夹中所有文件的修改时间(04.11)