2016-11-8
18:41

root
root

[程序代码]截取图片

=======================按键截取===================
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Sub Command1_Click()
Call keybd_event(vbKeySnapshot, 0, 0, 0)     '全屏
End Sub

Private Sub Command2_Click()
Call keybd_event(vbKeySnapshot, 1, 0, 0)     '当前窗体
End Sub

Private Sub Command3_Click()
SavePicture Clipboard.GetData, "C:\图片.bmp" '保存图片
End Sub
=========================非(按键截取)===========================
Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 Sub Form_Load()
    Me.Hide                '窗体不可见
    On Error Resume Next   '出错忽略
    Me.AutoRedraw = True   '自动重画
    Timer1.Interval = 1000 '每十秒一抓
End Sub

Private Sub Timer1_Timer()
BitBlt hDC, 0, 0, Screen.Width, Screen.Height, GetDC(0), 0, 0, vbSrcCopy   '抓屏
SavePicture Me.Image, "c:\图片.BMP"    '保存
End Sub
=========================指定区域截取===========================
Option Explicit
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (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 Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Sub ScrnCap(Lt As Integer, top As Integer, Rt As Integer, Bot As Integer) '屏幕截图核心函数
Dim rWidth, rHeight, SourceDC, DestDC, BHandle, Wnd, DHandle
rWidth = Rt - Lt
rHeight = Bot - top
SourceDC = CreateDC("DISPLAY", 0, 0, 0)
DestDC = CreateCompatibleDC(SourceDC)
BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
SelectObject DestDC, BHandle
BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Lt, top, &HCC0020
Wnd = Screen.ActiveForm.hwnd
OpenClipboard Wnd
EmptyClipboard
SetClipboardData 2, BHandle
CloseClipboard
DeleteDC DestDC
ReleaseDC DHandle, SourceDC
End Sub

Private Sub Command1_Click()
Call ScrnCap(0, 0, 100, 300) '4个参数分别为:左上角X,左上角Y,右上角X,右上角Y
Image1.Picture = Clipboard.GetData()
End Sub
=========================裁剪图片=========================
Private Sub Command1_Click()
Dim fn As String, xx As Single, yy As Single, ww As Single, hh As Single
'fn = "c:\1.bmp"   '裁剪图片名及路径
xx = 500           '裁剪横坐标
yy = 500           '裁剪纵坐标
ww = 100           '裁剪宽度
hh = 100           '裁剪高度
Picture1.Width = ww
Picture1.Height = hh
Picture1.PaintPicture Picture1.Picture, 0, 0, ww, hh, xx, yy, ww, hh
Picture2.Picture = Picture1.Image
End Sub

Private Sub Form_Load()
Me.ScaleMode = 3
Picture1.Visible = False
Picture1.BorderStyle = 0
Picture1.AutoRedraw = True
Picture1.ScaleMode = 3
End Sub
文章如需转载请注明:转载自: 紫灵幽梦
« 上一篇 下一篇 »

相关文章:

vb读取access并且显示  (2017-5-11 9:18:27)

VB 获取CPU温度示例  (2017-5-8 10:35:11)

VB程序逆向反汇编常见的函数   (2017-5-8 10:32:0)

VB内嵌汇编的模块示例  (2017-5-8 10:24:4)

内存数据的读写(PC)   (2017-3-1 17:51:40)

用VB制作外挂   (2017-3-1 16:16:53)

发表留言: