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 / lib / bwidget1.3.0 / label.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  9.1 KB  |  269 lines
  1. # ------------------------------------------------------------------------------
  2. #  label.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: label.tcl,v 1.8 2001/09/06 00:08:35 andreas_kupries Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - BWLabel::create
  8. #     - BWLabel::configure
  9. #     - BWLabel::cget
  10. #     - BWLabel::setfocus
  11. #     - BWLabel::_drag_cmd
  12. #     - BWLabel::_drop_cmd
  13. #     - BWLabel::_over_cmd
  14. # ------------------------------------------------------------------------------
  15.  
  16. namespace eval BWLabel {
  17.     Widget::tkinclude BWLabel label .l \
  18.         remove {-foreground -text -textvariable -underline}
  19.  
  20.     Widget::declare BWLabel {
  21.         {-name               String     "" 0}
  22.         {-text               String     "" 0}
  23.         {-textvariable       String     "" 0}
  24.         {-underline          Int        -1 0 "%d >= -1"}
  25.         {-focus              String     "" 0}
  26.         {-foreground         TkResource "" 0 label}
  27.         {-disabledforeground TkResource "" 0 button}
  28.         {-state              Enum       normal 0  {normal disabled}}
  29.         {-fg                 Synonym    -foreground}
  30.  
  31.     }
  32.     DynamicHelp::include BWLabel balloon
  33.     DragSite::include    BWLabel "" 1
  34.     DropSite::include    BWLabel {
  35.         TEXT    {move {}}
  36.         IMAGE   {move {}}
  37.         BITMAP  {move {}}
  38.         FGCOLOR {move {}}
  39.         BGCOLOR {move {}}
  40.         COLOR   {move {}}
  41.     }
  42.  
  43.     Widget::syncoptions BWLabel "" .l {-text {} -underline {}}
  44.  
  45.     proc ::Label { path args } { return [eval BWLabel::create $path $args] }
  46.     proc use {} {}
  47.  
  48.     bind BwLabel <FocusIn> {BWLabel::setfocus %W}
  49. }
  50.  
  51.  
  52. # ------------------------------------------------------------------------------
  53. #  Command BWLabel::create
  54. # ------------------------------------------------------------------------------
  55. proc BWLabel::create { path args } {
  56.     array set maps [list BWLabel {} .l {}]
  57.     array set maps [Widget::parseArgs BWLabel $args]
  58.     frame $path -class BWLabel -borderwidth 0 -highlightthickness 0 -relief flat
  59.     Widget::initFromODB BWLabel $path $maps(BWLabel)
  60.  
  61.     bind real${path} <Destroy> {Widget::destroy %W; rename %W {}}
  62.     eval label $path.l $maps(.l)
  63.  
  64.     if { [Widget::cget $path -state] == "normal" } {
  65.         set fg [Widget::cget $path -foreground]
  66.     } else {
  67.         set fg [Widget::cget $path -disabledforeground]
  68.     }
  69.  
  70.     set var [Widget::cget $path -textvariable]
  71.     if {  $var == "" &&
  72.           [Widget::cget $path -image] == "" &&
  73.           [Widget::cget $path -bitmap] == ""} {
  74.         set desc [BWidget::getname [Widget::cget $path -name]]
  75.         if { $desc != "" } {
  76.             set text  [lindex $desc 0]
  77.             set under [lindex $desc 1]
  78.         } else {
  79.             set text  [Widget::cget $path -text]
  80.             set under [Widget::cget $path -underline]
  81.         }
  82.     } else {
  83.         set under -1
  84.         set text  ""
  85.     }
  86.  
  87.     $path.l configure -text $text -textvariable $var \
  88.         -underline $under -foreground $fg
  89.  
  90.     set accel [string tolower [string index $text $under]]
  91.     if { $accel != "" } {
  92.         bind [winfo toplevel $path] <Alt-$accel> "BWLabel::setfocus $path"
  93.     }
  94.  
  95.     bindtags $path.l [list $path.l $path Label [winfo toplevel $path] all]
  96.     bindtags $path [list real${path} BwLabel [winfo toplevel $path] all]
  97.     pack $path.l -expand yes -fill both
  98.  
  99.     DragSite::setdrag $path $path.l BWLabel::_init_drag_cmd [Widget::cget $path -dragendcmd] 1
  100.     DropSite::setdrop $path $path.l BWLabel::_over_cmd BWLabel::_drop_cmd 1
  101.     DynamicHelp::sethelp $path $path.l 1
  102.  
  103.     rename $path ::$path:cmd
  104.     proc ::$path { cmd args } "return \[eval BWLabel::\$cmd $path \$args\]"
  105.  
  106.     return $path
  107. }
  108.  
  109.  
  110. # ------------------------------------------------------------------------------
  111. #  Command BWLabel::configure
  112. # ------------------------------------------------------------------------------
  113. proc BWLabel::configure { path args } {
  114.     set oldunder [$path.l cget -underline]
  115.     if { $oldunder != -1 } {
  116.         set oldaccel [string tolower [string index [$path.l cget -text] $oldunder]]
  117.     } else {
  118.         set oldaccel ""
  119.     }
  120.     set res [Widget::configure $path $args]
  121.  
  122.     set cfg  [Widget::hasChanged $path -foreground fg]
  123.     set cdfg [Widget::hasChanged $path -disabledforeground dfg]
  124.     set cst  [Widget::hasChanged $path -state state]
  125.  
  126.     if { $cst || $cfg || $cdfg } {
  127.         if { $state == "normal" } {
  128.             $path.l configure -fg $fg
  129.         } else {
  130.             $path.l configure -fg $dfg
  131.         }
  132.     }
  133.  
  134.     set cv [Widget::hasChanged $path -textvariable var]
  135.     set cb [Widget::hasChanged $path -image img]
  136.     set ci [Widget::hasChanged $path -bitmap bmp]
  137.     set cn [Widget::hasChanged $path -name name]
  138.     set ct [Widget::hasChanged $path -text text]
  139.     set cu [Widget::hasChanged $path -underline under]
  140.  
  141.     if { $cv || $cb || $ci || $cn || $ct || $cu } {
  142.         if {  $var == "" && $img == "" && $bmp == "" } {
  143.             set desc [BWidget::getname $name]
  144.             if { $desc != "" } {
  145.                 set text  [lindex $desc 0]
  146.                 set under [lindex $desc 1]
  147.             }
  148.         } else {
  149.             set under -1
  150.             set text  ""
  151.         }
  152.         set top [winfo toplevel $path]
  153.         if { $oldaccel != "" } {
  154.             bind $top <Alt-$oldaccel> {}
  155.         }
  156.         set accel [string tolower [string index $text $under]]
  157.         if { $accel != "" } {
  158.             bind $top <Alt-$accel> "BWLabel::setfocus $path"
  159.         }
  160.         $path.l configure -text $text -underline $under -textvariable $var
  161.     }
  162.  
  163.     set force [Widget::hasChanged $path -dragendcmd dragend]
  164.     DragSite::setdrag $path $path.l BWLabel::_init_drag_cmd $dragend $force
  165.     DropSite::setdrop $path $path.l BWLabel::_over_cmd BWLabel::_drop_cmd
  166.     DynamicHelp::sethelp $path $path.l
  167.  
  168.     return $res
  169. }
  170.  
  171.  
  172. # ------------------------------------------------------------------------------
  173. #  Command BWLabel::cget
  174. # ------------------------------------------------------------------------------
  175. proc BWLabel::cget { path option } {
  176.     return [Widget::cget $path $option]
  177. }
  178.  
  179.  
  180. # ------------------------------------------------------------------------------
  181. #  Command BWLabel::setfocus
  182. # ------------------------------------------------------------------------------
  183. proc BWLabel::setfocus { path } {
  184.     if { ![string compare [Widget::cget $path -state] "normal"] } {
  185.         set w [Widget::cget $path -focus]
  186.         if { [winfo exists $w] && [Widget::focusOK $w] } {
  187.             focus $w
  188.         }
  189.     }
  190. }
  191.  
  192.  
  193. # ------------------------------------------------------------------------------
  194. #  Command BWLabel::_init_drag_cmd
  195. # ------------------------------------------------------------------------------
  196. proc BWLabel::_init_drag_cmd { path X Y top } {
  197.     set path [winfo parent $path]
  198.     if { [set cmd [Widget::cget $path -draginitcmd]] != "" } {
  199.         return [uplevel \#0 $cmd [list $path $X $Y $top]]
  200.     }
  201.     if { [set data [$path.l cget -image]] != "" } {
  202.         set type "IMAGE"
  203.         pack [label $top.l -image $data]
  204.     } elseif { [set data [$path.l cget -bitmap]] != "" } {
  205.         set type "BITMAP"
  206.         pack [label $top.l -bitmap $data]
  207.     } else {
  208.         set data [$path.l cget -text]
  209.         set type "TEXT"
  210.     }
  211.     set usertype [Widget::getoption $path -dragtype]
  212.     if { $usertype != "" } {
  213.         set type $usertype
  214.     }
  215.     return [list $type {copy} $data]
  216. }
  217.  
  218.  
  219. # ------------------------------------------------------------------------------
  220. #  Command BWLabel::_drop_cmd
  221. # ------------------------------------------------------------------------------
  222. proc BWLabel::_drop_cmd { path source X Y op type data } {
  223.     set path [winfo parent $path]
  224.     if { [set cmd [Widget::cget $path -dropcmd]] != "" } {
  225.         return [uplevel \#0 $cmd [list $path $source $X $Y $op $type $data]]
  226.     }
  227.     if { $type == "COLOR" || $type == "FGCOLOR" } {
  228.         configure $path -foreground $data
  229.     } elseif { $type == "BGCOLOR" } {
  230.         configure $path -background $data
  231.     } else {
  232.         set text   ""
  233.         set image  ""
  234.         set bitmap ""
  235.         switch -- $type {
  236.             IMAGE   {set image $data}
  237.             BITMAP  {set bitmap $data}
  238.             default {
  239.                 set text $data
  240.                 if { [set var [$path.l cget -textvariable]] != "" } {
  241.                     configure $path -image "" -bitmap ""
  242.                     GlobalVar::setvar $var $data
  243.                     return
  244.                 }
  245.             }
  246.         }
  247.         configure $path -text $text -image $image -bitmap $bitmap
  248.     }
  249.     return 1
  250. }
  251.  
  252.  
  253. # ------------------------------------------------------------------------------
  254. #  Command BWLabel::_over_cmd
  255. # ------------------------------------------------------------------------------
  256. proc BWLabel::_over_cmd { path source event X Y op type data } {
  257.     set path [winfo parent $path]
  258.     if { [set cmd [Widget::cget $path -dropovercmd]] != "" } {
  259.         return [uplevel \#0 $cmd [list $path $source $event $X $Y $op $type $data]]
  260.     }
  261.     if { [Widget::getoption $path -state] == "normal" ||
  262.          $type == "COLOR" || $type == "FGCOLOR" || $type == "BGCOLOR" } {
  263.         DropSite::setcursor based_arrow_down
  264.         return 1
  265.     }
  266.     DropSite::setcursor dot
  267.     return 0
  268. }
  269.