#Include Once"windows.bi"

'h-хендл окна, sFile-путь куда сохранить файл, функция возвращает 0 при успехе
Function WndScreenToBmpFile(h As HWND,sFile As ZString Ptr)As Long
If IsWindow(h)=0 Then Return 1
Dim As DWORD ln=Any,b=Any
Dim As RECT rr=Any
GetWindowRect h,@rr
Dim As HDC hdc=GetDC(h)
If hdc=0 Then Return 3

'заголовки битмапа
Dim As BITMAPFILEHEADER bmfh
Dim As BITMAPINFOHEADER bi
Dim As BITMAPINFO bmInfo
bi.biSize=sizeof(BITMAPINFOHEADER)
bi.biWidth=rr.right-rr.left'ширина
bi.biHeight=rr.bottom-rr.top'высота
bi.biPlanes=1
bi.biBitCount=GetDeviceCaps(hdc,12)'бит на пиксель
bi.biCompression=BI_RGB
ln=(bi.biWidth*bi.biHeight*bi.biBitCount)Shr 3'размер данных
If ln<4 Then Return 2
bmfh.bfType=&h04D42
bmfh.bfSize=ln+sizeof(BITMAPFILEHEADER)+sizeof(BITMAPINFOHEADER)'общий размер
bmfh.bfOffBits=sizeof(BITMAPFILEHEADER)+sizeof(BITMAPINFOHEADER)'смещение до начала данных
bmInfo.bmiHeader.biSize=sizeof(BITMAPINFOHEADER)
bmInfo.bmiHeader.biWidth=bi.biWidth
bmInfo.bmiHeader.biHeight=bi.biHeight
bmInfo.bmiHeader.biPlanes=1
bmInfo.bmiHeader.biBitCount=bi.biBitCount
bmInfo.bmiHeader.biCompression=BI_RGB

Dim As HDC tmpDC=CreateCompatibleDC(hdc)'DC для битмапа
If tmpDC=0 Then ReleaseDC h,hDC:Return 3

Dim As Any Ptr pBits=Any'сюда функция поместит указатель на созданный массив данных
Dim As HBITMAP bitmap=CreateDIBSection(hdc,@bmInfo,DIB_PAL_COLORS,@pBits,0,0)
If bitmap=0 Then
    ReleaseDC h,hDC
    DeleteDC tmpDC
    Return 4
EndIf

'запись скрина в bitmap
SelectObject tmpDC,bitmap
PrintWindow h,tmpDC,0

'создание файла
Dim As HANDLE hFile=CreateFile(sFile,GENERIC_WRITE,0,0,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0)
If hFile=-1 Then
    Function=5
Else
'запись в файл 2 заголовков и массива данных пикселей
    WriteFile hFile,@bmfh,sizeof(BITMAPFILEHEADER),@b,0
    WriteFile hFile,@bi,sizeof(BITMAPINFOHEADER),@b,0
    WriteFile hFile,pBits,ln,@b,0
    CloseHandle hFile
EndIf
DeleteObject bitmap
DeleteDC tmpDC
ReleaseDC h,hDC
End Function

'пример вызова. Следует задать нужные вам хендл окна и путь сохранения
Dim As Long r=WndScreenToBmpFile(3408064,"1.bmp")

'перечень всех возвращаемых значений и показ сообщения(не обязательное)
Dim As ZString Ptr MsgTbl(5)={_
@"Done!",_
@"Not exist window",_
@"Not wisible window",_
@"Couldn't create DC",_
@"Couldn't create bitmap",_
@"Couldn't create file"}
MessageBox 0,MsgTbl(r),"WndScreenToBmpFile",0