/code/ Сохраняем экранную область в BMP файл

[Dark Machine]

Код: Выделить всё

'==============================================
'  Сохраняем экранную область в BMP файл
'
' hParam -   Указатель на структуру RECT с координатами области
'                 Можно использовать хендл окна
'                 Если передать ноль (0), то будет сохранён весь экран
'
' sBmpFile - Имя файла. Глубина цвета в сохраняемом файле 32 бит 
'
' Пример вызова.
'
'  rc.nLeft      = 100
'  rc.nTop      = 100
'  rc.nRight    = 200
'  rc.nBottom = 300
'
'  CaptureWindow VarPtr(rc), "c:\test.bmp"
'
'==============================================
'
FUNCTION CaptureWindow(BYVAL hParam AS DWORD, BYVAL sBmpFile AS STRING) AS LONG
  LOCAL hDC AS DWORD, hMemDC AS DWORD, hMemBmp AS DWORD, rc AS RECT
  LOCAL bm AS BITMAP, bmi AS BITMAPINFO
  LOCAL bmpFileHdr AS BITMAPFILEHEADER, dwWidthBytes AS DWORD, hFile AS LONG

  ' Must have file name...
  IF LEN(sBmpFile) = 0 THEN EXIT FUNCTION

  ' Default to desktop window...
  IF IsWindow(hParam) THEN

     ' Obtain entire window area...
     GetWindowRect hParam, rc
  ELSE
     IF ISTRUE IsBadReadPtr(hParam, SIZEOF(RECT)) THEN
        ' If RECT pointer is invalid (and no window specified), get desktop size...
        SetRect rc, 0, 0, GetSystemMetrics(%SM_CXSCREEN), GetSystemMetrics(%SM_CYSCREEN)
     ELSE
        ' Get specified desktop area...
        POKE$ VARPTR(rc), PEEK$(hParam, SIZEOF(RECT))
     END IF
  END IF

  ' Create hidden DC and copy window contents...
  hDc = CreateDC("DISPLAY", BYVAL %Null, BYVAL %Null, BYVAL %Null)
  hMemDC = CreateCompatibleDC(hDC)
  bmi.bmiHeader.biSize = SIZEOF(bmi.bmiHeader)
  bmi.bmiHeader.biWidth = (rc.nRight - rc.nLeft)
  bmi.bmiHeader.biHeight = (rc.nBottom - rc.nTop)

  ' Four byte alignment...
  dwWidthBytes = bmi.bmiHeader.biWidth + (bmi.bmiHeader.biWidth MOD 4)

  bmi.bmiHeader.biPlanes = 1
  bmi.bmiHeader.biBitCount = 32
  bmi.bmiHeader.biCompression = %BI_RGB
  hMemBmp = CreateDIBSection(hMemDC, bmi, %DIB_RGB_COLORS, %NULL, 0, 0)

  SelectObject hMemDC, hMemBmp
  GetObject hMemBmp, SIZEOF(bm), bm
  BitBlt hMemDC, 0, 0, bm.bmWidth, bm.bmHeight, hDC, rc.nLeft, rc.nTop, %SRCCOPY

  bmpFileHdr.bfType = CVI("BM")
  bmpFileHdr.bfOffBits = 54

  bmpFileHdr.bfSize = SIZEOF(bmpFileHdr) + (dwWidthBytes * bm.bmHeight)

  ' Write to disk...
  LOCAL BMP_Data  AS STRING
  BMP_Data  = bmpFileHdr & bmi.bmiHeader & PEEK$(bm.bmBits, bm.bmWidthBytes * bm.bmHeight)

  hFile = FREEFILE
  OPEN sBmpFile FOR OUTPUT AS #hFile
  PRINT #hFile, BMP_Data;
  CLOSE hFile
  IF ERR = 0 THEN FUNCTION = %TRUE

  ' Clean up and exit...
  DeleteDC hDC
  DeleteDC hMemDC
  DeleteObject hMemBmp

END FUNCTION