Somerick | Дата: Воскресенье, 24.07.2016, 21:09 | Сообщение # 1 |
Рядовой
Группа: Пользователи
Сообщений: 14
Статус: Offline
| Принцип создания BMP, затем запись в файл.
Работает для окон которые закрыты другими. Для свёрнутых, невидимых - нет.
Код #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
|
|
| |