VB截屏(拷贝屏幕图像)代码
来源:百度文库 编辑:神马文学网 时间:2024/04/27 18:03:50
一时对图片处理特别感兴趣.....下面就来转一篇有关于截屏的文章.
本文转自:http://im0518.blog.163.com/blog/static/2655641720071022101445585/
两种方法:感觉第一种方法来得直接一些
方法一:
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Sub saveMyScreen(filePath As String)
'filePath为截屏要保存的路径
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
Picture1.Visible = False
Dim lngDesktopHwnd As Long
Dim lngDesktopDC As Long
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
lngDesktopHwnd = GetDesktopWindow
lngDesktopDC = GetDC(lngDesktopHwnd)
Call BitBlt(Picture1.hdc, 0, 0, Screen.Width, Screen.Height, lngDesktopDC, 0, 0, SRCCOPY)
Picture1.Picture = Picture1.Image
Call ReleaseDC(lngDesktopHwnd, lngDesktopDC)
SavePicture Picture1, filePath '保存图片
End Sub
方法二:
'form中放一个按钮和一个图片框
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const theScreen = 0
Const theForm = 1
Private Sub Command1_Click()
Call keybd_event(vbKeySnapshot, theScreen, 0, 0)
DoEvents
Picture1.Picture = Clipboard.GetData(vbCFBitmap)
End Sub
方法一修改后:
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Sub saveMyScreen(filePath As String)
Dim lngDesktopHwnd As Long
Dim lngDesktopDC As Long
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
lngDesktopHwnd = GetDesktopWindow
lngDesktopDC = GetDC(lngDesktopHwnd)
'filePath为截屏要保存的路径
Me.Visible = False
Me.WindowState = 2
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
' Picture1.Visible = False
Call BitBlt(Picture1.hdc, 0, 0, Screen.Width, Screen.Height, lngDesktopDC, 0, 0, SRCCOPY)
Picture1.Picture = Picture1.Image
Call ReleaseDC(lngDesktopHwnd, lngDesktopDC)
Me.Visible = True
' SavePicture Picture1, filePath '保存图片
End Sub
Private Sub Command1_Click()
saveMyScreen "filePath"
End Sub
复制代码
本文转自:http://im0518.blog.163.com/blog/static/2655641720071022101445585/
两种方法:感觉第一种方法来得直接一些
方法一:
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Sub saveMyScreen(filePath As String)
'filePath为截屏要保存的路径
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
Picture1.Visible = False
Dim lngDesktopHwnd As Long
Dim lngDesktopDC As Long
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
lngDesktopHwnd = GetDesktopWindow
lngDesktopDC = GetDC(lngDesktopHwnd)
Call BitBlt(Picture1.hdc, 0, 0, Screen.Width, Screen.Height, lngDesktopDC, 0, 0, SRCCOPY)
Picture1.Picture = Picture1.Image
Call ReleaseDC(lngDesktopHwnd, lngDesktopDC)
SavePicture Picture1, filePath '保存图片
End Sub
方法二:
'form中放一个按钮和一个图片框
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const theScreen = 0
Const theForm = 1
Private Sub Command1_Click()
Call keybd_event(vbKeySnapshot, theScreen, 0, 0)
DoEvents
Picture1.Picture = Clipboard.GetData(vbCFBitmap)
End Sub
方法一修改后:
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Sub saveMyScreen(filePath As String)
Dim lngDesktopHwnd As Long
Dim lngDesktopDC As Long
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
lngDesktopHwnd = GetDesktopWindow
lngDesktopDC = GetDC(lngDesktopHwnd)
'filePath为截屏要保存的路径
Me.Visible = False
Me.WindowState = 2
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
' Picture1.Visible = False
Call BitBlt(Picture1.hdc, 0, 0, Screen.Width, Screen.Height, lngDesktopDC, 0, 0, SRCCOPY)
Picture1.Picture = Picture1.Image
Call ReleaseDC(lngDesktopHwnd, lngDesktopDC)
Me.Visible = True
' SavePicture Picture1, filePath '保存图片
End Sub
Private Sub Command1_Click()
saveMyScreen "filePath"
End Sub
复制代码
VB截屏(拷贝屏幕图像)代码
图像二值化的VB代码1
VB实用代码,收藏!!
不错VB代码
拷贝一个字符串到另一个代码
个人修养(拷贝)
VB取得系统信息代码
甲骨文称Android移动操作系统拷贝Java代码
拷贝成功(代前言).
计算机等级考试二级VB辅导:图像的特殊技巧
DotNetNuke:Skin.vb代码流程分析
VB.NET访问INI文件代码实现
常用VB操作ACCESS数据库代码
VB获取网卡MAC地址代码
VB.net C# 代码转换工具
几种博客图像的处理代码
图像代码 置入博客的方法
C++中的位拷贝和值拷贝 - liam1122(小亮)的专栏 - CSDN博客
VB或VBA代码转HTML的加载宏
VB treeview使用示例代码(从数据库中读入
一些vb和c java 的代码收藏分享
使用GDI+对图像处理的一些C#代码
vb代码编写教程[高级教程]教你编写出自己的QQ代码
拷贝成功