printdialog.tcl

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

            return
        }

        if {$tcl_platform(platform) != "windows"} {
            set print_cmd [set PrinterCmd]
            # Escape [] and $ in user input for eval in sn_print_file
            regsub -all {(\$|\[|\])} $print_cmd {\\&} print_cmd
            set file [set file]
            set file [file nativename ${file}]
        } else {
            set file [sn_tmpFileName]
            set file ${file}
            #dummy
            set print_cmd ide_winprint
        }

        #print postscript into the specified file
        ${this} PrintPostScriptPages

        if {${map}} {
            foreach cmd ${pars} {
                eval ${canvas} itemconfigure ${cmd}
            }
        }

        if {$tcl_platform(platform) == "windows"} {
            sn_print_file ${print_cmd} ${file} -postscript
            catch {file delete -force -- ${file}}
        }\
        elseif {[set PrintTo] == "printer" && [string compare\
          ${print_cmd} ""] != 0} {
            sn_print_file ${print_cmd} ${file}
        }
    }

    public variable no_show_lines 0

    public variable colormap {}
    public variable colormode {mono}
    public variable file {} {
        global sn_options

        if {[string compare ${file} ""] == 0} {
            set file [file join $sn_options(profile_dir) print.ps]
        }
    }

    public variable fontmap {} {}

    public variable pageanchor {nw} {}

    public variable pageheight {29.7} {
        global ${this}-pageheight
        set ${this}-pageheight ${pageheight}
    }

    public variable pagewidth {21} {}

    public variable pagex {0.5} {}

    public variable pager {0.5} {
        global ${this}-pager
        set ${this}-pager ${pager}
    }

    public variable pagey {1.0} {}

    public variable pageb {1.0} {}

    public variable rotate {0} {
    }

    public variable x {0}

    public variable y {0}

    public variable PrintTo {file} {}

    public variable PrinterCmd "" {
        global sn_options

        if {[string compare ${PrinterCmd} ""] == 0} {
            catch {set PrinterCmd $sn_options(def,print-command)}
        }

        if {[string compare ${PrinterCmd} ""] != 0} {
            set state normal
        } else {
            set state disabled
        }

        if {[winfo exists $itk_component(hull).printerframe.entry]} {
            $itk_component(hull).printerframe.entry config -state ${state}
        }
    }

    public variable range [get_indep String SQLPprintall] {}

    public variable copycount {1} {}

    public variable pageformat "" {
        global sn_options

        if {$sn_options(def,page-format) == ""} {
            set sn_options(def,page-format) [lindex\
              [lindex $sn_options(def,page-formats) 0] 0]
        }

        if {${pageformat} != ""} {
            set sn_options(def,page-format) ${pageformat}
        } else {
            set pageformat $sn_options(def,page-format)
        }

        pageformat ${pageformat}
    }

    method pageformat {fmt} {
        global sn_options

        upvar #0 sn_options(def,page-format) pf

        set pageformat ${pf}

        set fnd 0
        foreach n $sn_options(def,page-formats) {
            if {[lindex ${n} 0] == ${fmt}} {
                set pagewidth [lindex ${n} 1]
                set pageheight [lindex ${n} 2]
                set unit [lindex ${n} 3]
                set fnd 1
            }
        }
        if {${fnd} == 0} {
            bell
            return
        }
        if {${unit} == "cm"} {
            set unit "c"
        } else {
            set unit "i"
        }

        if {${unit} == "i"} {
            set unit "inch"
            set pagex 0.2
            set pager 0.2
            set pagey 0.4
            set pageb 0.4
        } else {
            set unit "cm"
            set pagex 0.5
            set pager 0.5
            set pagey 1.0
            set pageb 1.0
        }
	if {[winfo exists $itk_component(hull).ps.factor_entry]} {
	    CalcPostScriptPages ${factor_entry}
	}
    }

    public variable canvas {}
    public variable action {}
    public variable unit {c}
    protected variable busy {}
    protected variable entry_pars "%1_6_2"
    common last_print_cmd {}
    public variable init_withdraw 0
    public variable grab 1

    common scr_factor 1.0
    protected variable x_size
    protected variable y_size
    protected variable pixels_per_pageh
    protected variable pixels_per_pagev
    protected variable pages_v
    protected variable pages_h
    protected variable topm
    protected variable leftm
    protected variable rightm
    protected variable botm
    protected variable pageh
    protected variable pagew
    protected variable tx
    protected variable ty
    protected variable twidth
    protected variable theight
    protected variable step
    protected variable pr_pagenum 1
    common header_font ""

    private variable pagev_entry ""
    private variable pageh_entry ""
    private variable factor_entry ""
}

proc custom_pos {} {
    global lay_pos

    if {[info exists rep_txt_pos] == 1} {
        return
    }

    set lay_pos [sourcenav::Window::next_window_name]
    sourcenav::Window ${lay_pos}
    ${lay_pos} withdraw
    ${lay_pos} configure -title [get_indep String ODDReportFieldPosTitle]

    set obj ${lay_pos}.fr_pos
    frame ${obj}
    frame ${obj}.tmp -bd 5
    text ${obj}.tmp.text_pos -relief raised -bd 2\
      -yscrollcommand "${obj}.tmp.scroll set" -width 40 -height 10
    scrollbar ${obj}.tmp.scroll -command " ${obj}.tmp.text_pos yview "
    label ${obj}.tmp.l -text [get_indep String ODDReportFieldPos] -padx 10
    pack ${obj}.tmp.l -side left
    pack ${obj}.tmp.scroll -side right -fill y
    pack ${obj}.tmp.text_pos -side left -fill both -expand y
    pack ${obj}.tmp -side top -fill both -expand y
    frame ${obj}.butt -bd 5
    button ${obj}.butt.ok -text [get_indep String ODDReportTakeOver]\
      -relief raised -command { get_pos
            unset lay_pos
            unset rep_names_pos } -width 10
    button ${obj}.butt.his -text [get_indep String ODDSapHistory]\
      -relief raised -command " SQLHistory " -width 10
    button ${obj}.butt.cancel -text [get_indep String cancel] -relief raised\
      -command { itcl::delete object ${lay_pos}
            unset lay_pos
            unset rep_names_pos } -width 10
    pack ${obj}.butt.ok -side left -expand y
    pack ${obj}.butt.his -side left -expand y
    pack ${obj}.butt.cancel -side left -expand y
    pack ${obj}.butt -side top -fill x
    pack ${obj} -side bottom -fill both -expand y
    ${lay_pos} move_to_mouse
    ${lay_pos} on_close "itcl::delete object ${lay_pos}; unset lay_pos; unset rep_names_pos"
    put_field_names
}

proc put_field_names {} {
    global lay_pos
    global field_names_pos
    global rep_names_pos
    global rep_txt_pos

    set new_field_name ""
    if {${field_names_pos} != ""} {
        foreach elem ${field_names_pos} {
            set new_field_name [lappend new_field_name ${elem}\n]
        }
        regsub -all "\{" ${new_field_name} "" new_field_name
        regsub -all "\} " ${new_field_name} "" new_field_name
        regsub -all "\}" ${new_field_name} "" new_field_name
        regsub -all "," ${new_field_name} "." new_field_name
        set rep_txt_pos ${new_field_name}
        set rep_names_pos ${rep_txt_pos}
        ${lay_pos}.fr_pos.tmp.text_pos insert 0.0 ${rep_txt_pos}
    }
}

proc get_pos {} {
    global lay_pos
    global rep_txt_pos
    global rep_names_pos

    set rep_txt_pos ""
    set tmp_field_name ""
    if {[winfo exists ${lay_pos}.fr_pos.tmp.text_pos] == 1} {
        set tmp_field_name "[${lay_pos}.fr_pos.tmp.text_pos get 0.0 end]"
    }
    if {${tmp_field_name} != ""} {
        set rep_txt_pos [split ${tmp_field_name} "\n"]
        regsub -all "\{\}" ${rep_txt_pos} "" rep_txt_pos
    }
    regsub -all "," ${rep_txt_pos} "." rep_txt_pos
    set poslen [llength ${rep_txt_pos}]
    for {set anz 0} {${anz} < ${poslen}} {incr anz} {
        set elem [lindex ${rep_txt_pos} ${anz}]
        if {[llength ${elem}] != 3} {
            if {[llength ${elem}] != 1} {
                sn_error_dialog [get_indep String ReportPosError]
                return
            }
        }
        if {[llength ${elem}] == 3} {
            if {![regexp {^([ 0-9. ]+)$|^[ 0-9 ]+$} [lindex ${elem} 1]] ||\
              ![regexp {^([ 0-9. ]+)$|^[ 0-9 ]+$} [lindex ${elem} 2]] ||\
              [lindex ${elem} 1] == "." || [lindex ${elem} 2] == "."} {
                sn_error_dialog [get_indep String ReportPosError]
                return
            }
        }
    }
    set rep_names_pos ${rep_txt_pos}
    set HistString "report ${rep_txt_pos}"
    SQLHistoryAppendCommand ${HistString}
    SQLHistoryWrite

    destroy ${lay_pos}
}

proc REPClear {} {
    global lay_pos

    if {[winfo exists ${lay_pos}.fr_pos.tmp.text_pos] == 1} {
        ${lay_pos}.fr_pos.tmp.text_pos delete 1.0 end
    }
}

proc put_field_pos {field_names} {
    global lay_pos
    global rep_txt_pos
    global rep_names_pos

    set new_field_name ""
    if {${field_names} != ""} {
        set new_field_name [lappend new_field_name ${field_names}\n]
        regsub -all "\{" ${new_field_name} "" new_field_name
        regsub -all "\} " ${new_field_name} "" new_field_name
        regsub -all "\}" ${new_field_name} "" new_field_name
        regsub -all "," ${new_field_name} "." new_field_name
        set rep_txt_pos ${new_field_name}
        set rep_names_pos ${rep_txt_pos}
        ${lay_pos}.fr_pos.tmp.text_pos insert 0.0 ${rep_txt_pos}
    }
    set rep_names_pos ${rep_txt_pos}
    return ${rep_txt_pos}
}