Get Capture Screen

'GET Capture Screen

Const BI_RGB = 0

Const DIB_RGB_COLORS = 0     
' color table in RGBs

Const DIB_PAL_COLORS = 1      
' color table in palette indices



Const PATCOPY = &HF00021      
' (DWORD) dest = pattern

Const PATINVERT = &H5A0049  
' (DWORD) dest = pattern XOR dest

Const PATPAINT = &HFB0A09    
' (DWORD) dest = DPSnoo



Private Type POINTAPI

   
x As Long

   
y As Long

End Type



Private Type BITMAPINFOHEADER
'40 bytes

   
biSize As Long

   
biWidth As Long

   
biHeight As Long

   
biPlanes As Integer

   
biBitCount As Integer

   
biCompression As Long

   
biSizeImage As Long

   
biXPelsPerMeter As Long

   
biYPelsPerMeter As Long

   
biClrUsed As Long

   
biClrImportant As Long

End Type



Private Type BITMAPINFO

   
bmiHeader As BITMAPINFOHEADER

End Type



Private Type tBITMAP

   
Header As BITMAPINFO

   
Bytes(0 To 63) As Byte

End Type



Private Declare Function CreateDIBPatternBrushPt Lib "gdi32" _

(lpPackedDIB As Any, ByVal iUsage As Long) As Long

Private Declare Function PlgBlt Lib "gdi32" _

(ByVal hdcDest As Long, lpPoint
As POINTAPI, _

ByVal hdcSrc As Long, ByVal nXSrc As Long, _

ByVal nYSrc As Long, ByVal nWidth As Long, _

ByVal nHeight As Long, ByVal hbmMask As Long, _

ByVal xMask As Long, ByVal yMask As Long) As Long

Private Declare Function PatBlt Lib "gdi32" _

(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _

ByVal nWidth As Long, ByVal nHeight As Long, _

ByVal dwRop As Long) As Long

Private Declare Function GetDC Lib "user32" _

(ByVal hwnd As Long) As Long

Private Declare Function SelectObject Lib "gdi32" _

(ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" _

(ByVal hObject As Long) As Long



Private Sub Form_Paint()

Dim hBrush As Long, tBr
As tBITMAP, Cnt As Long, hOld As Long

Dim Pt(0 To 2)
As POINTAPI



'set the coördinates of the parallelogram

Pt(0).x = 30

Pt(0).y = 10

Pt(1).x = 300

Pt(1).y = 0

Pt(2).x = 0

Pt(2).y = 300



'resize and modify a screenshot

PlgBlt Me.hdc, Pt(0), GetDC(0), 0, 0, Screen.Width / _

Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, _

ByVal 0&, ByVal 0&, ByVal 0&



'initialize the tBITMAP-structure

tBr.Header.bmiHeader.biSize = Len(tBr.Header.bmiHeader)

tBr.Header.bmiHeader.biCompression = BI_RGB

tBr.Header.bmiHeader.biHeight = 8

tBr.Header.bmiHeader.biPlanes = 1

tBr.Header.bmiHeader.biWidth = 8

tBr.Header.bmiHeader.biBitCount = 1



For Cnt = 0 To 7

tBr.Bytes(Cnt) = 128

Next Cnt



'create a pattern brush

hBrush = CreateDIBPatternBrushPt(tBr, DIB_RGB_COLORS)

'select the brush into the form's DC

hOld = SelectObject(Me.hdc, hBrush)

'Perform the Pattern Block Transfer

PatBlt Me.hdc, 0, 0, 30, 30, PATCOPY

'restore the old brush and delete our pattern brush

DeleteObject SelectObject(Me.hdc, hOld)

End Sub