progressdlg.tcl 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990
  1. # ------------------------------------------------------------------------------
  2. # progressdlg.tcl
  3. # This file is part of Unifix BWidget Toolkit
  4. # ------------------------------------------------------------------------------
  5. # Index of commands:
  6. # - ProgressDlg::create
  7. # ------------------------------------------------------------------------------
  8. namespace eval ProgressDlg {
  9. Dialog::use
  10. ProgressBar::use
  11. Widget::bwinclude ProgressDlg Dialog "" \
  12. remove {
  13. -modal -image -bitmap -side -anchor -cancel -default
  14. -homogeneous -padx -pady -spacing
  15. }
  16. Widget::bwinclude ProgressDlg ProgressBar .frame.pb \
  17. remove {-orient -width -height}
  18. Widget::declare ProgressDlg {
  19. {-width TkResource 25 0 label}
  20. {-height TkResource 2 0 label}
  21. {-textvariable TkResource "" 0 label}
  22. {-font TkResource "" 0 label}
  23. {-stop String "" 0}
  24. {-command String "" 0}
  25. }
  26. Widget::addmap ProgressDlg "" .frame.msg \
  27. {-width {} -height {} -textvariable {} -font {} -background {}}
  28. proc ::ProgressDlg { path args } { return [eval ProgressDlg::create $path $args] }
  29. proc use {} {}
  30. }
  31. # ------------------------------------------------------------------------------
  32. # Command ProgressDlg::create
  33. # ------------------------------------------------------------------------------
  34. proc ProgressDlg::create { path args } {
  35. Widget::init ProgressDlg "$path#ProgressDlg" $args
  36. eval Dialog::create $path [Widget::subcget "$path#ProgressDlg" ""] \
  37. -image [Bitmap::get hourglass] -modal none -side bottom -anchor c
  38. wm protocol $path WM_DELETE_WINDOW {;}
  39. set frame [Dialog::getframe $path]
  40. bind $frame <Destroy> "Widget::destroy $path#ProgressDlg"
  41. $frame configure -cursor watch
  42. eval label $frame.msg [Widget::subcget "$path#ProgressDlg" .frame.msg] \
  43. -relief flat -borderwidth 0 -highlightthickness 0 -anchor w -justify left
  44. pack $frame.msg -side top -pady 3m -anchor nw -fill x -expand yes
  45. set var [Widget::cget "$path#ProgressDlg" -variable]
  46. eval ProgressBar::create $frame.pb [Widget::subcget "$path#ProgressDlg" .frame.pb] \
  47. -width 100
  48. pack $frame.pb -side bottom -anchor w -fill x -expand yes
  49. set stop [Widget::cget "$path#ProgressDlg" -stop]
  50. set cmd [Widget::cget "$path#ProgressDlg" -command]
  51. if { $stop != "" && $cmd != "" } {
  52. Dialog::add $path -text $stop -name $stop -command $cmd
  53. }
  54. Dialog::draw $path
  55. BWidget::grab local $path
  56. proc ::$path { cmd args } "return \[eval ProgressDlg::\$cmd $path \$args\]"
  57. return $path
  58. }
  59. # ------------------------------------------------------------------------------
  60. # Command ProgressDlg::configure
  61. # ------------------------------------------------------------------------------
  62. proc ProgressDlg::configure { path args } {
  63. return [Widget::configure "$path#ProgressDlg" $args]
  64. }
  65. # ------------------------------------------------------------------------------
  66. # Command ProgressDlg::cget
  67. # ------------------------------------------------------------------------------
  68. proc ProgressDlg::cget { path option } {
  69. return [Widget::cget "$path#ProgressDlg" $option]
  70. }