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