Tweet
please reply to: http://www.powerbasic.com/support/pb...ad.php?t=18298
[CODE]'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
' file: prn_test.rc
#include "resource.h"
cancelprintdlgbox dialog 40, 40, 120, 40
style ws_popup | ws_caption | ws_sysmenu | ws_visible
font 10, "arial"
begin
ctext "cancel printing", -1, 4, 6, 120, 12
defpushbutton "cancel", idcancel, 44, 22, 32, 14, ws_group
end
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
' !!!!! snip here !!!!!
'------------------------------------------------------------------------------
' file: prn_test.bas
' prn_test.bas by ian cairns, may 3, 2001. - use and modify freely.
' revised may 8, 2001: parameters changed for print functions.
' added enumprinters() function modified from george bleck's code
' may 10, 2001: paintpage() function modified to create bitmap from actual hdc
' rather than compatible memory hdc
'------------------------------------------------------------------------------
' information to construct this program was freely stolen from a number
' of people from this forum including: lance edmonds, don dickinson,
' jim seekamp, charles dietz, semen matusovski, patrice terrier, keith waters,
' george bleck
' (apologies to those whose names i have inadvertently left out of this list)
'------------------------------------------------------------------------------
' the test program demonstrates using the printer setup dialog boxes
' and the page setup dialog boxes. it also demonstrates printing to
' either screen or printer by using direct calls to the dc, or by
' painting to a device compatible bitmap and bitblt-ing the result
' to the dc.
' when printing, a rectangle is drawn to the selected margins and
' both the text and circle are centered within the margins.
'------------------------------------------------------------------------------
' problem: the bitmap printing to a printer works fine in win98, but will not
' work properly in win nt (version 4 sp4). the graphics are printed ok, but text
' does not appear. all of the api return values indicate success. checking the values
' of the font selected into the 'print' bitmap return expected values. the font
' even overwrites the graphics as expected. but it is as if the font is painted
' with a null brush even though text colour is set with settextcolor()!
' (gettextcolor() returns the proper colour).
' i am still stuck here. does someone have a solution?
'------------------------------------------------------------------------------
' update: may 16, 2001: my problem was a bad printer driver. the program
' should work properly on all printers with a good printer driver.
'------------------------------------------------------------------------------
$dim all
$compile exe
$register none
$debug error on
$option version4
#include "win32api.inc"
#include "comdlg32.inc"
$resource "prn_test.pbr" ' resource contains cancel dialog
'------------------------------------------------------------------------------
' function declares
declare function printprocedure(psdinfo as pagesetupdlga, _
printmode as long, docname as string) as long
declare function printpage(hdcprn as long, printmode as long, docname as string, _
psdinfo as pagesetupdlga) as long
' page setup dialog declare! no in the win32api.inc
declare function pagesetupdlg lib "comdlg32.dll" alias "pagesetupdlga" (lppsd as pagesetupdlga) as long
'------------------------------------------------------------------------------
%idm_pagesetup = 1
%idm_print = 2
%idm_mode_direct = 3
%idm_mode_bitmap = 4
%idm_exit = 5
%mode_direct = 0
%mode_bitmap = 1
%pointsize = 48 ' alter this value for the text size
global gszcancelprinttext as asciiz * 30, _
guserabort as long,_
ghcancelprintdlg as long, _
glffacename as string
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function winmain (byval hcurrinstance as long,_
byval hprevinstance as long,_
lpcmdline as asciiz ptr,_
byval ncmdshow as long) as long
local msg as tagmsg, _
wclass as wndclassex, _
hwnd as dword, __
szclassname as asciiz * 20, _
szcaption as asciiz * 20
' initialize
' ~~~~~~~~~~
glffacename = "arial" ' alter this value to change fonts
szclassname = "printer_testbed32"
szcaption = "print test program"
' fill window class structure
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~
wclass.cbsize = sizeof(wclass)
wclass.style = 0 ' removed %cs_hredraw or %cs_vredraw to eliminate flickering on resize
wclass.lpfnwndproc = codeptr(mainwndproc)
wclass.cbclsextra = 0
wclass.cbwndextra = 0
wclass.hinstance = hcurrinstance
wclass.hicon = loadicon (%null, byval %idi_application)
wclass.hcursor = loadcursor(%null, byval %idc_arrow)
wclass.hbrbackground = getstockobject(%white_brush)
wclass.lpszmenuname = %null
wclass.lpszclassname = varptr(szclassname)
wclass.hiconsm = loadicon (%null, byval %idi_application)
' register the window-class
' ~~~~~~~~~~~~~~~~~~~~~~~~~
call registerclassex (wclass)
' create the main window
' ~~~~~~~~~~~~~~~~~~~~~~
hwnd = createwindow (szclassname, szcaption, %ws_overlappedwindow, _
%cw_usedefault, %cw_usedefault, %cw_usedefault, %cw_usedefault,_
%hwnd_desktop, %null, hcurrinstance, %null)
call showwindow (hwnd, ncmdshow)
call updatewindow (hwnd)
' main message loop of program
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
while getmessage(msg, %null, 0, 0)
call translatemessage (msg)
call dispatchmessage (msg)
wend
' clean up and assign return value
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function = msg.wparam
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function mainwndproc(byval hwnd as dword,_
byval wmsg as dword,_
byval wparam as dword,_
byval lparam as dword) export as long
static hmenu as long, _
hmenupopup as long, _
printmode as long, _
docname as string, _
hmapbmp as long, _
hmemdc as long, _
drect as rect, _
idevmode as long, _
idevnames as long, _
psdinfo as pagesetupdlga, _
prdinfo as printdlgapi, _
devmodeinfo as devmode, _
devptr as devmode ptr
local hdc as long,_
ps as paintstruct, _
retval as long, _
otext as string
select case wmsg
case %wm_create
' ~~~~~~~~~~~~~~~~
' create menu
hmenu = createmenu ()
hmenupopup = createmenu ()
call appendmenu (hmenupopup, %mf_string, %idm_pagesetup, "page &setup ...")
call appendmenu (hmenupopup, %mf_string, %idm_print , "&print ...")
call appendmenu (hmenupopup, %mf_separator, 0, ")
call appendmenu (hmenupopup, %mf_string, %idm_mode_direct, "mode: print direct")
call appendmenu (hmenupopup, %mf_string, %idm_mode_bitmap, "mode: print bitmap")
call appendmenu (hmenupopup, %mf_separator, 0, ")
call appendmenu (hmenupopup, %mf_string, %idm_exit, "e&xit")
call appendmenu (hmenu, %mf_popup, hmenupopup, "&file")
call setmenu (hwnd, hmenu)
call checkmenuitem(hmenu, %idm_mode_direct, %mf_checked)
printmode = %mode_direct ' alternate: %mode_bitmap
docname = "print mode: direct print"
' setup printsetupdialog structure
psdinfo.lstructsize = sizeof(psdinfo)
psdinfo.hwndowner = hwnd
psdinfo.flags = %psd_returndefault
' get default printer and default setup
call pagesetupdlg (psdinfo)
' change flags
psdinfo.flags = psdinfo.flags xor %psd_returndefault
psdinfo.flags = psdinfo.flags or %psd_margins
' setup printdialog structure
prdinfo.lstructsize = sizeof(prdinfo)
prdinfo.hwndowner = hwnd
prdinfo.flags = %pd_allpages or %pd_hideprinttofile or %pd_noselection
' get current window size for painting
call getclientrect (hwnd, drect)
function = 0
case %wm_syscommand
' ~~~~~~~~~~~~~~~~~~~
' intercept message for repainting if window is resized via system command
if wparam = %sc_maximize or wparam = %sc_restore then
call postmessage(hwnd, %wm_exitsizemove, %null, %null)
end if
function = defwindowproc(hwnd, wmsg, wparam, lparam)
case %wm_exitsizemove
' ~~~~~~~~~~~~~~~~~~~~~
call getclientrect (hwnd, drect)
if printmode = %mode_bitmap then ' need to make a new bitmap for a re-sized screen
hdc = %null
call paintpage(hdc, hmemdc, hmapbmp, drect, docname, printmode)
end if
call invalidaterect(hwnd, byval %null, byval %true)
function = 0
case %wm_command
' ~~~~~~~~~~~~~~~~
hmenu = getmenu (hwnd)
select case lowrd(wparam)
' ~~~~~~~~~~~~~~~~~~~~~~~~~
case %idm_mode_bitmap, %idm_mode_direct ' toggle between states
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if printmode = %mode_direct then
printmode = %mode_bitmap
docname = "print mode: bitmap print"
call checkmenuitem(hmenu, %idm_mode_direct, %mf_unchecked)
call checkmenuitem(hmenu, %idm_mode_bitmap, %mf_checked)
hdc = %null ' use to make a bitmap for the screen
call getclientrect (hwnd, drect)
call paintpage(hdc, hmemdc, hmapbmp, drect, docname, printmode)
else
printmode = %mode_direct
docname = "print mode: direct print"
call checkmenuitem(hmenu, %idm_mode_bitmap, %mf_unchecked)
call checkmenuitem(hmenu, %idm_mode_direct, %mf_checked)
end if
call invalidaterect(hwnd, byval %null, byval %true)
function = 0
case %idm_pagesetup
' ~~~~~~~~~~~~~~~~~~~
retval = pagesetupdlg (psdinfo)
if retval > 0 and psdinfo.hdevmode then
' release duplicate global hdevmode/hdevnames info
if prdinfo.hdevmode <> psdinfo.hdevmode and prdinfo.hdevmode <> 0 then
globalfree prdinfo.hdevmode
end if
if prdinfo.hdevnames <> psdinfo.hdevnames and prdinfo.hdevnames <> 0 then
globalfree prdinfo.hdevnames
end if
' syncronize hdevmode/hdevnames info
prdinfo.hdevmode = psdinfo.hdevmode
prdinfo.hdevnames = psdinfo.hdevnames
end if
function = 0
case %idm_print
' ~~~~~~~~~~~~~~~
if printdlg(prdinfo) <> 0 then
' release duplicate global hdevmode/hdevnames info
if psdinfo.hdevmode <> prdinfo.hdevmode and psdinfo.hdevmode <> 0 then
globalfree psdinfo.hdevmode
end if
if psdinfo.hdevnames <> prdinfo.hdevnames and psdinfo.hdevnames <> 0 then
globalfree psdinfo.hdevnames
end if
' syncronize hdevmode/hdevnames info
psdinfo.hdevmode = prdinfo.hdevmode
psdinfo.hdevnames = prdinfo.hdevnames
call printprocedure(psdinfo, printmode, docname)
end if
function = 0
case %idm_exit
' ~~~~~~~~~~~~~~
if hmemdc <> 0 then deletedc hmemdc : hmemdc = 0
if hmapbmp <> 0 then deleteobject hmapbmp : hmapbmp = 0
if psdinfo.hdevmode then
if prdinfo.hdc <> %null then
call releasedc(hwnd, prdinfo.hdc)
end if
globalfree psdinfo.hdevmode
globalfree psdinfo.hdevnames
psdinfo.hdevmode = 0
end if
postquitmessage 0
function = 0
end select
case %wm_paint
' ~~~~~~~~~~~~~~
hdc = beginpaint (hwnd, ps)
if printmode = %mode_bitmap then
call bitblt(hdc, 0, 0, drect.nright, drect.nbottom, hmemdc, 0, 0, %srccopy)
else
call paintpage(hdc, hmemdc, hmapbmp, drect, docname, printmode)
end if
call endpaint (hwnd, ps)
function = 0
case %wm_destroy
' ~~~~~~~~~~~~~~~~
if hmemdc <> 0 then deletedc hmemdc : hmemdc = 0
if hmapbmp <> 0 then deleteobject hmapbmp : hmapbmp = 0
if psdinfo.hdevmode then
if prdinfo.hdc <> %null then
call releasedc(hwnd, prdinfo.hdc)
end if
globalfree psdinfo.hdevmode
globalfree psdinfo.hdevnames
end if
call postquitmessage (0)
function = 0
case else
' ~~~~~~~~~
function = defwindowproc (hwnd, wmsg, wparam, lparam)
end select
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function paintpage(hdc as long, hmemdc as long, hmapbmp as long, _
drect as rect, docname as string, printmode as long) as long
' function altered may 10, 2001
local lffont as logfont, _
hbrush as long, _ ' brush handles
hbrushold as long, _
hpen as long, _ ' pen handle
hpenold as long, _
hfont as long, _ ' font handle
hfontold as long, _
otext as string, _ ' temporary container for text
recta as rect, _
tm as textmetric, _
xsize as sizel, _
retval as long, _
gethdcflag as long
dim pt(0:1) as local pointapi
gethdcflag = %false ' allows us to delete a temporary screen hdc
if printmode = %mode_bitmap then
if getdevicecaps(hdc, %rastercaps) and %rc_bitblt <> %rc_bitblt then
msgbox "selected device cannot print bitmaps! "
function = %true
exit function
end if
' create device dependant bitmap
hmemdc = createcompatibledc (hdc)
if hdc = %null then
hdc = getdc(%hwnd_desktop)
gethdcflag = %true
end if
' create bitmap compatible with dc (allows colors for the screen/printer)
hmapbmp = createcompatiblebitmap (hdc, drect.nright-drect.nleft, drect.nbottom-drect.ntop)
if gethdcflag = %true then
call releasedc(%hwnd_desktop, hdc)
end if
call selectobject (hmemdc, hmapbmp)
' fill the background
hbrush = getstockobject(%white_brush)
hbrushold = selectobject(hmemdc, hbrush)
call patblt(hmemdc, 0, 0, drect.nright-drect.nleft, drect.nbottom-drect.ntop, %patcopy)
' delete brush
call selectobject(hmemdc, hbrushold)
call deleteobject(hbrush)
else
hmemdc = hdc
end if
' set background mode to opaque
call setbkmode (hmemdc, %opaque)
' black pen 1/16 inch in width
xsize.cx = getdevicecaps(hmemdc, %logpixelsx)/32
xsize.cy = getdevicecaps(hmemdc, %logpixelsy)/32
hpen = createpen(%ps_solid, xsize.cx*2 , &h0 )
hpenold = selectobject(hmemdc, hpen)
' draw a rectangle at the margins, allowing for penwidth and 1 device point offset.
call rectangle(hmemdc, drect.nleft + xsize.cx, drect.ntop+xsize.cy, _
drect.nright - xsize.cx +1, drect.nbottom - xsize.cy +1)
' draw lines from edge to edge
call movetoex(hmemdc, drect.nleft + xsize.cx, drect.ntop + xsize.cy, byval %null)
call lineto(hmemdc, drect.nright - xsize.cx, drect.nbottom - xsize.cy)
call movetoex(hmemdc, drect.nright - xsize.cx, drect.ntop + xsize.cy, byval %null)
call lineto(hmemdc, drect.nleft + xsize.cx, drect.nbottom - xsize.cy)
' delete pen
call selectobject (hmemdc, hpenold)
call deleteobject (hpen)
' save dc as we change map modes.
call savedc (hmemdc)
' change map modes/extents
call setmapmode (hmemdc, %mm_isotropic)
call setwindowextex (hmemdc, 1000, 1000, byval %null)
call setviewportextex (hmemdc, (drect.nright - drect.nleft) \ 2, _
- (drect.nbottom - drect.ntop) \ 2, byval %null)
call setviewportorgex (hmemdc, drect.nleft + (drect.nright - drect.nleft) \ 2, _
drect.ntop + (drect.nbottom - drect.ntop) \ 2, byval %null)
' find the logical width of a line 1/16 inch in device point width
pt(0).y = 1 : pt(0).x = 1
pt(1).y = 1 : pt(1).x = 1 + getdevicecaps(hmemdc, %logpixelsx)/16
call dptolp(hmemdc, pt(0), 2)
' black pen 1/16 inch in width
hpen = createpen(%ps_solid, abs(pt(0).x - pt(1).x) , &h0 )
hpenold = selectobject(hmemdc, hpen)
' draw a circle 1/2 size of smallest margin
call ellipse(hmemdc, -500, -500, 500, 500 )
' restore the device context for text output
call restoredc (hmemdc, -1)
' set background mode to opaque
call setbkmode (hmemdc, %opaque)
' create our font (hard-coded font size)
lffont.lffacename = glffacename
lffont.lfheight = -1 * %pointsize * getdevicecaps(hmemdc, %logpixelsy) / 72
lffont.lfweight = 400
lffont.lfcharset = %default_charset
hfont = createfontindirect (lffont)
' save font for selection into dc at end
hfontold = selectobject (hmemdc, hfont)
' set text color
retval = settextcolor(hmemdc, %black)
' get font parameters
retval = gettextmetrics (hmemdc, tm)
' get string size
retval = gettextextentpoint32( hmemdc, bycopy docname, len(docname), xsize )
' center the text within the margins
' method 1:
recta.nleft = max&(drect.nleft, drect.nleft + (drect.nright - drect.nleft - xsize.cx)/2 )
recta.nright = min&(drect.nright, recta.nleft + xsize.cx)
recta.ntop = max&(drect.ntop, drect.ntop + (drect.nbottom - drect.ntop - xsize.cy)/2 )
recta.nbottom = min&(drect.nbottom, recta.ntop + xsize.cy)
retval = exttextout( hmemdc, recta.nleft, recta.ntop, %eto_clipped or %eto_opaque, recta, _
bycopy docname, len(docname), byval %null )
' method 2:
' recta.nleft = max&( 0, (drect.nright - drect.nleft - xsize.cx)/2 )
' recta.ntop = max&( 0, (drect.nbottom - drect.ntop - xsize.cy)/2 )
' paint it
' retval = textout( hmemdc, recta.nleft, recta.ntop, bycopy docname, len(docname) )
' delete font
call selectobject (hmemdc, hfontold)
call deleteobject (hfont)
' delete pen
call selectobject (hmemdc, hpenold)
call deleteobject (hpen)
' for direct printing, delete the reference to a bitmap memory dc
if printmode = %mode_direct then
hmemdc = 0
end if
function = 0
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function setprintervalues(hwnd as dword, hprinter as long, devmodeinfo as devmode, _
pdevmodeoutput as string, pdevmodeinput as string) as long
local retval as long, _
prndevmodeinfo as devmode
' get the size of the devmode structure
retval = documentproperties(byval hwnd, hprinter, devmodeinfo.dmdevicename, _
byval %null, byval %null, byval %null)
pdevmodeoutput = space$(retval)
pdevmodeinput = pdevmodeoutput
' get current printer settings
retval = documentproperties(byval hwnd, hprinter, devmodeinfo.dmdevicename, _
byval strptr(pdevmodeoutput), byval strptr(pdevmodeinput), _
byval %dm_out_buffer)
' use a temporary devmode structure for comparisons with user selected values
lset prndevmodeinfo = pdevmodeoutput
' set required bits for alteration of printer settings
if prndevmodeinfo.dmorientation <> devmodeinfo.dmorientation then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_orientation
end if
if prndevmodeinfo.dmpapersize <> devmodeinfo.dmpapersize then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_papersize
end if
if prndevmodeinfo.dmpaperlength <> devmodeinfo.dmpaperlength then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_paperlength
end if
if prndevmodeinfo.dmpaperwidth <> devmodeinfo.dmpaperwidth then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_paperwidth
end if
if prndevmodeinfo.dmscale <> devmodeinfo.dmscale then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_scale
end if
if prndevmodeinfo.dmcopies <> devmodeinfo.dmcopies then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_copies
end if
if prndevmodeinfo.dmdefaultsource <> devmodeinfo.dmdefaultsource then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_defaultsource
end if
if prndevmodeinfo.dmprintquality <> devmodeinfo.dmprintquality then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_printquality
end if
if prndevmodeinfo.dmcolor <> devmodeinfo.dmcolor then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_color
end if
if prndevmodeinfo.dmduplex <> devmodeinfo.dmduplex then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_duplex
end if
if prndevmodeinfo.dmyresolution <> devmodeinfo.dmyresolution then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_yresolution
end if
if prndevmodeinfo.dmttoption <> devmodeinfo.dmttoption then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_ttoption
end if
if prndevmodeinfo.dmcollate <> devmodeinfo.dmcollate then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_collate
end if
if prndevmodeinfo.dmformname <> devmodeinfo.dmformname then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_formname
end if
' set the devmode structure into the string to be returned to the printer.
mid$(pdevmodeinput, 1, len(devmodeinfo)) = devmodeinfo
pdevmodeoutput = pdevmodeinput
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function enumerateprinters(pdriver as string) as long
local dwneeded as long, _
dwreturned as long, _
iupper as long, _
pbyte as byte ptr, _
sznull as asciiz * 0, _
aptr as dword, _
tempstring as string, _
pinfo2() as printer_info_2, _
portname as string, _
printername as string, _
drivername as string, _
found as long
found = %false
pbyte = varptr( sznull )
call enumprinters( %printer_enum_connections or %printer_enum_local or %printer_enum_network, _
byval %null, 2, @pbyte, 0, dwneeded, dwreturned )
iupper = dwneeded \ sizeof( pinfo2( 0 )) 'compute upper bound
redim pinfo2( 0: iupper )
pbyte = varptr( pinfo2( 0 ))
call enumprinters( %printer_enum_connections or %printer_enum_local or %printer_enum_network, _
byval %null, 2, @pbyte, ( iupper + 1 ) * sizeof( pinfo2( 0 )), _
dwneeded, dwreturned )
if dwreturned > 0 then
for aptr = 0 to dwreturned - 1
printername = trim$(ucase$(pinfo2( aptr )[email protected]))
if instr(ucase$(printername), ucase$(pdriver) ) > 0 then
pdriver = printername
found = %true
exit for
end if
next aptr
end if
function = found
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function printprocedure(psdinfo as pagesetupdlga, _
printmode as long, docname as string) as long
static hwnd as dword, _
devnamesinfo as devnames, _
dnameptr as devnames ptr, _
devmodeinfo as devmode, _
dmodeptr as devmode ptr, _
hdcprn as long, _
hprinter as long, _
pdevmodeoutput as string, _
pdevmodeinput as string
static exitcode as long, _
berror as long, _
psz as asciiz ptr, _
retval as long
static di as docinfo,_
szdi as asciiz * %max_path
local pdriver as string, _
pdevice as string, _
bptr as byte ptr
hwnd = psdinfo.hwndowner
berror = %false
' set window text for cancel print dialog
gszcancelprinttext = docname
' get devmodeinfo
' ~~~~~~~~~~~~~~~
dmodeptr = globallock(psdinfo.hdevmode)
lset devmodeinfo = @dmodeptr
globalunlock psdinfo.hdevmode
' get printer device/driver names
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
dnameptr = globallock(psdinfo.hdevnames)
lset devnamesinfo = @dnameptr
bptr = dnameptr + devnamesinfo.wdriveroffset
for retval = 1 to devnamesinfo.wdeviceoffset - devnamesinfo.wdriveroffset
if @bptr < 1 then exit for
pdevice = pdevice + chr$(@bptr)
incr bptr
next retval
bptr = dnameptr + devnamesinfo.wdeviceoffset
for retval = 1 to devnamesinfo.woutputoffset - devnamesinfo.wdeviceoffset
if @bptr < 1 then exit for
pdriver = pdriver + chr$(@bptr)
incr bptr
next retval
globalunlock psdinfo.hdevnames
' devmode .dmdevicename may be truncated to 31 characters!!!
' if necessary, do a call to this function to get the full name for the specified printer!
if len(pdriver) > 30 then
if enumerateprinters(pdriver) = %false then
msgbox "could not find printer name"
exit function
end if
end if
' set printer properties
' ~~~~~~~~~~~~~~~~~~~~~~
' get a handle for the current printer
retval = openprinter(bycopy pdriver, hprinter, byval %null)
if retval = 0 then
msgbox "unable to write to selected printer!"
function = %true
exit function
end if
' change required bit fields to match user requests
call setprintervalues(hwnd, hprinter, devmodeinfo, pdevmodeoutput, pdevmodeinput)
' create printer device context
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
hdcprn = createdc(bycopy pdevice, bycopy pdriver, byval %null, byval strptr(pdevmodeoutput))
if hdcprn = %null then
function = %true
msgbox "unable to create printer dc!"
exit function
end if
' disable program windows
' ~~~~~~~~~~~~~~~~~~~~~~~
call enablewindow (hwnd, %false)
' create cancel printing dialog box
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
guserabort = %false
ghcancelprintdlg = createdialog( getwindowlong(hwnd,%gwl_hinstance), _
"cancelprintdlgbox", _
hwnd, codeptr(cancelprintproc) )
' set abortproc
' ~~~~~~~~~~~~~
retval = setabortproc (hdcprn, codeptr(abortproc))
' start document
' ~~~~~~~~~~~~~~
szdi = docname
di.cbsize = sizeof(di)
di.lpszdocname = varptr(szdi)
di.lpszoutput = %null
berror = startdoc(hdcprn, di)
if berror <= 0 then goto endprint
' print test page
' ~~~~~~~~~~~~~~~
exitcode = %false
while not guserabort
' start page
' ~~~~~~~~~~
berror = startpage(hdcprn)
if berror <= 0 then exit loop
' set desired printer settings
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
retval = documentproperties(byval hwnd, hprinter, bycopy pdriver, _
byval strptr(pdevmodeoutput), byval strptr(pdevmodeinput), _
byval %dm_in_buffer)
' print page
' ~~~~~~~~~~
retval =printpage(hdcprn, printmode, docname, psdinfo)
if retval = %false then ' last page printed
exit loop
elseif retval = %true then ' print error
berror = endpage(hdcprn)
exit loop
end if
if not guserabort then
berror = endpage(hdcprn)
if berror <= 0 then exit loop
end if
wend
endprint:
if not berror then
if guserabort then
call abortdoc (hdcprn)
else
berror = endpage (hdcprn)
if berror > 0 then
call enddoc(hdcprn)
end if
end if
end if
if not guserabort then
call enablewindow (hwnd, %true)
call destroywindow (ghcancelprintdlg)
end if
' release the current printer handle
closeprinter hprinter
' delete printer device context
call deletedc (hdcprn)
function = berror or guserabort
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function printpage(hdcprn as long, printmode as long, docname as string, _
psdinfo as pagesetupdlga) as long
' returns %false for last page has been printed
' returns %true for more pages to be printed
static pageno as long, _
mconvert as long, _
temp as long, _
hmemdc as long, _
hmapbmp as long, _
sztext as asciiz * 100, _
devmodeinfo as devmode, _
devptr as devmode ptr, _
pmargins as rect, _
drect as rect, _
prnlogpixels as sizel
local retval as long
' margin adjustment for inches/mm
if (psdinfo.flags and %psd_inhundredthsofmillimeters) then
' measurements of margins are in 100'ths of millimeters!
mconvert = 2540 ' 2540 hundred mm = 1 inch
else '(psdinfo.flags and %psd_inthousandthsofinches)
mconvert = 1000 ' 1000 thousandths = 1 inch
end if
' number of dots/inch
prnlogpixels.cx = getdevicecaps(hdcprn, %logpixelsx)
prnlogpixels.cy = getdevicecaps(hdcprn, %logpixelsy)
' printer margin non-printable width
temp = getdevicecaps(hdcprn, %physicaloffsetx)
' left margin : convert inches/mm to device units and subtract the non-printable area
pmargins.nleft = ( psdinfo.rtmargin.nleft / mconvert ) * prnlogpixels.cx - temp
' print width = device width - (left margin + right margin) :: converted to device units per inch/mm
pmargins.nright = getdevicecaps(hdcprn, %physicalwidth) _
- (psdinfo.rtmargin.nleft + psdinfo.rtmargin.nright)* prnlogpixels.cx / mconvert
' printer margin non-printable height
temp = getdevicecaps(hdcprn, %physicaloffsety)
' top margin : convert inches/mm to device units and subtract the non-printable area
pmargins.ntop = ( psdinfo.rtmargin.ntop / mconvert ) * prnlogpixels.cy - temp
' print height = device height - (top margin + right margin) :: converted to device units per inch/mm
pmargins.nbottom = getdevicecaps(hdcprn, %physicalheight) _
- (psdinfo.rtmargin.ntop + psdinfo.rtmargin.nbottom) * prnlogpixels.cy / mconvert
' add calculated margin offsets
if printmode = %mode_bitmap then ' margins are set by the bitmap
drect.nleft = 0
drect.ntop = 0
drect.nright = pmargins.nright
drect.nbottom = pmargins.nbottom
else ' margins are drawn directly
drect = pmargins
drect.nright = drect.nright + drect.nleft
drect.nbottom = drect.nbottom + drect.ntop
end if
retval = paintpage(hdcprn, hmemdc, hmapbmp, drect, docname, printmode)
if printmode = %mode_bitmap and retval <> -1 then
call bitblt(hdcprn, pmargins.nleft, pmargins.ntop, pmargins.nright, pmargins.nbottom, _
hmemdc, 0, 0,%srccopy)
end if
if hmemdc <> 0 then deletedc hmemdc : hmemdc = 0
if hmapbmp <> 0 then deleteobject hmapbmp : hmapbmp = 0
function = %false
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function cancelprintproc (byval hdlg as dword, byval msg as dwo
[CODE]'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
' file: prn_test.rc
#include "resource.h"
cancelprintdlgbox dialog 40, 40, 120, 40
style ws_popup | ws_caption | ws_sysmenu | ws_visible
font 10, "arial"
begin
ctext "cancel printing", -1, 4, 6, 120, 12
defpushbutton "cancel", idcancel, 44, 22, 32, 14, ws_group
end
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
' !!!!! snip here !!!!!
'------------------------------------------------------------------------------
' file: prn_test.bas
' prn_test.bas by ian cairns, may 3, 2001. - use and modify freely.
' revised may 8, 2001: parameters changed for print functions.
' added enumprinters() function modified from george bleck's code
' may 10, 2001: paintpage() function modified to create bitmap from actual hdc
' rather than compatible memory hdc
'------------------------------------------------------------------------------
' information to construct this program was freely stolen from a number
' of people from this forum including: lance edmonds, don dickinson,
' jim seekamp, charles dietz, semen matusovski, patrice terrier, keith waters,
' george bleck
' (apologies to those whose names i have inadvertently left out of this list)
'------------------------------------------------------------------------------
' the test program demonstrates using the printer setup dialog boxes
' and the page setup dialog boxes. it also demonstrates printing to
' either screen or printer by using direct calls to the dc, or by
' painting to a device compatible bitmap and bitblt-ing the result
' to the dc.
' when printing, a rectangle is drawn to the selected margins and
' both the text and circle are centered within the margins.
'------------------------------------------------------------------------------
' problem: the bitmap printing to a printer works fine in win98, but will not
' work properly in win nt (version 4 sp4). the graphics are printed ok, but text
' does not appear. all of the api return values indicate success. checking the values
' of the font selected into the 'print' bitmap return expected values. the font
' even overwrites the graphics as expected. but it is as if the font is painted
' with a null brush even though text colour is set with settextcolor()!
' (gettextcolor() returns the proper colour).
' i am still stuck here. does someone have a solution?
'------------------------------------------------------------------------------
' update: may 16, 2001: my problem was a bad printer driver. the program
' should work properly on all printers with a good printer driver.
'------------------------------------------------------------------------------
$dim all
$compile exe
$register none
$debug error on
$option version4
#include "win32api.inc"
#include "comdlg32.inc"
$resource "prn_test.pbr" ' resource contains cancel dialog
'------------------------------------------------------------------------------
' function declares
declare function printprocedure(psdinfo as pagesetupdlga, _
printmode as long, docname as string) as long
declare function printpage(hdcprn as long, printmode as long, docname as string, _
psdinfo as pagesetupdlga) as long
' page setup dialog declare! no in the win32api.inc
declare function pagesetupdlg lib "comdlg32.dll" alias "pagesetupdlga" (lppsd as pagesetupdlga) as long
'------------------------------------------------------------------------------
%idm_pagesetup = 1
%idm_print = 2
%idm_mode_direct = 3
%idm_mode_bitmap = 4
%idm_exit = 5
%mode_direct = 0
%mode_bitmap = 1
%pointsize = 48 ' alter this value for the text size
global gszcancelprinttext as asciiz * 30, _
guserabort as long,_
ghcancelprintdlg as long, _
glffacename as string
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function winmain (byval hcurrinstance as long,_
byval hprevinstance as long,_
lpcmdline as asciiz ptr,_
byval ncmdshow as long) as long
local msg as tagmsg, _
wclass as wndclassex, _
hwnd as dword, __
szclassname as asciiz * 20, _
szcaption as asciiz * 20
' initialize
' ~~~~~~~~~~
glffacename = "arial" ' alter this value to change fonts
szclassname = "printer_testbed32"
szcaption = "print test program"
' fill window class structure
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~
wclass.cbsize = sizeof(wclass)
wclass.style = 0 ' removed %cs_hredraw or %cs_vredraw to eliminate flickering on resize
wclass.lpfnwndproc = codeptr(mainwndproc)
wclass.cbclsextra = 0
wclass.cbwndextra = 0
wclass.hinstance = hcurrinstance
wclass.hicon = loadicon (%null, byval %idi_application)
wclass.hcursor = loadcursor(%null, byval %idc_arrow)
wclass.hbrbackground = getstockobject(%white_brush)
wclass.lpszmenuname = %null
wclass.lpszclassname = varptr(szclassname)
wclass.hiconsm = loadicon (%null, byval %idi_application)
' register the window-class
' ~~~~~~~~~~~~~~~~~~~~~~~~~
call registerclassex (wclass)
' create the main window
' ~~~~~~~~~~~~~~~~~~~~~~
hwnd = createwindow (szclassname, szcaption, %ws_overlappedwindow, _
%cw_usedefault, %cw_usedefault, %cw_usedefault, %cw_usedefault,_
%hwnd_desktop, %null, hcurrinstance, %null)
call showwindow (hwnd, ncmdshow)
call updatewindow (hwnd)
' main message loop of program
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
while getmessage(msg, %null, 0, 0)
call translatemessage (msg)
call dispatchmessage (msg)
wend
' clean up and assign return value
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function = msg.wparam
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function mainwndproc(byval hwnd as dword,_
byval wmsg as dword,_
byval wparam as dword,_
byval lparam as dword) export as long
static hmenu as long, _
hmenupopup as long, _
printmode as long, _
docname as string, _
hmapbmp as long, _
hmemdc as long, _
drect as rect, _
idevmode as long, _
idevnames as long, _
psdinfo as pagesetupdlga, _
prdinfo as printdlgapi, _
devmodeinfo as devmode, _
devptr as devmode ptr
local hdc as long,_
ps as paintstruct, _
retval as long, _
otext as string
select case wmsg
case %wm_create
' ~~~~~~~~~~~~~~~~
' create menu
hmenu = createmenu ()
hmenupopup = createmenu ()
call appendmenu (hmenupopup, %mf_string, %idm_pagesetup, "page &setup ...")
call appendmenu (hmenupopup, %mf_string, %idm_print , "&print ...")
call appendmenu (hmenupopup, %mf_separator, 0, ")
call appendmenu (hmenupopup, %mf_string, %idm_mode_direct, "mode: print direct")
call appendmenu (hmenupopup, %mf_string, %idm_mode_bitmap, "mode: print bitmap")
call appendmenu (hmenupopup, %mf_separator, 0, ")
call appendmenu (hmenupopup, %mf_string, %idm_exit, "e&xit")
call appendmenu (hmenu, %mf_popup, hmenupopup, "&file")
call setmenu (hwnd, hmenu)
call checkmenuitem(hmenu, %idm_mode_direct, %mf_checked)
printmode = %mode_direct ' alternate: %mode_bitmap
docname = "print mode: direct print"
' setup printsetupdialog structure
psdinfo.lstructsize = sizeof(psdinfo)
psdinfo.hwndowner = hwnd
psdinfo.flags = %psd_returndefault
' get default printer and default setup
call pagesetupdlg (psdinfo)
' change flags
psdinfo.flags = psdinfo.flags xor %psd_returndefault
psdinfo.flags = psdinfo.flags or %psd_margins
' setup printdialog structure
prdinfo.lstructsize = sizeof(prdinfo)
prdinfo.hwndowner = hwnd
prdinfo.flags = %pd_allpages or %pd_hideprinttofile or %pd_noselection
' get current window size for painting
call getclientrect (hwnd, drect)
function = 0
case %wm_syscommand
' ~~~~~~~~~~~~~~~~~~~
' intercept message for repainting if window is resized via system command
if wparam = %sc_maximize or wparam = %sc_restore then
call postmessage(hwnd, %wm_exitsizemove, %null, %null)
end if
function = defwindowproc(hwnd, wmsg, wparam, lparam)
case %wm_exitsizemove
' ~~~~~~~~~~~~~~~~~~~~~
call getclientrect (hwnd, drect)
if printmode = %mode_bitmap then ' need to make a new bitmap for a re-sized screen
hdc = %null
call paintpage(hdc, hmemdc, hmapbmp, drect, docname, printmode)
end if
call invalidaterect(hwnd, byval %null, byval %true)
function = 0
case %wm_command
' ~~~~~~~~~~~~~~~~
hmenu = getmenu (hwnd)
select case lowrd(wparam)
' ~~~~~~~~~~~~~~~~~~~~~~~~~
case %idm_mode_bitmap, %idm_mode_direct ' toggle between states
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if printmode = %mode_direct then
printmode = %mode_bitmap
docname = "print mode: bitmap print"
call checkmenuitem(hmenu, %idm_mode_direct, %mf_unchecked)
call checkmenuitem(hmenu, %idm_mode_bitmap, %mf_checked)
hdc = %null ' use to make a bitmap for the screen
call getclientrect (hwnd, drect)
call paintpage(hdc, hmemdc, hmapbmp, drect, docname, printmode)
else
printmode = %mode_direct
docname = "print mode: direct print"
call checkmenuitem(hmenu, %idm_mode_bitmap, %mf_unchecked)
call checkmenuitem(hmenu, %idm_mode_direct, %mf_checked)
end if
call invalidaterect(hwnd, byval %null, byval %true)
function = 0
case %idm_pagesetup
' ~~~~~~~~~~~~~~~~~~~
retval = pagesetupdlg (psdinfo)
if retval > 0 and psdinfo.hdevmode then
' release duplicate global hdevmode/hdevnames info
if prdinfo.hdevmode <> psdinfo.hdevmode and prdinfo.hdevmode <> 0 then
globalfree prdinfo.hdevmode
end if
if prdinfo.hdevnames <> psdinfo.hdevnames and prdinfo.hdevnames <> 0 then
globalfree prdinfo.hdevnames
end if
' syncronize hdevmode/hdevnames info
prdinfo.hdevmode = psdinfo.hdevmode
prdinfo.hdevnames = psdinfo.hdevnames
end if
function = 0
case %idm_print
' ~~~~~~~~~~~~~~~
if printdlg(prdinfo) <> 0 then
' release duplicate global hdevmode/hdevnames info
if psdinfo.hdevmode <> prdinfo.hdevmode and psdinfo.hdevmode <> 0 then
globalfree psdinfo.hdevmode
end if
if psdinfo.hdevnames <> prdinfo.hdevnames and psdinfo.hdevnames <> 0 then
globalfree psdinfo.hdevnames
end if
' syncronize hdevmode/hdevnames info
psdinfo.hdevmode = prdinfo.hdevmode
psdinfo.hdevnames = prdinfo.hdevnames
call printprocedure(psdinfo, printmode, docname)
end if
function = 0
case %idm_exit
' ~~~~~~~~~~~~~~
if hmemdc <> 0 then deletedc hmemdc : hmemdc = 0
if hmapbmp <> 0 then deleteobject hmapbmp : hmapbmp = 0
if psdinfo.hdevmode then
if prdinfo.hdc <> %null then
call releasedc(hwnd, prdinfo.hdc)
end if
globalfree psdinfo.hdevmode
globalfree psdinfo.hdevnames
psdinfo.hdevmode = 0
end if
postquitmessage 0
function = 0
end select
case %wm_paint
' ~~~~~~~~~~~~~~
hdc = beginpaint (hwnd, ps)
if printmode = %mode_bitmap then
call bitblt(hdc, 0, 0, drect.nright, drect.nbottom, hmemdc, 0, 0, %srccopy)
else
call paintpage(hdc, hmemdc, hmapbmp, drect, docname, printmode)
end if
call endpaint (hwnd, ps)
function = 0
case %wm_destroy
' ~~~~~~~~~~~~~~~~
if hmemdc <> 0 then deletedc hmemdc : hmemdc = 0
if hmapbmp <> 0 then deleteobject hmapbmp : hmapbmp = 0
if psdinfo.hdevmode then
if prdinfo.hdc <> %null then
call releasedc(hwnd, prdinfo.hdc)
end if
globalfree psdinfo.hdevmode
globalfree psdinfo.hdevnames
end if
call postquitmessage (0)
function = 0
case else
' ~~~~~~~~~
function = defwindowproc (hwnd, wmsg, wparam, lparam)
end select
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function paintpage(hdc as long, hmemdc as long, hmapbmp as long, _
drect as rect, docname as string, printmode as long) as long
' function altered may 10, 2001
local lffont as logfont, _
hbrush as long, _ ' brush handles
hbrushold as long, _
hpen as long, _ ' pen handle
hpenold as long, _
hfont as long, _ ' font handle
hfontold as long, _
otext as string, _ ' temporary container for text
recta as rect, _
tm as textmetric, _
xsize as sizel, _
retval as long, _
gethdcflag as long
dim pt(0:1) as local pointapi
gethdcflag = %false ' allows us to delete a temporary screen hdc
if printmode = %mode_bitmap then
if getdevicecaps(hdc, %rastercaps) and %rc_bitblt <> %rc_bitblt then
msgbox "selected device cannot print bitmaps! "
function = %true
exit function
end if
' create device dependant bitmap
hmemdc = createcompatibledc (hdc)
if hdc = %null then
hdc = getdc(%hwnd_desktop)
gethdcflag = %true
end if
' create bitmap compatible with dc (allows colors for the screen/printer)
hmapbmp = createcompatiblebitmap (hdc, drect.nright-drect.nleft, drect.nbottom-drect.ntop)
if gethdcflag = %true then
call releasedc(%hwnd_desktop, hdc)
end if
call selectobject (hmemdc, hmapbmp)
' fill the background
hbrush = getstockobject(%white_brush)
hbrushold = selectobject(hmemdc, hbrush)
call patblt(hmemdc, 0, 0, drect.nright-drect.nleft, drect.nbottom-drect.ntop, %patcopy)
' delete brush
call selectobject(hmemdc, hbrushold)
call deleteobject(hbrush)
else
hmemdc = hdc
end if
' set background mode to opaque
call setbkmode (hmemdc, %opaque)
' black pen 1/16 inch in width
xsize.cx = getdevicecaps(hmemdc, %logpixelsx)/32
xsize.cy = getdevicecaps(hmemdc, %logpixelsy)/32
hpen = createpen(%ps_solid, xsize.cx*2 , &h0 )
hpenold = selectobject(hmemdc, hpen)
' draw a rectangle at the margins, allowing for penwidth and 1 device point offset.
call rectangle(hmemdc, drect.nleft + xsize.cx, drect.ntop+xsize.cy, _
drect.nright - xsize.cx +1, drect.nbottom - xsize.cy +1)
' draw lines from edge to edge
call movetoex(hmemdc, drect.nleft + xsize.cx, drect.ntop + xsize.cy, byval %null)
call lineto(hmemdc, drect.nright - xsize.cx, drect.nbottom - xsize.cy)
call movetoex(hmemdc, drect.nright - xsize.cx, drect.ntop + xsize.cy, byval %null)
call lineto(hmemdc, drect.nleft + xsize.cx, drect.nbottom - xsize.cy)
' delete pen
call selectobject (hmemdc, hpenold)
call deleteobject (hpen)
' save dc as we change map modes.
call savedc (hmemdc)
' change map modes/extents
call setmapmode (hmemdc, %mm_isotropic)
call setwindowextex (hmemdc, 1000, 1000, byval %null)
call setviewportextex (hmemdc, (drect.nright - drect.nleft) \ 2, _
- (drect.nbottom - drect.ntop) \ 2, byval %null)
call setviewportorgex (hmemdc, drect.nleft + (drect.nright - drect.nleft) \ 2, _
drect.ntop + (drect.nbottom - drect.ntop) \ 2, byval %null)
' find the logical width of a line 1/16 inch in device point width
pt(0).y = 1 : pt(0).x = 1
pt(1).y = 1 : pt(1).x = 1 + getdevicecaps(hmemdc, %logpixelsx)/16
call dptolp(hmemdc, pt(0), 2)
' black pen 1/16 inch in width
hpen = createpen(%ps_solid, abs(pt(0).x - pt(1).x) , &h0 )
hpenold = selectobject(hmemdc, hpen)
' draw a circle 1/2 size of smallest margin
call ellipse(hmemdc, -500, -500, 500, 500 )
' restore the device context for text output
call restoredc (hmemdc, -1)
' set background mode to opaque
call setbkmode (hmemdc, %opaque)
' create our font (hard-coded font size)
lffont.lffacename = glffacename
lffont.lfheight = -1 * %pointsize * getdevicecaps(hmemdc, %logpixelsy) / 72
lffont.lfweight = 400
lffont.lfcharset = %default_charset
hfont = createfontindirect (lffont)
' save font for selection into dc at end
hfontold = selectobject (hmemdc, hfont)
' set text color
retval = settextcolor(hmemdc, %black)
' get font parameters
retval = gettextmetrics (hmemdc, tm)
' get string size
retval = gettextextentpoint32( hmemdc, bycopy docname, len(docname), xsize )
' center the text within the margins
' method 1:
recta.nleft = max&(drect.nleft, drect.nleft + (drect.nright - drect.nleft - xsize.cx)/2 )
recta.nright = min&(drect.nright, recta.nleft + xsize.cx)
recta.ntop = max&(drect.ntop, drect.ntop + (drect.nbottom - drect.ntop - xsize.cy)/2 )
recta.nbottom = min&(drect.nbottom, recta.ntop + xsize.cy)
retval = exttextout( hmemdc, recta.nleft, recta.ntop, %eto_clipped or %eto_opaque, recta, _
bycopy docname, len(docname), byval %null )
' method 2:
' recta.nleft = max&( 0, (drect.nright - drect.nleft - xsize.cx)/2 )
' recta.ntop = max&( 0, (drect.nbottom - drect.ntop - xsize.cy)/2 )
' paint it
' retval = textout( hmemdc, recta.nleft, recta.ntop, bycopy docname, len(docname) )
' delete font
call selectobject (hmemdc, hfontold)
call deleteobject (hfont)
' delete pen
call selectobject (hmemdc, hpenold)
call deleteobject (hpen)
' for direct printing, delete the reference to a bitmap memory dc
if printmode = %mode_direct then
hmemdc = 0
end if
function = 0
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function setprintervalues(hwnd as dword, hprinter as long, devmodeinfo as devmode, _
pdevmodeoutput as string, pdevmodeinput as string) as long
local retval as long, _
prndevmodeinfo as devmode
' get the size of the devmode structure
retval = documentproperties(byval hwnd, hprinter, devmodeinfo.dmdevicename, _
byval %null, byval %null, byval %null)
pdevmodeoutput = space$(retval)
pdevmodeinput = pdevmodeoutput
' get current printer settings
retval = documentproperties(byval hwnd, hprinter, devmodeinfo.dmdevicename, _
byval strptr(pdevmodeoutput), byval strptr(pdevmodeinput), _
byval %dm_out_buffer)
' use a temporary devmode structure for comparisons with user selected values
lset prndevmodeinfo = pdevmodeoutput
' set required bits for alteration of printer settings
if prndevmodeinfo.dmorientation <> devmodeinfo.dmorientation then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_orientation
end if
if prndevmodeinfo.dmpapersize <> devmodeinfo.dmpapersize then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_papersize
end if
if prndevmodeinfo.dmpaperlength <> devmodeinfo.dmpaperlength then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_paperlength
end if
if prndevmodeinfo.dmpaperwidth <> devmodeinfo.dmpaperwidth then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_paperwidth
end if
if prndevmodeinfo.dmscale <> devmodeinfo.dmscale then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_scale
end if
if prndevmodeinfo.dmcopies <> devmodeinfo.dmcopies then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_copies
end if
if prndevmodeinfo.dmdefaultsource <> devmodeinfo.dmdefaultsource then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_defaultsource
end if
if prndevmodeinfo.dmprintquality <> devmodeinfo.dmprintquality then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_printquality
end if
if prndevmodeinfo.dmcolor <> devmodeinfo.dmcolor then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_color
end if
if prndevmodeinfo.dmduplex <> devmodeinfo.dmduplex then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_duplex
end if
if prndevmodeinfo.dmyresolution <> devmodeinfo.dmyresolution then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_yresolution
end if
if prndevmodeinfo.dmttoption <> devmodeinfo.dmttoption then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_ttoption
end if
if prndevmodeinfo.dmcollate <> devmodeinfo.dmcollate then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_collate
end if
if prndevmodeinfo.dmformname <> devmodeinfo.dmformname then
devmodeinfo.dmfields = devmodeinfo.dmfields or %dm_formname
end if
' set the devmode structure into the string to be returned to the printer.
mid$(pdevmodeinput, 1, len(devmodeinfo)) = devmodeinfo
pdevmodeoutput = pdevmodeinput
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function enumerateprinters(pdriver as string) as long
local dwneeded as long, _
dwreturned as long, _
iupper as long, _
pbyte as byte ptr, _
sznull as asciiz * 0, _
aptr as dword, _
tempstring as string, _
pinfo2() as printer_info_2, _
portname as string, _
printername as string, _
drivername as string, _
found as long
found = %false
pbyte = varptr( sznull )
call enumprinters( %printer_enum_connections or %printer_enum_local or %printer_enum_network, _
byval %null, 2, @pbyte, 0, dwneeded, dwreturned )
iupper = dwneeded \ sizeof( pinfo2( 0 )) 'compute upper bound
redim pinfo2( 0: iupper )
pbyte = varptr( pinfo2( 0 ))
call enumprinters( %printer_enum_connections or %printer_enum_local or %printer_enum_network, _
byval %null, 2, @pbyte, ( iupper + 1 ) * sizeof( pinfo2( 0 )), _
dwneeded, dwreturned )
if dwreturned > 0 then
for aptr = 0 to dwreturned - 1
printername = trim$(ucase$(pinfo2( aptr )[email protected]))
if instr(ucase$(printername), ucase$(pdriver) ) > 0 then
pdriver = printername
found = %true
exit for
end if
next aptr
end if
function = found
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function printprocedure(psdinfo as pagesetupdlga, _
printmode as long, docname as string) as long
static hwnd as dword, _
devnamesinfo as devnames, _
dnameptr as devnames ptr, _
devmodeinfo as devmode, _
dmodeptr as devmode ptr, _
hdcprn as long, _
hprinter as long, _
pdevmodeoutput as string, _
pdevmodeinput as string
static exitcode as long, _
berror as long, _
psz as asciiz ptr, _
retval as long
static di as docinfo,_
szdi as asciiz * %max_path
local pdriver as string, _
pdevice as string, _
bptr as byte ptr
hwnd = psdinfo.hwndowner
berror = %false
' set window text for cancel print dialog
gszcancelprinttext = docname
' get devmodeinfo
' ~~~~~~~~~~~~~~~
dmodeptr = globallock(psdinfo.hdevmode)
lset devmodeinfo = @dmodeptr
globalunlock psdinfo.hdevmode
' get printer device/driver names
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
dnameptr = globallock(psdinfo.hdevnames)
lset devnamesinfo = @dnameptr
bptr = dnameptr + devnamesinfo.wdriveroffset
for retval = 1 to devnamesinfo.wdeviceoffset - devnamesinfo.wdriveroffset
if @bptr < 1 then exit for
pdevice = pdevice + chr$(@bptr)
incr bptr
next retval
bptr = dnameptr + devnamesinfo.wdeviceoffset
for retval = 1 to devnamesinfo.woutputoffset - devnamesinfo.wdeviceoffset
if @bptr < 1 then exit for
pdriver = pdriver + chr$(@bptr)
incr bptr
next retval
globalunlock psdinfo.hdevnames
' devmode .dmdevicename may be truncated to 31 characters!!!
' if necessary, do a call to this function to get the full name for the specified printer!
if len(pdriver) > 30 then
if enumerateprinters(pdriver) = %false then
msgbox "could not find printer name"
exit function
end if
end if
' set printer properties
' ~~~~~~~~~~~~~~~~~~~~~~
' get a handle for the current printer
retval = openprinter(bycopy pdriver, hprinter, byval %null)
if retval = 0 then
msgbox "unable to write to selected printer!"
function = %true
exit function
end if
' change required bit fields to match user requests
call setprintervalues(hwnd, hprinter, devmodeinfo, pdevmodeoutput, pdevmodeinput)
' create printer device context
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
hdcprn = createdc(bycopy pdevice, bycopy pdriver, byval %null, byval strptr(pdevmodeoutput))
if hdcprn = %null then
function = %true
msgbox "unable to create printer dc!"
exit function
end if
' disable program windows
' ~~~~~~~~~~~~~~~~~~~~~~~
call enablewindow (hwnd, %false)
' create cancel printing dialog box
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
guserabort = %false
ghcancelprintdlg = createdialog( getwindowlong(hwnd,%gwl_hinstance), _
"cancelprintdlgbox", _
hwnd, codeptr(cancelprintproc) )
' set abortproc
' ~~~~~~~~~~~~~
retval = setabortproc (hdcprn, codeptr(abortproc))
' start document
' ~~~~~~~~~~~~~~
szdi = docname
di.cbsize = sizeof(di)
di.lpszdocname = varptr(szdi)
di.lpszoutput = %null
berror = startdoc(hdcprn, di)
if berror <= 0 then goto endprint
' print test page
' ~~~~~~~~~~~~~~~
exitcode = %false
while not guserabort
' start page
' ~~~~~~~~~~
berror = startpage(hdcprn)
if berror <= 0 then exit loop
' set desired printer settings
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
retval = documentproperties(byval hwnd, hprinter, bycopy pdriver, _
byval strptr(pdevmodeoutput), byval strptr(pdevmodeinput), _
byval %dm_in_buffer)
' print page
' ~~~~~~~~~~
retval =printpage(hdcprn, printmode, docname, psdinfo)
if retval = %false then ' last page printed
exit loop
elseif retval = %true then ' print error
berror = endpage(hdcprn)
exit loop
end if
if not guserabort then
berror = endpage(hdcprn)
if berror <= 0 then exit loop
end if
wend
endprint:
if not berror then
if guserabort then
call abortdoc (hdcprn)
else
berror = endpage (hdcprn)
if berror > 0 then
call enddoc(hdcprn)
end if
end if
end if
if not guserabort then
call enablewindow (hwnd, %true)
call destroywindow (ghcancelprintdlg)
end if
' release the current printer handle
closeprinter hprinter
' delete printer device context
call deletedc (hdcprn)
function = berror or guserabort
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function printpage(hdcprn as long, printmode as long, docname as string, _
psdinfo as pagesetupdlga) as long
' returns %false for last page has been printed
' returns %true for more pages to be printed
static pageno as long, _
mconvert as long, _
temp as long, _
hmemdc as long, _
hmapbmp as long, _
sztext as asciiz * 100, _
devmodeinfo as devmode, _
devptr as devmode ptr, _
pmargins as rect, _
drect as rect, _
prnlogpixels as sizel
local retval as long
' margin adjustment for inches/mm
if (psdinfo.flags and %psd_inhundredthsofmillimeters) then
' measurements of margins are in 100'ths of millimeters!
mconvert = 2540 ' 2540 hundred mm = 1 inch
else '(psdinfo.flags and %psd_inthousandthsofinches)
mconvert = 1000 ' 1000 thousandths = 1 inch
end if
' number of dots/inch
prnlogpixels.cx = getdevicecaps(hdcprn, %logpixelsx)
prnlogpixels.cy = getdevicecaps(hdcprn, %logpixelsy)
' printer margin non-printable width
temp = getdevicecaps(hdcprn, %physicaloffsetx)
' left margin : convert inches/mm to device units and subtract the non-printable area
pmargins.nleft = ( psdinfo.rtmargin.nleft / mconvert ) * prnlogpixels.cx - temp
' print width = device width - (left margin + right margin) :: converted to device units per inch/mm
pmargins.nright = getdevicecaps(hdcprn, %physicalwidth) _
- (psdinfo.rtmargin.nleft + psdinfo.rtmargin.nright)* prnlogpixels.cx / mconvert
' printer margin non-printable height
temp = getdevicecaps(hdcprn, %physicaloffsety)
' top margin : convert inches/mm to device units and subtract the non-printable area
pmargins.ntop = ( psdinfo.rtmargin.ntop / mconvert ) * prnlogpixels.cy - temp
' print height = device height - (top margin + right margin) :: converted to device units per inch/mm
pmargins.nbottom = getdevicecaps(hdcprn, %physicalheight) _
- (psdinfo.rtmargin.ntop + psdinfo.rtmargin.nbottom) * prnlogpixels.cy / mconvert
' add calculated margin offsets
if printmode = %mode_bitmap then ' margins are set by the bitmap
drect.nleft = 0
drect.ntop = 0
drect.nright = pmargins.nright
drect.nbottom = pmargins.nbottom
else ' margins are drawn directly
drect = pmargins
drect.nright = drect.nright + drect.nleft
drect.nbottom = drect.nbottom + drect.ntop
end if
retval = paintpage(hdcprn, hmemdc, hmapbmp, drect, docname, printmode)
if printmode = %mode_bitmap and retval <> -1 then
call bitblt(hdcprn, pmargins.nleft, pmargins.ntop, pmargins.nright, pmargins.nbottom, _
hmemdc, 0, 0,%srccopy)
end if
if hmemdc <> 0 then deletedc hmemdc : hmemdc = 0
if hmapbmp <> 0 then deleteobject hmapbmp : hmapbmp = 0
function = %false
end function
'------------------------------------------------------------------------------
'##############################################################################
'------------------------------------------------------------------------------
function cancelprintproc (byval hdlg as dword, byval msg as dwo
Comment