home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / messagedlg.tcl < prev    next >
Text File  |  2000-11-02  |  4KB  |  112 lines
  1. # ------------------------------------------------------------------------------
  2. #  messagedlg.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. # ------------------------------------------------------------------------------
  5. #  Index of commands:
  6. #     - MessageDlg::create
  7. # ------------------------------------------------------------------------------
  8.  
  9. namespace eval MessageDlg {
  10.     Dialog::use
  11.  
  12.     Widget::tkinclude MessageDlg message .frame.msg \
  13.         remove     {-cursor -highlightthickness -highlightbackground -highlightcolor \
  14.                         -relief -borderwidth -takefocus -textvariable} \
  15.         rename     {-text -message} \
  16.         initialize {-aspect 800 -anchor c -justify center}
  17.  
  18.     Widget::bwinclude MessageDlg Dialog "" \
  19.         remove {-modal -image -bitmap -side -anchor -separator \
  20.                     -homogeneous -padx -pady -spacing}
  21.  
  22.     Widget::declare MessageDlg {
  23.         {-icon       Enum   info 0 {none error info question warning}}
  24.         {-type       Enum   user 0 {abortretryignore ok okcancel retrycancel yesno yesnocancel user}}
  25.         {-buttons    String ""   0}
  26.     }
  27.  
  28.     proc ::MessageDlg { path args } { return [eval MessageDlg::create $path $args] }
  29.     proc use { } {}
  30. }
  31.  
  32.  
  33. # ------------------------------------------------------------------------------
  34. #  Command MessageDlg::create
  35. # ------------------------------------------------------------------------------
  36. proc MessageDlg::create { path args } {
  37.     global tcl_platform
  38.  
  39.     Widget::init MessageDlg "$path#Message" $args
  40.     set type  [Widget::getoption "$path#Message" -type]
  41.     set title [Widget::getoption "$path#Message" -title]
  42.     set icon  [Widget::getoption "$path#Message" -icon]
  43.     set defb  -1
  44.     set canb  -1
  45.     switch -- $type {
  46.         abortretryignore {set lbut {abort retry ignore}}
  47.         ok               {set lbut {ok}; set defb 0 }
  48.         okcancel         {set lbut {ok cancel}; set defb 0; set canb 1}
  49.         retrycancel      {set lbut {retry cancel}; set defb 0; set canb 1}
  50.         yesno            {set lbut {yes no}; set defb 0; set canb 1}
  51.         yesnocancel      {set lbut {yes no cancel}; set defb 0; set canb 2}
  52.         user             {set lbut [Widget::getoption "$path#Message" -buttons]}
  53.     }
  54.     if { [Widget::getoption "$path#Message" -default] == -1 } {
  55.         Widget::setoption "$path#Message" -default $defb
  56.     }
  57.     if { [Widget::getoption "$path#Message" -cancel] == -1 } {
  58.         Widget::setoption "$path#Message" -cancel $canb
  59.     }
  60.     if { $title == "" } {
  61.         set frame [frame $path -class MessageDlg]
  62.         set title [option get $frame "${icon}Title" MessageDlg]
  63.         destroy $frame
  64.         if { $title == "" } {
  65.             set title "Message"
  66.         }
  67.     }
  68.     Widget::setoption "$path#Message" -title $title
  69.     if { $tcl_platform(platform) == "unix" || $type == "user" } {
  70.         if { $icon != "none" } {
  71.             set image [Bitmap::get $icon]
  72.         } else {
  73.             set image ""
  74.         }
  75.         eval Dialog::create $path [Widget::subcget "$path#Message" ""] \
  76.             -image $image -modal local -side bottom -anchor c
  77.         set idbut 0
  78.         foreach but $lbut {
  79.             Dialog::add $path -text $but -name $but
  80.         }
  81.         set frame [Dialog::getframe $path]
  82.  
  83.         eval message $frame.msg [Widget::subcget "$path#Message" .frame.msg] \
  84.             -relief flat -borderwidth 0 -highlightthickness 0 -textvariable {""}
  85.         pack  $frame.msg -side left -padx 3m -pady 1m -fill x -expand yes
  86.  
  87.         set res [Dialog::draw $path]
  88.     } else {
  89.         set parent [Widget::getoption "$path#Message" -parent]
  90.         set def    [lindex $lbut [Widget::getoption "$path#Message" -default]]
  91.         set opt    [list \
  92.                         -message [Widget::getoption "$path#Message" -message] \
  93.                         -type    $type  \
  94.                         -title   $title]
  95.         if { [winfo exists $parent] } {
  96.            lappend opt -parent $parent
  97.         }
  98.         if { $def != "" } {
  99.            lappend opt -default $def
  100.         }
  101.         if { $icon != "none" } {
  102.            lappend opt -icon $icon
  103.         }
  104.         set res [eval tk_messageBox $opt]
  105.         set res [lsearch $lbut $res]
  106.     }
  107.     Widget::destroy "$path#Message"
  108.     destroy $path
  109.  
  110.     return $res
  111. }
  112.