vb.net取屏幕位图 vbs屏幕截图( 二 )


Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
Private Declare Function ObjPtr Lib "msvbvm60.dll" Alias "VarPtr" (Var As Object) As Long
Private Declare Function VarPtr Lib "msvbvm60.dll" (Var As Any) As Long
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long
Private m_MyCreated As Boolean
Private m_MyDibInfo As BITMAPINFOHEADER
Private m_Myhdc As Long
Private m_Myhbitmap As Long
Private m_MyhbitmapOld As Long
Private m_MyBuffer As Long
Private m_MyptrByte As Long
Private m_MyWidth As Long
Private m_MyHeight As Long
Private m_MyLineAdd As Long
Private m_MyPixelAdd As Long
Private m_MyLineByteWidth As Long
Private m_pvDataPtrAdd As Long
Private m_InitPtrFlag As Boolean
Private pByte0(0 To 0) As Byte
Private pByte0Ptr(0 To 0) As Long
Private OldpByte0 As Long
Private OldpByte0Ptr As Long
Private pByte1(0 To 0) As Byte
Private pByte1Ptr(0 To 0) As Long
Private OldpByte1 As Long
Private OldpByte1Ptr As Long
Private p3Dest(0 To 2) As Byte
Private p3ByteDest(0 To 0) As Long
Private Oldp3ByteDest As Long
Private Oldp3ByteDestPtr As Long
Private p3Src(0 To 2) As Byte
Private p3ByteSrc(0 To 0) As Long
Private Oldp3ByteSrc As Long
Private Oldp3ByteSrcPtr As Long
Private pLongAll(0 To 0) As Long
Private pLongAllPtr(0 To 0) As Long
Private OldpLongAll As Long
Private OldpLongAllPtr As Long
Private Function CreateDIB(ByVal Width As Long, ByVal Height As Long, Optional ByVal iBitCount As Integer = 24) As Boolean
If m_MyCreated And m_MyWidth = Width And m_MyHeight = Height And m_MyDibInfo.biBitCount = iBitCount Then
CreateDIB = True
Exit Function
End If
DestoryDIB
If iBitCount24 And iBitCount32 Then
CreateDIB = False
Exit Function
End If
m_MyWidth = Width
m_MyHeight = Height
If m_MyWidth1 Then m_MyWidth = 1
If m_MyHeight1 Then m_MyHeight = 1
【vb.net取屏幕位图 vbs屏幕截图】m_Myhdc = CreateCompatibleDC(0)
If m_Myhdc = 0 Then
m_MyWidth = 0
m_MyHeight = 0
CreateDIB = False
Exit Function
End If
With m_MyDibInfo
.biSize = Len(m_MyDibInfo)
.biWidth = m_MyWidth
.biHeight = m_MyHeight
.biPlanes = 1
.biBitCount = iBitCount
.biCompression = BI_RGB
.biClrImportant = 0
.biXPelsPerMeter = 0
.biYPelsPerMeter = 0
End With
m_Myhbitmap = CreateDIBSection(m_Myhdc, m_MyDibInfo, 0, m_MyBuffer, 0, 0)
If m_Myhbitmap = 0 Then
DeleteDC m_Myhdc
m_Myhdc = 0
m_MyWidth = 0
m_MyHeight = 0
CreateDIB = False
Exit Function
End If
m_MyhbitmapOld = SelectObject(m_Myhdc, m_Myhbitmap)
m_MyptrByte = m_MyBuffer
Dim dpixeladd As Long
dpixeladd = iBitCount \ 8
m_MyPixelAdd = dpixeladd - 3
m_MyLineByteWidth = m_MyWidth * (dpixeladd)
If (m_MyLineByteWidth Mod 4)0 Then m_MyLineByteWidth = m_MyLineByteWidth + (4 - (m_MyLineByteWidth Mod 4))
m_MyCreated = True
CreateDIB = True
End Function
Private Sub DestoryDIB()
If m_MyCreated Then
DeleteObject (SelectObject(m_Myhdc, m_MyhbitmapOld))
DeleteDC m_Myhdc
m_Myhdc = 0
m_Myhbitmap = 0
m_MyhbitmapOld = 0
m_MyBuffer = 0
m_MyptrByte = 0
m_MyCreated = False
End If
End Sub
CreateDIB 就生成了一个指定宽度,高度和颜色为数的位图对象
位图句柄 m_Myhbitmap
设备描述句柄 m_Myhdc
数据区首地址 m_MyBuffer
生成位图对象后,就可以通过BitBlt做需要的处理
要取数时
ReDim bbuffer(0 To m_MyLineByteWidth * m_MyHeight) As Byte
CopyMemory bbuffer(0), ByVal m_MyBuffer, m_MyLineByteWidth * m_MyHeight

推荐阅读