2,462
社区成员
发帖
与我相关
我的任务
分享
Private Sub Command1_Click()
Picture1.Picture = LoadPicture("")
Picture1.Picture = KeyJp(theScreen)
SavePicture Picture1.Picture, "c:\jp.bmp"
End Sub
Private Sub Command2_Click()
Picture1.Picture = LoadPicture("")
Picture1.Picture = KeyJp(theForm)
SavePicture Picture1.Picture, "c:\jp2.bmp"
End Sub
'〓〓〓〓〓〓〓〓〓〓KeyJp函数相关定义声明等 Start
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Enum JpMode
theScreen = 0 '全屏截图
theForm = 1 '当前焦点窗口截图
End Enum
'〓〓〓〓〓〓〓〓〓〓KeyJp函数相关定义声明等 End
'┏〓〓〓〓〓〓〓〓〓 KeyJp,start 〓〓〓〓〓〓〓〓〓┓
'[详介]:
'函数注释:
'[简介]:
'按键方式截屏
Function KeyJp(Optional ByVal TheMode As JpMode = theScreen) As IPictureDisp
'VB源码,帮你写函数,帮你写代码,帮你写模块,帮你设计软件
'--需要什么函数或功能,可以联系我。
'版权所有,请保留作者信息.QQ:1085992075
'如需商业用途请联系作者
Call keybd_event(vbKeySnapshot, TheMode, 0, 0) '
DoEvents
Set KeyJp = Clipboard.GetData(vbCFBitmap)
End Function
'┗〓〓〓〓〓〓〓〓〓 KeyJp,end 〓〓〓〓〓〓〓〓〓┛
Private Sub Command1_Click()
Dim lDesktop As Long
Dim lDC As Long
frmMain.AutoRedraw = True
frmMain.ScaleMode = 1
lDesktop = GetDesktopWindow() '取得桌面窗口
Picture1.AutoRedraw = True
lDC = GetDC(lDesktop) '取得桌面窗口的设备场景
BitBlt Picture1.hDC, 0, 0, Screen.Width, Screen.Height, lDC, 0, 0, vbSrcCopy '将桌面图象绘制到窗体
SavePicture Picture1.Image, "D:\1.bmp"
End Sub
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Enum JpMode
theScreen = 0 '全屏截图
theForm = 1 '当前焦点窗口截图
End Enum
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As Guid, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Const CF_BITMAP = 2
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type
Private Type Guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Function ApiGetClipBmp() As IPicture
On Error Resume Next
Dim Pic As PicBmp, IID_IDispatch As Guid
OpenClipboard 0 'OpenClipboard
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
With Pic
.Size = Len(Pic)
.Type = 1
.hBmp = GetClipboardData(CF_BITMAP)
End With
OleCreatePictureIndirect Pic, IID_IDispatch, 1, ApiGetClipBmp
'stdole.SavePicture ApiGetClipBmp, "c:\clipboard.bmp"
CloseClipboard
End Function
Function KeyJp(Optional ByVal TheMode As JpMode = theScreen) As IPictureDisp
'版权所有,请保留作者信息.QQ:1085992075 '如需商业用途请联系作者
Call keybd_event(vbKeySnapshot, TheMode, 0, 0) '
DoEvents
'Set KeyJp = Clipboard.GetData
End Function
'┗〓〓〓〓〓〓〓〓〓 KeyJp,end 〓〓〓〓〓〓〓〓〓┛
Sub dd()
KeyJp (theScreen)
SavePicture ApiGetClipBmp, "c:\2.bmp"
End Sub