lib/gui_script/frame.tcl

   1
   2 #----- Create a new title frame widget
   3
   4 proc FrameCreate {w args} {
   5   global _Frame
   6
   7   button $w
   8   set _Frame($w,bg) [$w cget -bg]
   9   set _Frame($w,fg) [$w cget -fg]
  10   set _Frame($w,font) [$w cget -font]
  11   set _Frame($w,text) ""
  12   set _Frame($w,side) left
  13   set _Frame($w,base) center
  14   set _Frame($w,padx) 5
  15   set _Frame($w,pady) 5
  16   set _Frame($w,ipad) 2
  17   set _Frame($w,bd) 2
  18   set _Frame($w,indent) 10
  19   set _Frame($w,relief) groove
  20   destroy $w
  21
  22   frame $w -bd 0 -highlightthickness 0 -relief flat
  23   frame $w.p -bd 0 -highlightthickness 0 -relief flat
  24   frame $w.b -bd 0 -highlightthickness 0 -relief flat
  25   pack $w.b -side bottom -fill both -expand 1
  26   frame $w.b.p -bd 0 -highlightthickness 0 -relief flat
  27   label $w.l -bd 0 -highlightthickness 0 -relief flat -padx 0 -pady 0
  28   frame $w.f
  29
  30   eval FrameConfig $w $args
  31   return $w
  32 }
  33
  34 #----- Change configuration options for the notebook widget
  35
  36 proc FrameConfig {w args} {
  37   global _Frame
  38
  39   # get configuration options
  40
  41   foreach {tag value} $args {
  42     switch -- $tag {
  43       -text {
  44         set _Frame($w,text) $value
  45       }
  46       -padx {
  47         set _Frame($w,padx) $value
  48       }
  49       -pady {
  50         set _Frame($w,pady) $value
  51       }
  52       -ipad {
  53         set _Frame($w,ipad) $value
  54       }
  55       -bg {
  56         set _Frame($w,bg) $value
  57       }
  58       -fg {
  59         set _Frame($w,fg) $value
  60       }
  61       -font {
  62         set _Frame($w,font) $value
  63       }
  64       -side {
  65         set _Frame($w,side) $value
  66       }
  67       -base {
  68         set _Frame($w,base) $value
  69       }
  70       -bd {
  71         set _Frame($w,bd) $value
  72       }
  73       -relief {
  74         set _Frame($w,relief) $value
  75       }
  76       -indent {
  77         set _Frame($w,indent) $value
  78       }
  79     }
  80   }
  81
  82   catch {place forget $w.l}
  83   catch {pack forget $w.f}
  84
  85   $w.b configure -bd $_Frame($w,bd) -relief $_Frame($w,relief)
  86   pack $w.f -in $w.b -side bottom -fill both -padx $_Frame($w,padx) \
  87     -pady $_Frame($w,pady) -expand 1
  88
  89   if {$_Frame($w,text) == ""} {
  90     catch {pack forget $w.p}
  91     catch {pack forget $w.b.p}
  92     return
  93   }
  94
  95   catch {pack $w.p -side top -fill x}
  96   catch {pack $w.b.p -side top -fill x}
  97
  98   $w.l configure -text $_Frame($w,text) -font $_Frame($w,font) \
  99     -fg $_Frame($w,fg) -padx $_Frame($w,ipad)
 100
 101   set height [winfo reqheight $w.l]
 102   switch $_Frame($w,base) {
 103     top {set htop $height; set hbot 1; set y 0}
 104     center {set htop [expr {$height / 2}]
 105             set hbot [expr {$height - $htop}]
 106             set y 0}
 107     bottom {set htop 1; set hbot $height
 108             set y [expr {$_Frame($w,bd) + 1}]}
 109   }
 110   $w.p configure -height $htop
 111   $w.b.p configure -height $hbot
 112
 113   switch $_Frame($w,side) {
 114     left {set relx 0.0
 115           set x $_Frame($w,indent)
 116           set anchor nw}
 117     center {set relx 0.5;
 118             set x 0
 119             set anchor n}
 120     right {set relx 1.0
 121            set x -$_Frame($w,indent)
 122            set anchor ne}
 123   }
 124   place $w.l -relx $relx -x $x -y $y -anchor $anchor
 125 }
 126
 127 proc FrameGet {w} {
 128   return $w.f
 129 }
 130
 131 proc FrameLabel {w} {
 132   return $w.l
 133 }
 134