printdialog.tcl

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

        set PrinterCmd ${last_print_cmd}

        # We need the next loop to configure the global variables!
     #   set class [itcl::info class]
     #   foreach pub [itcl::info public] {
     #       if {[string first "${class}::" ${pub}] != -1} {
     #           configure -${pub} [set ${pub}]
     #       }
     #   }
        if {${canvas} != ""} {
            ${this} CalcPostScriptPages ""
        }

        ${this} take_focus

        if {!${init_withdraw}} {
            ${this} centerOnScreen

            catch {${this} resizable no no}

            update idletasks
            set geom [split [lindex [split [${this} geometry] "+"] 0] "x"]
            ${this} minsize [lindex ${geom} 0] [lindex ${geom} 1]
        }
    }

    destructor {
    }

    #deletes an entry from string array
    proc DelArrEntry {array n} {
        upvar ${array} arr

        if {! [info exist arr]} {
            set arr ""
        }

        set i [lsearch ${arr} ${n}]
        if {${i} != -1} {
            set arr [lreplace ${arr} ${i} ${i}]
        }
    }

    proc Round {num} {
        set i [string first . ${num}]
        if {${i} != -1} {
            set mnom [string range ${num} [expr ${i} + 1] end]
            set num [string range ${num} 0 [expr ${i} - 1]]
            if {${mnom} > 0.0} {
                set num [expr ${num} + 1]
            }
        }
        return ${num}
    }

    method CalcPostScriptPages {factor} {

        set fac ${factor}
        DelArrEntry fac "%"

        if {[catch {set fac [expr int(${fac}) + 0]}]} {
            set fac 100
        }

        if {${fac} > 600} {
            set fac 600
        }
        set tfac [expr ${fac} / 100.0]

        #get geometry to center textes
        if {${pr_pagenum}} {
            set id [${canvas} create text 0 0 -text "Page H0 V0"\
              -font ${header_font}]
            set tgeom [${canvas} bbox ${id}]
            set twidth [expr [lindex ${tgeom} 2] - [lindex ${tgeom} 0]]
            set theight [expr [lindex ${tgeom} 3] - [lindex ${tgeom} 1]]
            set step [expr ${theight} + 2]
            #add factor to the step
            #set step    [expr $step * $tfac]
            ${canvas} delete ${id}
        } else {
            set step 0.0
        }

        set scr [${canvas} cget -scrollregion]
        set canv_width [lindex ${scr} 2]
        set canv_height [lindex ${scr} 3]
        if {${canv_width} == ""} {
            return ""
        }

        if {${unit} == "cm"} {
            set snUnit "c"
        } else {
            set snUnit "i"
        }

        if {${rotate} == 0} {
            set pixels_per_pageh [winfo fpixels ${canvas}\
              [set pagewidth]${snUnit}]
            set pixels_per_pagev [winfo fpixels ${canvas}\
              [set pageheight]${snUnit}]
        } else {
            set pixels_per_pagev [winfo fpixels ${canvas}\
              [set pagewidth]${snUnit}]
            set pixels_per_pageh [winfo fpixels ${canvas}\
              [set pageheight]${snUnit}]
        }
        set pages_h [expr [expr ${canv_width} * ${tfac}] / ${pixels_per_pageh}]
        set pages_v [expr [expr ${canv_height} * ${tfac}] / ${pixels_per_pagev}]

        #		set pages_v [expr $pages_v * [expr $fac / 100.0]]
        #		set pages_h [expr $pages_h * [expr $fac / 100.0]]

        if {${pages_v} < 0} {
            set pages_v 1
        }
        if {${pages_h} < 0} {
            set pages_h 1
        }

        #round to next (gerade) number
        set pages_h [Round ${pages_h}]
        set pages_v [Round ${pages_v}]

        $itk_component(hull).ps.factor_entry delete 0 end
        $itk_component(hull).ps.factor_entry insert 0 "${fac}"

        #		$twindow.ps.factor_entry insert end "%"

        $itk_component(hull).ps.pagev_entry delete 0 end
        $itk_component(hull).ps.pagev_entry insert 0 "${pages_v}"

        $itk_component(hull).ps.pageh_entry delete 0 end
        $itk_component(hull).ps.pageh_entry insert 0 "${pages_h}"

        return [list ${pages_v} ${pages_h}]
    }


    method PrintPostScriptPages {} {
        global print_fontmap
        global sn_options

        #move all objects of the canvas to display a title
        if {(${pages_h} > 1 || ${pages_v} > 1) && ${pr_pagenum} != 0} {
            #			foreach it [$canvas find withtag all] {
            #				$canvas move $it 0 $step
            #			}
            ${canvas} move all 0 ${step}
        }
        #move all boxes tow pixels to upper, to center text in the boxes on\
          paper
        #that meen, the outfit is different on SCREEN and on PAPER
        #This is a workaround for a Tk bug.
        ${canvas} move %boxes% 0 -2

        set factor [expr {[set factor_entry] / 100.0}]
        set pixels_hi [expr {${pixels_per_pagev} / ${factor}}]
        set pixels_wi [expr {${pixels_per_pageh} / ${factor}}]

        set t [expr {(${pagew} * ${pixels_hi}) / ${pageh}}]
        if {((${pixels_hi} + ${step}) / ${pageh}) >
                (${pixels_wi} / ${pagew})} {
            set pixels_wi [expr {(${pagew} * ${pixels_hi}) / ${pageh}}]
        }

        set pfd [open [set file] "w+"]
        fconfigure ${pfd} -encoding $sn_options(def,system-encoding) -blocking 0
        set t "_"
        set i 0
        while {${i} < ${pages_h}} {

            set j 0
            while {${j} < ${pages_v}} {

                #horizontal pages
                set xi [expr ${pixels_wi} * ${i}]
                #vertical pages
                set yi [expr ${pixels_hi} * ${j}]
                #set pageanchor "center"

                #print a title if more than one page
                if {(${pages_h} > 1 || ${pages_v} > 1) && ${pr_pagenum} != 0} {
                    set geom [list ${xi} ${yi} [expr {${xi} + ${pixels_wi}}]\
                      [expr {${yi} + ${step} - 1}]]
                    set id2 [eval ${canvas} create rect ${geom} -outline red\
                      -fill white -outline white -tags "Printer:Dlg"]
                    set tx [expr {${xi} + ((${pixels_wi} - ${twidth}) / 2)}]
                    set ty [expr {${yi} + ((${step} - ${theight}) / 2)}]
                    set id1 [${canvas} create text ${tx} ${ty}\
                      -font ${header_font} -text "[get_indep String SQLPPage]\
                      [expr ${j} + 1]-[expr ${i} + 1]" -anchor nw\
                      -tag "Printer:Dlg"]
                    ${canvas} raise ${id1} ${id2}

                    #wait to draw the new widgets
                    update
                }

                #				eval
                puts ${pfd} [${canvas} postscript -x ${xi} -y ${yi}\
                  -width ${pixels_wi} -height [expr ${pixels_hi} + ${step}]\
                  -pagex ${leftm}${unit} -pagey ${topm}${unit} -rotate\
                  [set rotate] -colormode [set colormode]\
                  -fontmap print_fontmap -pagewidth ${pagew}${unit}\
                  -pageheight ${pageh}${unit} -pageanchor ${pageanchor}]
                #						-file [set $this-file]$j$t$i.ps
                incr j
            }
            incr i
        }
        close ${pfd}

        #move back objects of the canvas to original coordinates
        set test 0
        if {${test} == 0} {
            if {(${pages_h} > 1 || ${pages_v} > 1) && ${pr_pagenum} != 0} {
                #remove all created items on the canvas created by printer
                ${canvas} delete Printer:Dlg
                #			foreach it [$canvas find withtag all] {
                #				$canvas move $it 0 -${step}
                #			}
                ${canvas} move all 0 -${step}
            }
        }
        ${canvas} move %boxes% 0 2
    }

    method postscript_parameters {} {

        if {${rotate} == 0} {
        } else {
        }

        set rotate [set rotate]
        if {${rotate}} {
            set topm    [set pagex]
            set leftm   [set pagey]
            set rightm  [set pageb]
            set botm    [set pager]

            set pageh   [expr {([set ${this}-pagewidth] - ${topm}) - ${botm}}]
            set pagew   [expr {([set ${this}-pageheight] - ${leftm}) - ${rightm}}]
        } else {
            set topm    [expr {[set pageheight] - [set pagey]}]
           #set topm    [set pagey]
            set leftm   [set pagex]
            set rightm  [set pager]
            set botm    [set pageb]

            set pagew   [expr {([set pagewidth] - ${leftm})- ${rightm}}]
            set pageh   [expr ${topm} - ${botm}]
        }
        ##scale the returned values to Printer DPI's
        set pagew [expr ${pagew} * ${scr_factor}]
        set pageh [expr ${pageh} * ${scr_factor}]

        set pars "-colormode [set colormode] -file [set file]\
          -pagex ${leftm}${unit} -pagey ${topm}${unit} -rotate ${rotate}\
          -pageanchor ${pageanchor} -x ${x} -y ${y} "

        set scr [lindex [${canvas} config -scrollregion] 4]
        set x_size [lindex ${scr} 2]
        set y_size [lindex ${scr} 3]

        if {[winfo fpixels ${canvas} [set pageheight]${unit}] <\
          ${y_size}} {
            set pgh [expr [set pageheight] - [set pagey]]
            append pars "-width ${x_size} -height ${y_size}\
              -pageheight ${pgh}${unit}"
        }\
        elseif {[winfo fpixels ${canvas} [set pagewidth]${unit}] <\
          ${x_size}} {
            set pgh [expr [set pagewidth] - [set pagex]]
            append pars "-width ${x_size} -height ${y_size}\
              -pagewidth ${pgh}${unit}"
        } else {
            append pars "-width [set pagewidth]${unit} -height\
              [set pageheight]${unit}"
        }

        if {[CalcPostScriptPages [set factor_entry]] == ""} {
            return ""
        }

        return ${pars}
    }

    method printit {} {
        global sn_options
        global env sn_debug tcl_platform

        if {${no_show_lines} && [string first "color" [winfo visual .]] !=\
          -1 && [set colormode] == "mono"} {

            set map 1
        } else {
            set map 0
        }

        if {${map}} {
            set pars ""
            foreach it [${canvas} find withtag all] {
                set type [${canvas} type ${it}]
                switch ${type} {
                    "rectangle" {
                            lappend pars [list ${it} -outline [lindex\
                              [${canvas} itemconfigure ${it} -outline] 4]]
                            ${canvas} itemconfigure ${it}\
                              -outline $sn_options(def,print-form-fg)
                        }
                    "line" {
                            lappend pars [list ${it} -fill [lindex\
                              [${canvas} itemconfigure ${it} -fill] 4]]
                            ${canvas} itemconfigure ${it}\
                              -fill $sn_options(def,print-form-bg)
                        }
                    "text" {
                            lappend pars [list ${it} -fill [lindex\
                              [${canvas} itemconfigure ${it} -fill] 4]]
                            ${canvas} itemconfigure ${it} -fill Black
                        }
                }
            }
        }

        set ps_cmd [postscript_parameters]
        sn_log "postscript parameters: <${ps_cmd}>"

        if {$tcl_platform(platform) != "windows" && ${ps_cmd} == ""} {
            bell -displayof ${canvas}