home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / demos / BWidgets / demo.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  6.0 KB  |  211 lines
  1. #!/bin/sh
  2. # The next line is executed by /bin/sh, but not tcl \
  3. exec wish "$0" ${1+"$@"}
  4.  
  5. namespace eval Demo {
  6.     variable _wfont
  7.  
  8.     variable notebook
  9.     variable mainframe
  10.     variable status
  11.     variable prgtext
  12.     variable prgindic
  13.     variable font
  14.     variable font_name
  15.     variable toolbar1  1
  16.     variable toolbar2  1
  17.  
  18.     set pwd [pwd]
  19.     cd [file dirname [info script]]
  20.     variable DEMODIR [pwd]
  21.     cd $pwd
  22.  
  23.     foreach script {
  24.     manager.tcl basic.tcl select.tcl dnd.tcl tree.tcl tmpldlg.tcl
  25.     } {
  26.     namespace inscope :: source $DEMODIR/$script
  27.     }
  28. }
  29.  
  30.  
  31. proc Demo::create { } {
  32.     global   tk_patchLevel
  33.     variable _wfont
  34.     variable notebook
  35.     variable mainframe
  36.     variable font
  37.     variable prgtext
  38.     variable prgindic
  39.  
  40.     set prgtext "Please wait while loading font..."
  41.     set prgindic -1
  42.     _create_intro
  43.     update
  44.     SelectFont::loadfont
  45.  
  46.     # Menu description
  47.     set descmenu {
  48.         "&File" all file 0 {
  49.             {command "E&xit" {} "Exit BWidget demo" {} -command exit}
  50.         }
  51.         "&Options" all options 0 {
  52.             {checkbutton "Toolbar &1" {all option} "Show/hide toolbar 1" {}
  53.                 -variable Demo::toolbar1
  54.                 -command  {$Demo::mainframe showtoolbar 0 $Demo::toolbar1}
  55.             }
  56.             {checkbutton "Toolbar &2" {all option} "Show/hide toolbar 2" {}
  57.                 -variable Demo::toolbar2
  58.                 -command  {$Demo::mainframe showtoolbar 1 $Demo::toolbar2}
  59.             }
  60.         }
  61.     }
  62.  
  63.     set prgtext   "Creating MainFrame..."
  64.     set prgindic  0
  65.     set mainframe [MainFrame .mainframe \
  66.                        -menu         $descmenu \
  67.                        -textvariable Demo::status \
  68.                        -progressvar  Demo::prgindic]
  69.  
  70.     # toolbar 1 creation
  71.     incr prgindic
  72.     set tb1  [$mainframe addtoolbar]
  73.     set bbox [ButtonBox $tb1.bbox1 -spacing 0 -padx 1 -pady 1]
  74.     $bbox add -image [Bitmap::get new] \
  75.         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
  76.         -helptext "Create a new file"
  77.     $bbox add -image [Bitmap::get open] \
  78.         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
  79.         -helptext "Open an existing file"
  80.     $bbox add -image [Bitmap::get save] \
  81.         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
  82.         -helptext "Save file"
  83.     pack $bbox -side left -anchor w
  84.  
  85.     set sep [Separator $tb1.sep -orient vertical]
  86.     pack $sep -side left -fill y -padx 4 -anchor w
  87.  
  88.     incr prgindic
  89.     set bbox [ButtonBox $tb1.bbox2 -spacing 0 -padx 1 -pady 1]
  90.     $bbox add -image [Bitmap::get cut] \
  91.         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
  92.         -helptext "Cut selection"
  93.     $bbox add -image [Bitmap::get copy] \
  94.         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
  95.         -helptext "Copy selection"
  96.     $bbox add -image [Bitmap::get paste] \
  97.         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \
  98.         -helptext "Paste selection"
  99.     pack $bbox -side left -anchor w
  100.  
  101.    # toolbar 2 creation
  102.     incr prgindic
  103.     set tb2    [$mainframe addtoolbar]
  104.     set _wfont [SelectFont $tb2.font -type toolbar \
  105.                     -command "Demo::update_font \[$tb2.font cget -font\]"]
  106.     set font   [$_wfont cget -font]
  107.     pack $_wfont -side left -anchor w
  108.  
  109.     $mainframe addindicator -text "BWidget [package version BWidget]"
  110.     $mainframe addindicator -textvariable tk_patchLevel
  111.  
  112.     # NoteBook creation
  113.     set frame    [$mainframe getframe]
  114.     set notebook [NoteBook $frame.nb]
  115.  
  116.     set prgtext   "Creating Manager..."
  117.     incr prgindic
  118.     set f0  [DemoManager::create $notebook]
  119.     set prgtext   "Creating Basic..."
  120.     incr prgindic
  121.     set f1  [DemoBasic::create $notebook]
  122.     set prgtext   "Creating Select..."
  123.     incr prgindic
  124.     set f2 [DemoSelect::create $notebook]
  125.     set prgtext   "Creating Dialog..."
  126.     incr prgindic
  127.     set f3b [DemoDlg::create $notebook]
  128.     set prgtext   "Creating Drag and Drop..."
  129.     incr prgindic
  130.     set f4 [DemoDnd::create $notebook]
  131.     set prgtext   "Creating Tree..."
  132.     incr prgindic
  133.     set f5 [DemoTree::create $notebook]
  134.  
  135.     set prgtext   "Done"
  136.     incr prgindic
  137.     $notebook compute_size
  138.     pack $notebook -fill both -expand yes -padx 4 -pady 4
  139.     $notebook raise [$notebook page 0]
  140.  
  141.     pack $mainframe -fill both -expand yes
  142.     update idletasks
  143.     destroy .intro
  144. }
  145.  
  146.  
  147. proc Demo::update_font { newfont } {
  148.     variable _wfont
  149.     variable notebook
  150.     variable font
  151.     variable font_name
  152.  
  153.     . configure -cursor watch
  154.     if { $font != $newfont } {
  155.         $_wfont configure -font $newfont
  156.         $notebook configure -font $newfont
  157.         set font $newfont
  158.     }
  159.     . configure -cursor ""
  160. }
  161.  
  162.  
  163. proc Demo::_create_intro { } {
  164.     variable DEMODIR
  165.  
  166.     set top [toplevel .intro -relief raised -borderwidth 2]
  167.  
  168.     wm withdraw $top
  169.     wm overrideredirect $top 1
  170.  
  171.     set ximg  [label $top.x -bitmap @$DEMODIR/x1.xbm \
  172.         -foreground grey90 -background white]
  173.     set bwimg [label $ximg.bw -bitmap @$DEMODIR/bwidget.xbm \
  174.         -foreground grey90 -background white]
  175.     set frame [frame $ximg.f -background white]
  176.     set lab1  [label $frame.lab1 -text "Loading demo" \
  177.         -background white -font {times 8}]
  178.     set lab2  [label $frame.lab2 -textvariable Demo::prgtext \
  179.         -background white -font {times 8} -width 35]
  180.     set prg   [ProgressBar $frame.prg -width 50 -height 10 -background white \
  181.         -variable Demo::prgindic -maximum 10]
  182.     pack $lab1 $lab2 $prg
  183.     place $frame -x 0 -y 0 -anchor nw
  184.     place $bwimg -relx 1 -rely 1 -anchor se
  185.     pack $ximg
  186.     BWidget::place $top 0 0 center
  187.     wm deiconify $top
  188. }
  189.  
  190.  
  191. proc Demo::main {} {
  192.     variable DEMODIR
  193.  
  194.     lappend ::auto_path [file dirname $DEMODIR]
  195.     namespace inscope :: package require BWidget
  196.  
  197.     option add *TitleFrame.l.font {helvetica 11 bold italic}
  198.  
  199.     wm withdraw .
  200.     wm title . "BWidget demo"
  201.  
  202.     Demo::create
  203.     BWidget::place . 0 0 center
  204.     wm deiconify .
  205.     raise .
  206.     focus -force .
  207. }
  208.  
  209. Demo::main
  210. wm geom . [wm geom .]
  211.