I am looking for a little help and advice. Yesterday I converted (and customised a little) a C++ routine that can capture a window based on its handle and save it as a bitmap file. Yes I know there are some QuickWin functions that can do this but some of the windows I need to capture are not Quickwin (e.g. OpenGL) so hence using the windows API. The C++ is at MSDN Topic "Capturing an Image". I tested The C++ and it creates a succesful BMP. In fortran the preamble 'test parts' that grab the desktop image, shrink it and display it in the window selected work OK but the BMP file created is not valid. Having interogated the BMP file the bit map header and information header are OK, the problem is the pixeldata part of the file is totally filled with null data. The file size is correct. Based on that and some debugging it looks like either the grabbing the data to memory or the pointers to data are incorrect. When I interrogate the location pointed to by 'ilpbitmap' that has a load on nulls. I am guessing the issue is in on of the following statements (extracted from the complete source posted below):
bret = BitBlt(hdcMemDC,0,0,rcClient%right-rcClient%left, rcClient%bottom-rcClient%top,hdcWindow,0,0,SRCCOPY) hDIB = GlobalAlloc(GHND,dwBmpSize) ilpbitmap = GlobalLock(hDIB) isint = GetDIBits(hdcWindow, hbmScreen, 0,bmpScreen%bmHeight, ilpbitmap, loc(bi), DIB_RGB_COLORS) bret = WriteFile(hFile, ilpbitmap, dwBmpSize, loc(dwBytesWritten), NULL)
My questions are:
1) Any suggestions as to what the problem might be?
2) Is the use of GlobalAlloc & GlobalLock within a fortran application wrong/bad? My feeling is I should probably be using allocate to create a buffer for the data.
The full source is:
module capture_image use ifwin implicit none private public :: CaptureAnImageToBMP_file public :: bmp_read !public :: test_write( contains subroutine CaptureAnImageToBMP_file(hWnd,gfile,istat) !based largely on parts of C++ example at http://msdn.microsoft.com/en-us/library/windows/desktop/dd183402(v=vs.85).aspx !MSDN Topic "Capturing an Image" // GDI_CapturingAnImage.cpp : Defines the entry point for the application. implicit none integer(handle),intent(in) :: hWnd !handle to window to capture character(len=*),intent(in) :: gfile !name of BMP file to write, must be c string integer, intent(out) :: istat !error status 0=OK, <0 NOK integer(handle) :: hdcScreen,hdcWindow ! hDc integer(handle) :: hdcMemDC = NULL ! hDc type(t_rect) :: rcClient integer(bool) :: bret integer(sint) :: isint integer(handle) :: hbmScreen = NULL ! HBITMAP integer(LPVOID) :: ilpvoid ! HGDIOBJ type(t_bitmap) :: bmpscreen type(t_BITMAPFILEHEADER) :: bmfHeader type(t_BITMAPINFOHEADER) :: bi integer(DWORD) :: dwBmpSize integer(HANDLE) :: hDIB integer(LPVOID) :: ilpbitmap integer(HANDLE) :: ihan ! HGLOBAL integer(HANDLE) :: hfile integer(DWORD) :: dwBytesWritten, dwSizeofDIB ! istat=0 !assume OK ! Retrieve the handle to a display device context for the client area of the window. hdcScreen = GetDC(NULL) hdcWindow = GetDC(hWnd) ! Create a compatible DC which is used in a BitBlt from the window DC hdcMemDC = CreateCompatibleDC(hdcWindow) if(hdcMemDC.eq.0) then !"CreateCompatibleDC has failed" istat=-1 goto 999 endif ! Get the client area for size calculation bret=GetClientRect(hWnd, rcClient) !This is the best stretch mode isint=SetStretchBltMode(hdcWindow,HALFTONE) !The source DC is the entire screen and the destination DC is the current window (HWND) bret=StretchBlt(hdcWindow,0,0,rcClient%right, rcClient%bottom,hdcScreen,0,0, & GetSystemMetrics (SM_CXSCREEN),GetSystemMetrics (SM_CYSCREEN),SRCCOPY) if(bret.eq.0) then ! "StretchBlt has failed" istat=-2 goto 999 endif ! Create a compatible bitmap from the Window DC hbmScreen = CreateCompatibleBitmap(hdcWindow, rcClient%right-rcClient%left, rcClient%bottom-rcClient%top) if(hbmScreen.eq.0) then !"CreateCompatibleBitmap Failed" istat=-3 goto 999 endif ! Select the compatible bitmap into the compatible memory DC. ilpvoid=SelectObject(hdcMemDC,hbmScreen) ! Bit block transfer into our compatible memory DC (hdcWindow is source handle, hdcMemDC is target handle) bret = BitBlt(hdcMemDC,0,0,rcClient%right-rcClient%left, rcClient%bottom-rcClient%top,hdcWindow,0,0,SRCCOPY) if(bret.eq.0) then !"BitBlt has failed" istat=-4 goto 999 endif ! Get the BITMAP from the HBITMAP isint = GetObject(hbmScreen,sizeof(bmpScreen),loc(bmpScreen)) bi%biSize = sizeof(bmfHeader) bi%biWidth = bmpScreen%bmWidth bi%biHeight = bmpScreen%bmHeight bi%biPlanes = 1 bi%biBitCount = 32 bi%biCompression = BI_RGB bi%biSizeImage = 0 bi%biXPelsPerMeter = 0 bi%biYPelsPerMeter = 0 bi%biClrUsed = 0 bi%biClrImportant = 0 dwBmpSize = ((bmpScreen%bmWidth * bi%biBitCount + 31) / 32) * 4 * bmpScreen%bmHeight ! Starting with 32-bit Windows, GlobalAlloc and LocalAlloc are implemented as wrapper functions that ! call HeapAlloc using a handle to the process's default heap. Therefore, GlobalAlloc and LocalAlloc ! have greater overhead than HeapAlloc. hDIB = GlobalAlloc(GHND,dwBmpSize) !! char *lpbitmap = (char *) GlobalLock(hDIB) !hmmmm ilpbitmap = GlobalLock(hDIB) ! Gets the "bits" from the bitmap and copies them into a buffer which is pointed to by ilpbitmap isint = GetDIBits(hdcWindow, hbmScreen, 0,bmpScreen%bmHeight, ilpbitmap, loc(bi), DIB_RGB_COLORS) ! A file is created, this is where we will save the screen capture. hFile = CreateFile(gfile//char(0), GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL) ! Add the size of the headers to the size of the bitmap to get the total file size dwSizeofDIB = dwBmpSize + sizeof(bmfHeader) + sizeof(bi) ! Offset to where the actual bitmap bits start. bmfHeader%bfOffBits = sizeof(bmfHeader) + sizeof(bi) !Size of the file bmfHeader%bfSize = dwSizeofDIB !bfType must always be BM for Bitmaps bmfHeader%bfType = int(z'4D42') !; //BM bmfHeader%bfReserved1 = 0 bmfHeader%bfReserved2 = 0 dwBytesWritten = 0 bret = WriteFile(hFile, loc(bmfHeader), sizeof(bmfHeader), loc(dwBytesWritten), NULL) bret = WriteFile(hFile, loc(bi), sizeof(bi), loc(dwBytesWritten), NULL) bret = WriteFile(hFile, ilpbitmap, dwBmpSize, loc(dwBytesWritten), NULL) ! Unlock and Free the DIB from the heap bret = GlobalUnlock(hDIB) ihan = GlobalFree(hDIB) ! Close the handle for the file that was created bret = CloseHandle(hFile) 999 continue !cleanup bret = DeleteObject(hbmScreen) bret = DeleteObject(hdcMemDC) isint = ReleaseDC(NULL,hdcScreen) isint = ReleaseDC(hWnd,hdcWindow) return end subroutine CaptureAnImageToBMP_file