Спасибо оба способа работают.Моя прога через timer постоянно делает скриншот раб.стола и сохраняет в файл. Если использовать программное нажатие клавиши printscreen, то это сильно грузит процессор.Вторым способом, с помощью bitblt, вставляю скриншот в picturebox, скриншот появляется на Picturebox, но сохранить с него не могу!SavePicture не помогает!Кто знает как сохранить?
Вот попробуй это кинь на форму Picture1, и тимер. Вставь следущий код длжено работать.
Option Explicit
Private Declare Function StretchBlt Lib "gdi32" _
 ByVal hdc 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 hSrcWidth As Long, ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long
' **************************
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Const SRCCOPY = &HCC0020
Dim Papi As POINTAPI
Private Sub Form_Load()
Picture1.AutoRedraw = True
Picture1.ScaleMode = 3
Timer1.Interval = 100
End Sub
Sub ChacheActiveWindow()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@allapi.net
Dim hBrush As Long, tBr As tBITMAP, cnt As Long, hOld As Long
Dim mesto As RECT
Dim l As Long
Dim wid As Long
Dim hid As Long
Dim s As String
Dim hddc As Long
l = GetForegroundWindow
s = "АКНО!!!"
hddc = GetWindowDC(l)
Call GetWindowRect(l, mesto)
With mesto
wid = .Right - .Left
hid = .Bottom - .Top
End With
Picture1.Width = wid * Screen.TwipsPerPixelX
Picture1.Height = hid * Screen.TwipsPerPixelY
Dim Pt(0 To 2) As POINTAPI
'set the coördinates of the parallelogram
Pt(0).X = 0
Pt(0).Y = 0
Pt(1).X = wid
Pt(1).Y = 0
Pt(2).X = 0
Pt(2).Y = hid
'resize and modify a screenshot
Picture1.Cls
PlgBlt Picture1.hdc, Pt(0), hddc, 0, 0, wid, hid, ByVal 0&, ByVal 0&, ByVal 0&
'initialize the tBITMAP-structure
With tBr.Header.bmiHeader
.biSize = Len(tBr.Header.bmiHeader)
.biCompression = BI_RGB
.biHeight = 8
.biPlanes = 1
.biWidth = 8
.biBitCount = 1
End With
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(Picture1.hdc, hBrush)
'Perform the Pattern Block Transfer
PatBlt Picture1.hdc, 0, 0, 1, 1, PATCOPY
'restore the old brush and delete our pattern brush
 eleteObject SelectObject(Me.hdc, hOld)
Call DeleteDC(hddc)
Call SavePicture(Picture1.Image, App.Path & "\" & s & ".bmp"
End Sub
Несколькоизвращенный метод скришотит активное окно и сохраняет в файл. Причем можно его при желании исказить.
P.S. Думаю, API не сложно подобрать, какие здесь используются )