I could not find where
fill_rectangle is defined,
in which module is this subroutine defined ?
Here is a code fragment extracted from the WM_PAINT message handler within a window's proc function, which shows how to read a background image from a windows bitmap (*.bmp) file and display the image centered in the window:
INTEGER :: rval, background_color
TYPE(T_PAINTSTRUCT) :: ps
TYPE(T_RECT) :: clientRect
INTEGER :: WndWidth, WndHeight
INTEGER :: imageWidth, imageHeight
INTEGER(HANDLE) :: hbitmapImage
INTEGER(HANDLE) :: hdcBitmap
INTEGER(HANDLE) :: hgdiobjectOld
CHARACTER(LEN=256) :: fname
fname = 'c:\somepath\somefile.bmp'//CHAR(0)
hbitmapImage = LoadImage (ghInstance, fname, IMAGE_BITMAP, 0, 0, &
LR_LOADFROMFILE)
rval = GetClientRect(hwnd, clientRect)
WndWidth = clientRect%right - clientRect%left
WndHeight = clientRect%bottom - clientRect%top
! create a device context for the current window
rval = BeginPaint (hwnd, ps)
! Erase the background
CALL fill_rectangle (ps%hdc, background_color, clientRect)
! Draw the image
CALL GetBitmapSize (hbitmapImage, ps%hdc, imageWidth, imageHeight)
hdcBitmap = CreateCompatibleDC (ps%hdc)
hgdiobjectOld = SelectObject (hdcBitmap, hbitmapImage)
rval = BitBlt (ps%hdc, &
(WndWidth-imageWidth)/2, &
(WndHeight-imageHeight)/2, &
imageWidth, &
imageHeight, &
hdcBitmap, 0, 0, SRCCOPY)
! clean up
rval = SelectObject (hdcBitmap, hgdiobjectOld)
rval = DeleteDC (hdcBitmap)
rval = DeleteObject (hbitmapImage)
rval = EndPaint (hwnd, ps)
!==== seperate utility used in the above code ====
! Fills width and height with the dimensions, in pixels, of the
! bitmap specified by the bitmap handle, using the metrics of the
! provided device context.
SUBROUTINE GetBitmapSize (hbitmap, hDC, width, height)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hbitmap
INTEGER(HANDLE), INTENT(IN) :: hDC
INTEGER, INTENT(OUT) :: width
INTEGER, INTENT(OUT) :: height
TYPE(T_BITMAPINFO) :: bitmapInfo
INTEGER :: rval
bitmapInfo%bmiHeader%biBitCount = 0
bitmapInfo%bmiHeader%biSize = SIZEOF(bitmapInfo%bmiHeader)
rval = GetDIBits (hDC, hbitmap, 0, 0, 0, LOC(bitmapInfo), &
DIB_RGB_COLORS)
IF (rval == 0) THEN
! error
ELSE
width = bitmapInfo%bmiHeader%biWidth
height = bitmapInfo%bmiHeader%biHeight
END IF
END SUBROUTINE GetBitmapSize
|
|
|
|
|
|
