Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

PBDLL6: Printing with Dialogs

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBDLL6: Printing with Dialogs

    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
    :) IRC :)

  • #2
    I modified the PaintPage() function to create a bitmap from the original hDC
    rather than from a compatible memory hDC. This makes the bitmap "more" compatible
    and allows a colour bitmap if the device is capable of colour.

    Regards,

    [This message has been edited by Ian Cairns (edited May 10, 2001).]
    :) IRC :)

    Comment

    Working...
    X