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 / basic.tcl next >
Encoding:
Text File  |  2001-10-22  |  6.8 KB  |  200 lines
  1.  
  2. namespace eval DemoBasic {
  3.     variable var
  4.     variable count 0
  5.     variable id    ""
  6. }
  7.  
  8.  
  9. proc DemoBasic::create { nb } {
  10.     set frame [$nb insert end demoBasic -text "Basic"]
  11.  
  12.     set topf  [frame $frame.topf]
  13.     set titf1 [TitleFrame $topf.titf1 -text "Label"]
  14.     set titf2 [TitleFrame $topf.titf2 -text "Entry"]
  15.     set titf3 [TitleFrame $frame.titf3 -text "Button and ArrowButton"]
  16.  
  17.     _label  [$titf1 getframe]
  18.     _entry  [$titf2 getframe]
  19.     _button [$titf3 getframe]
  20.  
  21.     pack $titf1 $titf2 -side left -fill both -padx 4 -expand yes
  22.     pack $topf -pady 2 -fill x
  23.     pack $titf3 -pady 2 -padx 4 -fill x
  24.  
  25.     return $frame
  26. }
  27.  
  28.  
  29. proc DemoBasic::_label { parent } {
  30.     variable var
  31.  
  32.     set lab [Label $parent.label -text "This is a Label widget" \
  33.                  -helptext "Label widget"]
  34.     set chk [checkbutton $parent.chk -text "Disabled" \
  35.                  -variable DemoBasic::var($lab,-state) \
  36.                  -onvalue  disabled -offvalue normal \
  37.                  -command  "$lab configure -state \$DemoBasic::var($lab,-state)"]
  38.     pack $lab -anchor w -pady 4
  39.     pack $chk -anchor w
  40. }
  41.  
  42.  
  43. proc DemoBasic::_entry { parent } {
  44.     set ent  [Entry $parent.entry -text "Press enter" \
  45.                   -command  {set DemoBasic::var(entcmd) "-command called"; after 500 {set DemoBasic::var(entcmd) ""}} \
  46.                    -helptext "Entry widget"]
  47.     set chk1 [checkbutton $parent.chk1 -text "Disabled" \
  48.                   -variable DemoBasic::var($ent,state) \
  49.                   -onvalue  disabled -offvalue normal \
  50.                   -command  "$ent configure -state \$DemoBasic::var($ent,state)"]
  51.     set chk2 [checkbutton $parent.chk2 -text "Non editable" \
  52.                   -variable DemoBasic::var($ent,editable) \
  53.                   -onvalue  false -offvalue true \
  54.                   -command  "$ent configure -editable \$DemoBasic::var($ent,editable)"]
  55.     set lab  [label $parent.cmd -textvariable DemoBasic::var(entcmd) -foreground red]
  56.     pack $ent -pady 4 -anchor w
  57.     pack $chk1 $chk2 -anchor w
  58.     pack $lab -pady 4
  59. }
  60.  
  61.  
  62. proc DemoBasic::_button { parent } {
  63.     variable var
  64.  
  65.     set frame [frame $parent.butfr]
  66.     set but   [Button $frame.but -text "Press me!" \
  67.                    -repeatdelay 300 \
  68.                    -command  "DemoBasic::_butcmd command" \
  69.                    -helptext "This is a Button widget"]
  70.     set sep1  [Separator $frame.sep1 -orient vertical]
  71.     set arr1  [ArrowButton $frame.arr1 -type button \
  72.                    -width 25 -height 25 \
  73.                    -repeatdelay 300 \
  74.                    -command  "DemoBasic::_butcmd command" \
  75.                    -helptext "This is an ArrowButton widget\nof type button"]
  76.     set sep2  [Separator $frame.sep2 -orient vertical]
  77.     set arr2  [ArrowButton $frame.arr2 -type arrow \
  78.                    -width 25 -height 25 -relief sunken -ipadx 0 -ipady 0 \
  79.                    -repeatdelay 300 \
  80.                    -command  "DemoBasic::_butcmd command" \
  81.                    -helptext "This is an ArrowButton widget\nof type arrow"]
  82.  
  83.     pack $but  -side left -padx 4
  84.     pack $sep1 -side left -padx 4 -fill y
  85.     pack $arr1 -side left -padx 4
  86.     pack $sep2 -side left -padx 4 -fill y
  87.     pack $arr2 -side left -padx 4
  88.     pack $frame
  89.  
  90.     set sep3  [Separator $parent.sep3 -orient horizontal]
  91.     pack $sep3 -fill x -pady 10
  92.  
  93.     set labf1 [LabelFrame $parent.labf1 -text "Command" -side top \
  94.                    -anchor w -relief sunken -borderwidth 1]
  95.     set subf  [$labf1 getframe]
  96.     set chk1  [checkbutton $subf.chk1 -text "Disabled" \
  97.                    -variable DemoBasic::var(bstate) -onvalue disabled -offvalue normal \
  98.                    -command  "DemoBasic::_bstate \$DemoBasic::var(bstate) $but $arr1 $arr2"]
  99.     set chk2  [checkbutton $subf.chk2 -text "Use -armcommand/\n-disarmcommand" \
  100.                    -justify left \
  101.                    -variable DemoBasic::var(barmcmd) \
  102.                    -command  "DemoBasic::_barmcmd \$DemoBasic::var(barmcmd) $but $arr1 $arr2"]
  103.     pack $chk1 $chk2 -anchor w
  104.  
  105.     set label [label $parent.label -textvariable DemoBasic::var(butcmd) -foreground red]
  106.     pack $label -side bottom -pady 4
  107.  
  108.     set labf2 [LabelFrame $parent.labf2 -text "Direction" -side top \
  109.                    -anchor w -relief sunken -borderwidth 1]
  110.     set subf  [$labf2 getframe]
  111.     set var(bside) top
  112.     foreach dir {top left bottom right} {
  113.         set rad [radiobutton $subf.$dir -text "$dir arrow" \
  114.                      -variable DemoBasic::var(bside) -value $dir \
  115.                      -command  "DemoBasic::_bside \$DemoBasic::var(bside) $arr1 $arr2"]
  116.         pack $rad -anchor w
  117.     }
  118.  
  119.     set labf3 [LabelFrame $parent.labf3 -text "Relief" -side top \
  120.                    -anchor w -relief sunken -borderwidth 1]
  121.     set subf  [$labf3 getframe]
  122.     set var(brelief) raised
  123.     foreach {f lrelief} {f1 {raised sunken ridge groove} f2 {flat solid link}} {
  124.         set f [frame $subf.$f]
  125.         foreach relief $lrelief {
  126.             set rad [radiobutton $f.$relief -text $relief \
  127.                          -variable DemoBasic::var(brelief) -value $relief \
  128.                          -command  "DemoBasic::_brelief \$DemoBasic::var(brelief) $but $arr1 $arr2"]
  129.             pack $rad -anchor w
  130.         }
  131.         pack $f -side left -padx 2 -anchor n
  132.     }
  133.     pack $labf1 $labf2 $labf3 -side left -fill y -padx 4
  134. }
  135.  
  136.  
  137. proc DemoBasic::_bstate { state but arr1 arr2 } {
  138.     foreach but [list $but $arr1 $arr2] {
  139.         $but configure -state $state
  140.     }
  141. }
  142.  
  143.  
  144. proc DemoBasic::_brelief { relief but arr1 arr2 } {
  145.     $but configure -relief $relief
  146.     if { $relief != "link" } {
  147.         foreach arr [list $arr1 $arr2] {
  148.             $arr configure -relief $relief
  149.         }
  150.     }
  151. }
  152.  
  153.  
  154. proc DemoBasic::_bside { side args } {
  155.     foreach arr $args {
  156.         $arr configure -dir $side
  157.     }
  158. }
  159.  
  160.  
  161. proc DemoBasic::_barmcmd { value but arr1 arr2 } {
  162.     if { $value } {
  163.         $but configure \
  164.             -armcommand    "DemoBasic::_butcmd arm" \
  165.             -disarmcommand "DemoBasic::_butcmd disarm" \
  166.             -command {}
  167.         foreach arr [list $arr1 $arr2] {
  168.             $arr configure \
  169.                 -armcommand    "DemoBasic::_butcmd arm" \
  170.                 -disarmcommand "DemoBasic::_butcmd disarm" \
  171.                 -command {}
  172.         }
  173.     } else {
  174.         $but configure -armcommand {} -disarmcommand {} \
  175.             -command  "DemoBasic::_butcmd command"
  176.         foreach arr [list $arr1 $arr2] {
  177.             $arr configure -armcommand {} -disarmcommand {} \
  178.                 -command "DemoBasic::_butcmd command"
  179.         }
  180.     }
  181. }
  182.  
  183.  
  184. proc DemoBasic::_butcmd { reason } {
  185.     variable count
  186.     variable id
  187.  
  188.     catch {after cancel $id}
  189.     if { $reason == "arm" } {
  190.         incr count
  191.         set DemoBasic::var(butcmd) "$reason command called ($count)"
  192.     } else {
  193.         set count 0
  194.         set DemoBasic::var(butcmd) "$reason command called"
  195.     }
  196.     set id [after 500 {set DemoBasic::var(butcmd) ""}]
  197. }
  198.  
  199.  
  200.