0byt3m1n1
Path:
C:
/
Program Files
/
R
/
R-4.4.1
/
Tcl
/
lib
/
BWidget
/
demo
/
[
Home
]
File: demo.tcl
#!/bin/sh # The next line is executed by /bin/sh, but not tcl \ exec wish "$0" ${1+"$@"} namespace eval Demo { variable _wfont variable notebook variable mainframe variable status variable prgtext variable prgindic variable font variable font_name variable toolbar1 1 variable toolbar2 1 set pwd [pwd] cd [file dirname [info script]] variable DEMODIR [pwd] cd $pwd foreach script { manager.tcl basic.tcl select.tcl dnd.tcl tree.tcl tmpldlg.tcl } { namespace inscope :: source $DEMODIR/$script } } image create photo bwidget16 -data { R0lGODlhEAAQAOMJABat6IGYffaBCUSku/KCDcCMPomXdgCy//+AANnZ2dnZ2dnZ2dnZ2dnZ2dnZ 2dnZ2SH5BAEKAA8ALAAAAAAQABAAAAQ58MlJq70U6a0x/9c2iRb5mNmHjmpXuiecIpRA0JWJDEfw HIffoWU4AIBBYKuABAoxSGEQ6oxins8IADs= } image create photo faded16 -data { R0lGODlhEAAQAKEDAAAAAICAgKCgoP///yH5BAEKAAMALAAAAAAQABAAAAIjnI+py+1vQEABsDoH blUI+XyAAImk033Zsmng8hoVRNd2XQAAOw== } image create photo stop16 -data { R0lGODlhEAAQAMIFAAAAAC8DA3gKCpYMDPAUFP///////////yH5BAEKAAcALAAAAAAQABAAAAMm SLrc/jDKqYBgAsB8CY/ZMFjTGAzUEACoFI7d83nkUysZpe/8ngAAOw== } proc Demo::create { } { global tk_patchLevel variable _wfont variable notebook variable mainframe variable font variable prgtext variable prgindic set prgtext "Please wait while loading font..." set prgindic -1 _create_intro update SelectFont::loadfont bind all <F12> { catch {console show} } # Menu description set descmenu { "&File" all file 0 { {command "E&xit" {} "Exit BWidget demo" {} -command exit} } "&Options" all options 0 { {checkbutton "Toolbar &1" {all option} "Show/hide toolbar 1" {} -variable Demo::toolbar1 -command {$Demo::mainframe showtoolbar 0 $Demo::toolbar1} } {checkbutton "Toolbar &2" {all option} "Show/hide toolbar 2" {} -variable Demo::toolbar2 -command {$Demo::mainframe showtoolbar 1 $Demo::toolbar2} } } } set prgtext "Creating MainFrame..." set prgindic 0 set mainframe [MainFrame .mainframe \ -menu $descmenu \ -textvariable Demo::status \ -progressvar Demo::prgindic] # toolbar 1 creation incr prgindic set tb1 [$mainframe addtoolbar] set bbox [ButtonBox $tb1.bbox1 -spacing 0 -padx 1 -pady 1] $bbox add -image [Bitmap::get new] \ -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ -helptext "Create a new file" $bbox add -image [Bitmap::get open] \ -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ -helptext "Open an existing file" $bbox add -image [Bitmap::get save] \ -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ -helptext "Save file" pack $bbox -side left -anchor w set sep [Separator $tb1.sep -orient vertical] pack $sep -side left -fill y -padx 4 -anchor w incr prgindic set bbox [ButtonBox $tb1.bbox2 -spacing 0 -padx 1 -pady 1] $bbox add -image [Bitmap::get cut] \ -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ -helptext "Cut selection" $bbox add -image [Bitmap::get copy] \ -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ -helptext "Copy selection" $bbox add -image [Bitmap::get paste] \ -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ -helptext "Paste selection" pack $bbox -side left -anchor w # toolbar 2 creation incr prgindic set tb2 [$mainframe addtoolbar] set _wfont [SelectFont $tb2.font -type toolbar \ -command "Demo::update_font \[$tb2.font cget -font\]"] set font [$_wfont cget -font] pack $_wfont -side left -anchor w $mainframe addindicator -text "BWidget [package version BWidget]" $mainframe addindicator -textvariable tk_patchLevel # NoteBook creation set frame [$mainframe getframe] set notebook [NoteBook $frame.nb] set prgtext "Creating Manager..." incr prgindic set f0 [DemoManager::create $notebook] set prgtext "Creating Basic..." incr prgindic set f1 [DemoBasic::create $notebook] set prgtext "Creating Select..." incr prgindic set f2 [DemoSelect::create $notebook] set prgtext "Creating Dialog..." incr prgindic set f3b [DemoDlg::create $notebook] set prgtext "Creating Drag and Drop..." incr prgindic set f4 [DemoDnd::create $notebook] set prgtext "Creating Tree..." incr prgindic set f5 [DemoTree::create $notebook] foreach page [$notebook pages] { $notebook itemconfigure $page \ -image bwidget16 \ -rimage faded16 \ -ractiveimage stop16 \ -rimagecmd {::Demo::_close_tab} } set prgtext "Done" incr prgindic $notebook compute_size pack $notebook -fill both -expand yes -padx 4 -pady 4 $notebook raise [$notebook page 0] pack $mainframe -fill both -expand yes update idletasks destroy .intro } proc Demo::_close_tab { tabSet tabName } { after idle [list $tabSet delete $tabName] set tabIndex [$tabSet index $tabName] set tabList [$tabSet pages] set tabTot [llength $tabList] # Pick another tab to raise. if {$tabTot == 1} { # No other tabs. exit } elseif {$tabIndex < $tabTot - 1} { # Raise the tab to the right. set raiseTabName [lindex $tabList [expr {$tabIndex + 1}]] } else { # This tab is furthest to the right. Raise the tab to the left. set raiseTabName [lindex $tabList [expr {$tabIndex - 1}]] } $tabSet raise $raiseTabName $tabSet see $raiseTabName return } proc Demo::update_font { newfont } { variable _wfont variable notebook variable font variable font_name . configure -cursor watch if { $font != $newfont } { $_wfont configure -font $newfont $notebook configure -font $newfont set font $newfont } . configure -cursor "" } proc Demo::_create_intro { } { variable DEMODIR set top [toplevel .intro -relief raised -borderwidth 2] wm withdraw $top wm overrideredirect $top 1 set ximg [label $top.x -bitmap @$DEMODIR/x1.xbm \ -foreground grey90 -background white] set bwimg [label $ximg.bw -bitmap @$DEMODIR/bwidget.xbm \ -foreground grey90 -background white] set frame [frame $ximg.f -background white] set lab1 [label $frame.lab1 -text "Loading demo" \ -background white -font {times 8}] set lab2 [label $frame.lab2 -textvariable Demo::prgtext \ -background white -font {times 8} -width 35] set prg [ProgressBar $frame.prg -width 50 -height 10 -background white \ -variable Demo::prgindic -maximum 10] pack $lab1 $lab2 $prg place $frame -x 0 -y 0 -anchor nw place $bwimg -relx 1 -rely 1 -anchor se pack $ximg BWidget::place $top 0 0 center wm deiconify $top } proc Demo::main {} { variable DEMODIR lappend ::auto_path [file dirname $DEMODIR] package require BWidget option add *TitleFrame.l.font {helvetica 11 bold italic} if {$::tk_version < 8.5} { set helpFont {helvetica 12} } else { set helpFont {TkDefaultFont 10} } DynamicHelp::configure \ -background #FFFFC0 \ -foreground #141312 \ -padx 3 \ -font $helpFont wm withdraw . wm title . "BWidget demo" Demo::create BWidget::place . 0 0 center wm deiconify . raise . focus -force . } Demo::main wm geom . [wm geom .]