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 / tmpldlg.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  7.5 KB  |  215 lines
  1.  
  2. namespace eval DemoDlg {
  3.     variable tmpl
  4.     variable msg
  5.     variable progmsg
  6.     variable progval
  7.     variable resources "en"
  8. }
  9.  
  10.  
  11. proc DemoDlg::create { nb } {
  12.     set frame [$nb insert end demoDlg -text "Dialog"]
  13.  
  14.     set titf1 [TitleFrame $frame.titf1 -text "Resources"]
  15.     set titf2 [TitleFrame $frame.titf2 -text "Template Dialog"]
  16.     set titf3 [TitleFrame $frame.titf3 -text "Message Dialog"]
  17.     set titf4 [TitleFrame $frame.titf4 -text "Other dialog"]
  18.  
  19.     set subf [$titf1 getframe]
  20.     set cmd  {option read [file join $::BWIDGET::LIBRARY "lang" $DemoDlg::resources.rc]}
  21.     set rad1 [radiobutton $subf.rad1 -text "English" \
  22.                   -variable DemoDlg::resources -value en \
  23.                   -command  $cmd]
  24.     set rad2 [radiobutton $subf.rad2 -text "French" \
  25.                   -variable DemoDlg::resources -value fr \
  26.                   -command  $cmd]
  27.     set rad3 [radiobutton $subf.rad3 -text "German" \
  28.                   -variable DemoDlg::resources -value de \
  29.                   -command  $cmd]
  30.     pack $rad1 $rad2 $rad3 -side left
  31.  
  32.     _tmpldlg [$titf2 getframe]
  33.     _msgdlg  [$titf3 getframe]
  34.     _stddlg  [$titf4 getframe]
  35.  
  36.     pack $titf1 -fill x -pady 2 -padx 2
  37.     pack $titf4 -side bottom -fill x -pady 2 -padx 2
  38.     pack $titf2 $titf3 -side left -padx 2 -fill both -expand yes
  39. }
  40.  
  41.  
  42. proc DemoDlg::_tmpldlg { parent } {
  43.     variable tmpl
  44.  
  45.     set tmpl(side)   bottom
  46.     set tmpl(anchor) c
  47.  
  48.     set labf1 [LabelFrame $parent.labf1 -text "Button side" -side top \
  49.                    -anchor w -relief sunken -borderwidth 1]
  50.     set subf  [$labf1 getframe]
  51.     radiobutton $subf.rad1 -text "Bottom" \
  52.         -variable DemoDlg::tmpl(side) -value bottom -anchor w
  53.     radiobutton $subf.rad2 -text "Left" \
  54.         -variable DemoDlg::tmpl(side) -value left   -anchor w
  55.     radiobutton $subf.rad3 -text "Right" \
  56.         -variable DemoDlg::tmpl(side) -value right  -anchor w
  57.     radiobutton $subf.rad4 -text "Top" \
  58.         -variable DemoDlg::tmpl(side) -value top    -anchor w
  59.  
  60.     pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 -fill x -anchor w
  61.  
  62.     set labf2 [LabelFrame $parent.labf2 -text "Button anchor" -side top \
  63.                    -anchor w -relief sunken -borderwidth 1]
  64.     set subf  [$labf2 getframe]
  65.     radiobutton $subf.rad1 -text "North" \
  66.         -variable DemoDlg::tmpl(anchor) -value n -anchor w
  67.     radiobutton $subf.rad2 -text "West" \
  68.         -variable DemoDlg::tmpl(anchor) -value w -anchor w
  69.     radiobutton $subf.rad3 -text "East" \
  70.         -variable DemoDlg::tmpl(anchor) -value e -anchor w
  71.     radiobutton $subf.rad4 -text "South" \
  72.         -variable DemoDlg::tmpl(anchor) -value s -anchor w
  73.     radiobutton $subf.rad5 -text "Center" \
  74.         -variable DemoDlg::tmpl(anchor) -value c -anchor w
  75.  
  76.     pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 $subf.rad5 -fill x -anchor w
  77.  
  78.     set sep    [Separator  $parent.sep -orient horizontal]
  79.     set button [button $parent.but -text "Show" -command DemoDlg::_show_tmpldlg]
  80.  
  81.     pack $button -side bottom
  82.     pack $sep -side bottom -fill x -pady 10
  83.     pack $labf1 $labf2 -side left -padx 4 -anchor n
  84. }
  85.  
  86.  
  87. proc DemoDlg::_msgdlg { parent } {
  88.     variable msg
  89.  
  90.     set msg(type) ok
  91.     set msg(icon) info
  92.  
  93.     set labf1 [LabelFrame $parent.labf1 -text "Type" -side top \
  94.                    -anchor w -relief sunken -borderwidth 1]
  95.     set subf  [$labf1 getframe]
  96.     radiobutton $subf.rad1 -text "Ok" -variable DemoDlg::msg(type) -value ok -anchor w
  97.     radiobutton $subf.rad2 -text "Ok, Cancel" -variable DemoDlg::msg(type) -value okcancel -anchor w
  98.     radiobutton $subf.rad3 -text "Retry, Cancel" -variable DemoDlg::msg(type) -value retrycancel -anchor w
  99.     radiobutton $subf.rad4 -text "Yes, No" -variable DemoDlg::msg(type) -value yesno -anchor w
  100.     radiobutton $subf.rad5 -text "Yes, No, Cancel" -variable DemoDlg::msg(type) -value yesnocancel -anchor w
  101.     radiobutton $subf.rad6 -text "Abort, Retry, Ignore" -variable DemoDlg::msg(type) -value abortretryignore -anchor w
  102.     radiobutton $subf.rad7 -text "User" -variable DemoDlg::msg(type) -value user -anchor w
  103.     Entry $subf.user -textvariable DemoDlg::msg(buttons)
  104.  
  105.     pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 $subf.rad5 $subf.rad6 -fill x -anchor w
  106.     pack $subf.rad7 $subf.user -side left
  107.  
  108.     set labf2 [LabelFrame $parent.labf2 -text "Icon" -side top -anchor w -relief sunken -borderwidth 1]
  109.     set subf  [$labf2 getframe]
  110.     radiobutton $subf.rad1 -text "Information" -variable DemoDlg::msg(icon) -value info     -anchor w
  111.     radiobutton $subf.rad2 -text "Question"    -variable DemoDlg::msg(icon) -value question -anchor w
  112.     radiobutton $subf.rad3 -text "Warning"     -variable DemoDlg::msg(icon) -value warning  -anchor w
  113.     radiobutton $subf.rad4 -text "Error"       -variable DemoDlg::msg(icon) -value error    -anchor w
  114.     pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 -fill x -anchor w
  115.  
  116.  
  117.     set sep    [Separator  $parent.sep -orient horizontal]
  118.     set button [button $parent.but -text "Show" -command DemoDlg::_show_msgdlg]
  119.  
  120.     pack $button -side bottom
  121.     pack $sep -side bottom -fill x -pady 10
  122.     pack $labf1 $labf2 -side left -padx 4 -anchor n
  123. }
  124.  
  125.  
  126. proc DemoDlg::_stddlg { parent } {
  127.     set but0  [button $parent.but0 \
  128.                    -text "Select a color " \
  129.                    -command "DemoDlg::_show_color $parent.but0"]
  130.     set but1  [button $parent.but1 \
  131.                    -text    "Font selector dialog" \
  132.                    -command DemoDlg::_show_fontdlg]
  133.     set but2  [button $parent.but2 \
  134.                    -text    "Progression dialog" \
  135.                    -command DemoDlg::_show_progdlg]
  136.     set but3  [button $parent.but3 \
  137.                    -text    "Password dialog" \
  138.                    -command DemoDlg::_show_passdlg]
  139.  
  140.     pack $but0 $but1 $but2 $but3 -side left -padx 5 -anchor w
  141. }
  142.  
  143. proc DemoDlg::_show_color {w} {
  144.     set color [SelectColor::menu $w.color [list below $w] \
  145.                        -color [$w cget -background]]
  146.     if {[string length $color]} {
  147.         $w configure -background $color
  148.     }
  149. }
  150.  
  151. proc DemoDlg::_show_tmpldlg { } {
  152.     variable tmpl
  153.  
  154.     set dlg [Dialog .tmpldlg -parent . -modal local \
  155.                  -separator 1 \
  156.                  -title   "Template dialog" \
  157.                  -side    $tmpl(side)    \
  158.                  -anchor  $tmpl(anchor)  \
  159.                  -default 0 -cancel 1]
  160.     $dlg add -name ok
  161.     $dlg add -name cancel
  162.     set msg [message [$dlg getframe].msg -text "Template\nDialog" -justify center -anchor c]
  163.     pack $msg -fill both -expand yes -padx 100 -pady 100
  164.     $dlg draw
  165.     destroy $dlg
  166. }
  167.  
  168.  
  169. proc DemoDlg::_show_msgdlg { } {
  170.     variable msg
  171.  
  172.     destroy .msgdlg
  173.     MessageDlg .msgdlg -parent . \
  174.         -message "Message for MessageBox" \
  175.         -type    $msg(type) \
  176.         -icon    $msg(icon) \
  177.         -buttons $msg(buttons)
  178. }
  179.  
  180.  
  181. proc DemoDlg::_show_fontdlg { } {
  182.     set font [SelectFont .fontdlg -parent . -font $Demo::font]
  183.     if { $font != "" } {
  184.         Demo::update_font $font
  185.     }
  186. }
  187.  
  188.  
  189. proc DemoDlg::_show_progdlg { } {
  190.     set DemoDlg::progmsg "Compute in progress..."
  191.     set DemoDlg::progval 0
  192.  
  193.     ProgressDlg .progress -parent . -title "Wait..." \
  194.         -type         infinite \
  195.         -width        20 \
  196.         -textvariable DemoDlg::progmsg \
  197.         -variable     DemoDlg::progval \
  198.         -stop         "Stop" \
  199.         -command      {destroy .progress}
  200.     _update_progdlg
  201. }
  202.  
  203.  
  204. proc DemoDlg::_update_progdlg { } {
  205.     if { [winfo exists .progress] } {
  206.         set DemoDlg::progval 2
  207.         after 20 DemoDlg::_update_progdlg
  208.     }
  209. }
  210.  
  211. proc DemoDlg::_show_passdlg { } {
  212.     PasswdDlg .passwd -parent .
  213. }
  214.  
  215.