Printing Graphics File in CVF 6.6

[jkrob]

Hello All,
I've seen Steve Lionel's files on Fortran_WinPrint
and Fortran_WinPrintDirect. Both files seem oriented
twards printing text. I need the ability to print a
BitMapped file created within CVF. Since a BM file is
not "FORMATTED" as a text file would be, how is that
done?

Thanks,

Jeff Krob
jkrob@comcast.net

[pcurtis]

Here is a function for printing bitmaps under Windows. The DIBSECTN code is available from Microsoft (or email me & I'll send a copy; pcurtis@kiltel.com).


FUNCTION print_bitmap (hdc_printer, bitmapId, xpos, ypos, mult, origin) RESULT (res)
USE dfwin
USE dfwinty

IMPLICIT NONE
INTEGER, INTENT(IN) :: hdc_printer, bitmapId, xpos, ypos, origin
REAL, INTENT(IN) :: mult
INTEGER :: rval, res, hdc_screen, hbitmap, hlib
INTEGER :: swide, shigh, pwide, phigh, bwide, bhigh
TYPE(T_RECT) :: rect

! NOTE - use of these functions requires that DIBSECTN.LIB be included
! in the link build and that DIBSECTN.DLL be present in the runtime path

!INTERFACE
! INTEGER(4) FUNCTION DSLoadDIBSectionFromBMPFile (fname, hbitmap, hpalette)
! !DEC$ ATTRIBUTES DLLIMPORT, STDCALL,ALIAS:'_DSLoadDIBSectionFromBMPFile@12':: DSLoadDIBSectionFromBMPFile
! !DEC$ ATTRIBUTES REFERENCE :: fname
! CHARACTER*(*) fname
! INTEGER hbitmap
! INTEGER hpalette
! END FUNCTION DSLoadDIBSectionFromBMPFile
!END INTERFACE

INTERFACE
INTEGER(4) FUNCTION DSDrawDIBSectionOnDC (hdc, hbitmap, lprect)
!DEC$ ATTRIBUTES DLLIMPORT, STDCALL,ALIAS:'_DSDrawDIBSectionOnDC@12':: DSDrawDIBSectionOnDC
INTEGER hdc, hbitmap, lprect
END FUNCTION DSDrawDIBSectionOnDC
END INTERFACE

res = -1 ! cannot load library
hlib = LoadLibrary ('DIBSECTN.DLL'C)
IF (hlib == 0) RETURN

res = -2 ! cannot load bitmap
hbitmap = LoadImageID (ghInstance, bitmapId, IMAGE_BITMAP, 0, 0, LR_CREATEDIBSECTION)
IF (hbitmap /= 0) THEN

! scaling factors, screen to printer
hdc_screen = GetDC (NULL)
CALL GetBitmapSize (hbitmap, hdc_screen, bwide, bhigh)
swide = GetDeviceCaps (hdc_screen, LOGPIXELSX)
shigh = GetDeviceCaps (hdc_screen, LOGPIXELSY)
pwide = GetDeviceCaps (hdc_printer, LOGPIXELSX)
phigh = GetDeviceCaps (hdc_printer, LOGPIXELSY)
rval = ReleaseDC (NULL, hdc_screen)

res = -3 ! bitmap has null extent
IF (bwide /= 0 .AND. bhigh /= 0) THEN
bwide = IFIX(mult*FLOAT(bwide)*FLOAT(pwide)/FLOAT(swide))
bhigh = IFIX(mult*FLOAT(bhigh)*FLOAT(phigh)/FLOAT(shigh))

! displace mapping rectangle wrt local origin
SELECT CASE (origin)

CASE (top_left)
rect%left = xpos
rect%right = xpos + bwide
rect%top = ypos
rect%bottom = ypos + bhigh

CASE (mid_left)
rect%left = xpos
rect%right = xpos + bwide
rect%top = ypos - bhigh/2
rect%bottom = rect%top + bhigh

CASE (bot_left)
rect%left = xpos
rect%right = xpos + bwide
rect%top = ypos - bhigh
rect%bottom = ypos

CASE (top_right)
rect%left = xpos - bwide
rect%right = xpos
rect%top = ypos
rect%bottom = ypos + bhigh

CASE (mid_right)
rect%left = xpos - bwide
rect%right = xpos
rect%top = ypos - bhigh/2
rect%bottom = rect%top + bhigh

CASE (bot_right)
rect%left = xpos - bwide
rect%right = xpos
rect%top = ypos - bhigh
rect%bottom = ypos

END SELECT

res = -4 ! cannot transfer DIB section to printer
IF (DSDrawDIBSectionOnDC (hdc_printer, hbitmap, LOC(rect))) &
res = rect%bottom - rect%top + 1

END IF
rval = DeleteObject (hbitmap)
END IF
rval = FreeLibrary (hlib)

END FUNCTION print_bitmap