- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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):
[fortran]
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)
[/fortran]
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:[fortran]
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
[/fortran]
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Try setting the bi%biImageSize to bi%biWidth*bi%biHeight instead of 0
I think the biXPelsPerMeter & biYPelsPerMeter should also be set to non zero values:
eg bi%biXPelsPerMeter = nint(GetDeviceCaps(hDC,LOGPIXELSX))/0.0254)
bi%biYPelsPerMeter = nint(GetDeviceCaps(hDC,LOGPIXELSY))/0.0254)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
@stephen , thanks, the bitmapsize is set OK (dwBmpSize = ((bmpScreen%bmWidth * bi%biBitCount + 31) / 32) * 4 * bmpScreen%bmHeight ) which is put into the header structure.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
bi%biSize = sizeof(bmfHeader)
Did you mean sizeof(bi) ?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
An eagle eyed spot Repeat Offender!!!!
In C++ they use the sizeof on the structure name itself and i have confused BITMAPFILEHEADER BITMAPINFOHEADER in picking a variable to size. It seems to work now on a quick test so I will look at finalising the code now.
If anyone has any words of wisdom on the use of GlobalAlloc & GlobalLock within a fortran application as per mt point 2) it would be appreciated.
. .
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
No insights on GlobalAlloc and GlobalLock, but they do require the user to use GlobalFree to avoid leaking memory and MSDN seems to deprecate them.
I was thinking about your initializers for hdcMemDC and hbmScreen -- Fortran handles that kind of stuff differently from C by creating a variable that is shared between instances. Probably not an issue for your current purposes, but if you write a utility function that is useful enough to eventually get called by something in a message loop, you might end up with multiple active instances and a difficult to debug problem. You can avoid that issue by rewriting the initializers as executable statements and declaring your procedure as RECURSIVE. This requires the Fortran processor to create a separate set of unsaved local variables for each instance.
Another thing I would have done is to rewrite the setup of bi as a Fortran structure constructor with keywords. That way you know that you aren't missing any structure components which is nice to be able to know at a glance because in some contexts C initializes everything to zero by default so something can go wrong if you copy C code that does this and don't initialize some components. Also it's easier to analyze code when the Windows API functions with a lot of arguments are written out with keywords, too. Sometimes you can lose your place in a sea of arguments.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I am not very familliar with C++ so as a started I thought I would just more or less translate the code, get it to work and than move on from there with some improvements. A useful leaning activity. I did note that the code left some structure elements with uninitialised junk and I added some extra inititialisations assignments to fix this. There is no prospect of multiple instances so I won't worry about that but I will bear that in mind.
Thanks.
Andrew
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Here is how I save the entire screen to a file in F90. The dialog proc (omitted) simply requests a filename for the resulting .BMP file. There are quite a few details here which do not appear in the OP's code.
[fortran]
MODULE DlgSaveScreen
USE globals
!USE i f w i n
USE ContWrap
USE ResWrap
USE CmnDlgs
USE Printfunc
PRIVATE
PUBLIC ScreenToBitmapFile
SAVE
CHARACTER(LEN=40) :: fname
CHARACTER(LEN=256) :: fullpath
! bitmap handle has module scope so it can
! be accessed by the proc function
INTEGER(HANDLE) :: hbitmap, hdib
CONTAINS
SUBROUTINE ScreenToBitmapFile
USE charfunc
USE filesubs
! need to replace CVF interfaces
!USE GDI32, Ignore_GetDIBits => GetDIBits, Ignore_cp => CreatePalette
USE GDI32, Ignore_cp => CreatePalette
IMPLICIT NONE
INTEGER(HANDLE) :: hdc, hmemdc, holdbitmap, hpal, ihandl
INTEGER :: ncf, ncp
INTEGER :: rval
INTEGER :: ncolors, lp
INTEGER :: infosize, width, height
TYPE(T_BITMAP) :: bm
TYPE(T_BITMAPINFOHEADER) :: bi
TYPE(T_BITMAPFILEHEADER) :: bfh
TYPE(T_RGBQUAD) :: rgbq
TYPE(T_PALETTEENTRY),DIMENSION(256) :: pe
! custom interface to CreatePalette to pass the arg as an integer LOC()
! passed by value instead of GDI32's version where the argument is a TYPE
! passed by reference
INTERFACE
FUNCTION CreatePalette (arg1)
USE ifwinTY
integer(HANDLE) :: CreatePalette ! HPALETTE
!DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'CreatePalette' :: CreatePalette
integer(LPVOID) arg1 ! LPLOGPALETTE arg1
END FUNCTION
END INTERFACE
! Each row in the BMP is padded to next higher 4 byte boundary.
INTEGER :: Pad, sx
Pad(sx) = ISHFT(ISHFT((sx)+3,-2),2)
!======= STEP 1: PREPARE THE BITMAP==========================================
! this is done BEFORE the savetofile dialog, so that the screen capture is
! immediate, and not screwed up by any time delays in clearing the savetofile
! dialog
! abstract the entire screen (null GetDC arg) as a bitmap
hdc = GetDC (NULL)
width = GetDeviceCaps (hdc, HORZRES)
height = GetDeviceCaps (hdc, VERTRES)
hbitmap = CreateCompatibleBitmap (hdc, width, height)
! memory device context
hmemdc = CreateCompatibleDC (hdc)
holdbitmap = SelectObject (hmemdc, hbitmap)
! copy the image data into the memory device context
rval = BitBlt (hmemdc, 0,0, &
width, height, &
hdc, 0,0, &
SRCCOPY)
! instead of using the LOGPALETTE type, simply block out
! some memory and accomplish the same thing, only this allows
! the paletteentry() array to be associated with a varying
! number of colors
IF (IAND(GetDeviceCaps (hdc, RASTERCAPS), RC_PALETTE) > 0) THEN
lp = MALLOC (8 + 256*SIZEOF(pe(1)))
rval = #300 ! palVersion
CALL CopyMemory (LOC(lp), LOC(rval), 4)
rval = GetSystemPaletteEntries (hdc, 0, 255, pe(1))
CALL CopyMemory (LOC(lp)+4, LOC(rval), 4) ! palNumEntries
CALL CopyMemory (LOC(lp)+8, LOC(pe(1)), 256*SIZEOF(pe(1)))
hpal = CreatePalette (lp)
CALL FREE (lp)
ELSE
hpal = GetStockObject (DEFAULT_PALETTE)
END IF
rval = ReleaseDC (NULL, hdc)
! get the bitmap structure members
rval = GetObject (hbitmap, SIZEOF(bm), LOC(bm))
! fill in the bitmap information structure
bi%biSize = SIZEOF(bi)
bi%biWidth = Pad(bm%bmWidth)
bi%biHeight = bm%bmHeight
bi%biPlanes = 1
bi%biBitCount = bm%bmPlanes * bm%bmBitsPixel
bi%biCompression = BI_RGB
bi%biSizeImage = 0
bi%biXPelsPerMeter = 0
bi%biYPelsPerMeter = 0
bi%biClrUsed = 0
bi%biClrImportant = 0
! number of colors
SELECT CASE (bi%biBitCount)
CASE (1)
ncolors = 2
CASE (4)
ncolors = 16
CASE (8)
ncolors = 256
CASE DEFAULT
ncolors = 0
END SELECT
! size of infoheader and color table
infosize = bi%biSize + ncolors * SIZEOF(rgbq)
! create a device context for the DIB
hdc = GetDC (NULL)
hpal = MSFWIN$SelectPalette (hdc, hpal, FALSE)
rval = RealizePalette (hdc)
! allocate memory for the infoheader and color table
hdib = GlobalAlloc (GMEM_FIXED, infosize)
IF (hdib == 0) THEN
rval = MSFWIN$SelectPalette (hdc, hpal, FALSE)
rval = DeleteObject (hpal)
rval = ReleaseDC (NULL, hdc)
RETURN
END IF
CALL CopyMemory (hdib, LOC(bi), bi%biSize)
! get SizeImage from the device driver
rval = GetDIBits (hmemdc, & ! source device context
hbitmap, & ! bitmap handle
0, & ! first scan line
bi%biHeight, & ! number of lines to copy
0, & ! null--> fills in bitmapinfo only
hdib, & ! addr of bitmapInfo structure
DIB_RGB_COLORS) ! use RGB colors
CALL CopyMemory (LOC(bi), hdib, bi%biSize)
IF (bi%biSizeImage == 0) THEN
bi%biSizeIMage = bi%biHeight * &
(IAND((bi%biWidth*bi%biBitCount + 31), .NOT.(31))/8)
END IF
! enlarge the buffer to hold the pixel data
CALL CopyMemory (hdib, LOC(bi), bi%biSize)
hdib = GlobalReAlloc (hdib, infosize + bi%biSizeImage, GMEM_MOVEABLE)
! get the entire DIB
rval = GetDIBits (hmemdc, & ! source device context
hbitmap, & ! bitmap handle
0, & ! first scan line
bi%biHeight, & ! number of lines to copy
hdib + infosize, & ! memory offset to start addr. for pixel data
hdib, & ! addr of bitmapInfo structure
DIB_RGB_COLORS) ! use RGB colors
rval = MSFWIN$SelectPalette (hdc, hpal, FALSE)
rval = ReleaseDC (NULL, hdc)
!======= STEP 2: SHOW A DIALOG TO GET THE FILENAME & PATH=======================
CALL concat (RootPath(1), BmpDir, fullpath)
fname = 'screen'
IF (ShowModalDialog(IDD_SAVESCREEN, LOC(ScreenSaverProc)) == IDOK) THEN
! prepare the target filename from the provided strings
ncf = INDEX(fname, '.')
IF (ncf > 0) fname(ncf:) = ''
ncf = chcnt (fname, 20)
ncp = chcnt (fullpath, 200)
IF (ncf > 0 .AND. ncp > 0) THEN
fullpath = fullpath(1:ncp)//'\'//fname(1:ncf)//'.bmp'//CHAR(0)
! create the file
ihandl = open_the_file (fullpath, 'W')
IF (ihandl > 0) THEN
! bitmap file header
bfh%bfType = MakeWord (INT1(ICHAR('B')), INT1(ICHAR('M')))
bfh%bfSize = GlobalSize(hdib) + SIZEOF(bfh)
bfh%bfReserved1 = 0
bfh%bfReserved2 = 0
bfh%bfOffBits = SIZEOF(bfh) + infosize
CALL rw_file ('W', ihandl, SIZEOF(bfh), LOC(bfh))
! bitmap info header + colormap + pixel data
CALL rw_file ('W', ihandl, infosize + bi%biSizeImage, hdib)
CALL close_file (ihandl)
END IF
END IF
END IF
! release system resources
rval = DeleteObject (hpal)
rval = DeleteObject (hbitmap)
rval = DeleteDC (hmemdc)
rval = GlobalFree (hdib)
END SUBROUTINE ScreenToBitmapFile
END MODULE DlgSaveScreen
[/fortran]
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
@paul. Thanks for the input, as an aside how did you get the indent formatting for the fortran, did you have to edit after pasting into the post or is the some magic I need to know?
I think the main procedural differance is you have quite a lot of stuff dealing with colour palates which will give smaller bitmaps on old systems using low colour resolution. The method on MSDN captures as true colour (32 bits with padding) and doesn't set a pallate. I am thinking that this is probably uncessary for current hardware. I think there is also bit more 'fiddling' with the data that is handle by the API calls in the OP.
I will have deeper read of the your post to see if there are further points of interest/learning.
Thanks
Andrew
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The WinPrint sample uses GlobalAlloc., etc.
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page