# voltmeter.tcl -- # # Part of: The TCL'ers Wiki # Contents: a voltmeter-like widget # Date: Fri Jun 13, 2003 # # Abstract # # # # Copyright (c) 2003 Marco Maggi # # The author hereby grant permission to use, copy, modify, distribute, # and license this software and its documentation for any purpose, # provided that existing copyright notices are retained in all copies # and that this notice is included verbatim in any distributions. No # written agreement, license, or royalty fee is required for any of the # authorized uses. Modifications to this software may be copyrighted by # their authors and need not follow the licensing terms described here, # provided that the new terms are clearly indicated on the first page of # each file where they apply. # # IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY PARTY # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY # DERIVATIVES THEREOF, EVEN IF THE AUTHOR HAVE BEEN ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # # THE AUTHOR AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND # NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, # AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE # MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. # # $Id: 9109,v 1.6 2005-06-11 06:00:47 jcw Exp $ # package require Tcl 8 package require Tk 8 option add *borderWidth 1 option add *Scale.from 0 option add *Scale.to 110 option add *Scale.orient vertical option add *Scale.label voltage option add *Scale.resolution 1 option add *Scale.showValue 1 proc main { argc argv } { global forever wm withdraw . wm title . "A voltmeter-like widget" wm geometry . +10+10 voltmeter::constructor .t1 ::value1 { 0 50 100 } scale .s1 -command "set ::value1" option add *t2.label "Ampermeter (mA)" option add *t2.Canvas.width 80m option add *t2.Canvas.height 40m voltmeter::constructor .t2 ::value2 { 0 {} 2.5 {} 5 } scale .s2 -command "set ::value2" button .b -text Quit -command "set ::forever 1" grid .t1 .s1 .t2 .s2 .b wm deiconify . vwait forever voltmeter::destructor .t1 voltmeter::destructor .t2 exit 0 } namespace eval voltmeter { option add *Voltmeter.min 0.0 option add *Voltmeter.max 100.0 option add *Voltmeter.indexid {} option add *Voltmeter.ticksfont { Helvetica 8 } option add *Voltmeter.labelfont { Helvetica 9 } option add *Voltmeter.label "Voltmeter (V)" option add *Voltmeter.relief flat option add *Voltmeter.borderWidth 0 option add *Voltmeter.Canvas.background gray option add *Voltmeter.Canvas.width 50m option add *Voltmeter.Canvas.height 25m option add *Voltmeter.Canvas.foreground black option add *Voltmeter.Canvas.highlightThickness 0 option add *Voltmeter.Canvas.borderWidth 1 option add *Voltmeter.Canvas.relief raised variable pi [expr {3.14159265359/180.0}] } proc voltmeter::constructor { widget varname labels } { variable pi upvar $varname value frame $widget -class Voltmeter canvas [set c $widget.canvas] grid $c -sticky news -padx 2m -pady 2m option add ${widget}.varname $varname set font [option get $widget ticksfont {}] set width [$c cget -width] set height [$c cget -height] set xcentre [expr {$width*0.5}] set ycentre [expr {$width*1.4}] set t 1.15 set t1 1.25 $c create arc \ [expr {$xcentre-$width*$t}] [expr {$ycentre-$width*$t}] \ [expr {$xcentre+$width*$t}] [expr {$ycentre+$width*$t}] \ -start 70.5 -extent 37 -style arc -outline lightgray \ -width [expr {$ycentre*0.245}] $c create arc \ [expr {$xcentre-$width*$t}] [expr {$ycentre-$width*$t}] \ [expr {$xcentre+$width*$t}] [expr {$ycentre+$width*$t}] \ -start 71 -extent 36 -style arc -outline white \ -width [expr {$ycentre*0.23}] $c create arc \ [expr {$xcentre-$width*$t1}] [expr {$ycentre-$width*$t1}] \ [expr {$xcentre+$width*$t1}] [expr {$ycentre+$width*$t1}] \ -start 75 -extent 30 \ -fill black -style arc -width 0.5m set num [llength $labels] set angle 255.0 set delta [expr {30.0/($num-1)}] set l1 [expr {$width*$t1}] set l2 [expr {$width*$t1*0.95}] set l3 [expr {$width*$t1*0.92}] for {set i 0} {$i < $num} {incr i} { set a [expr {($angle+$delta*$i)*$pi}] set x1 [expr {$xcentre+$l1*cos($a)}] set y1 [expr {$ycentre+$l1*sin($a)}] set x2 [expr {$xcentre+$l2*cos($a)}] set y2 [expr {$ycentre+$l2*sin($a)}] $c create line $x1 $y1 $x2 $y2 -fill black -width 0.5m set x1 [expr {$xcentre+$l3*cos($a)}] set y1 [expr {$ycentre+$l3*sin($a)}] set label [lindex $labels $i] if { [string length $label] } { $c create text $x1 $y1 \ -anchor center -justify center -fill black \ -text $label -font $font } } set label [option get $widget label {}] if { [string length $label] } { set font [option get $widget labelfont {}] $c create text $xcentre [expr {$ycentre-$width*1.05}] \ -anchor center -justify center -fill black \ -text $label -font $font } rivet $c 10 10 rivet $c [expr {$width-10}] 10 rivet $c 10 [expr {$height-10}] rivet $c [expr {$width-10}] [expr {$height-10}] set value 0 drawline $widget $value trace add variable $varname write \ [namespace code "tracer $widget $varname"] return $widget } proc voltmeter::destructor { widget } { set varname [option get $widget varname {}] trace remove variable $varname write \ [namespace code "tracer $widget $varname"] return } proc voltmeter::tracer { widget varname args } { upvar $varname value drawline $widget $value return } proc voltmeter::drawline { widget value } { variable pi set id [option get $widget indexid {}] set min [option get $widget min {}] set max [option get $widget max {}] set c $widget.canvas set v [expr { ($value <= ($max*1.05))? $value : ($max*1.05) }] set angle [expr {((($v-$min)/($max-$min))*30.0+165.0)*$pi}] set width [$c cget -width] set xcentre [expr {$width/2.0}] set ycentre [expr {$width*1.4}] set l1 [expr {$ycentre*0.85}] set l2 [expr {$ycentre*0.7}] set xl [expr {$xcentre-$l1*sin($angle)}] set yl [expr {$ycentre+$l1*cos($angle)}] set xs [expr {$xcentre-$l2*sin($angle)}] set ys [expr {$ycentre+$l2*cos($angle)}] catch {$c delete $id} set id [$c create line $xs $ys $xl $yl -fill black -width 0.6m] option add *[string trimleft $widget .].indexid $id return } proc voltmeter::rivet { c xc yc } { shadowcircle $c \ [expr {$xc-4}] [expr {$yc-4}] [expr {$xc+4}] [expr {$yc+4}] \ 5 0.5m -45.0 } proc shadowcircle { canvas x1 y1 x2 y2 ticks width orient } { set radius [expr {($x2-$x1)/2.0}] set angle $orient set delta [expr {180.0/$ticks}] for {set i 0} {$i <= $ticks} {incr i} { set a [expr {($angle+$i*$delta)}] set b [expr {($angle-$i*$delta)}] set color [expr {40+$i*(200/$ticks)}] set color [format "#%x%x%x" $color $color $color] $canvas create arc $x1 $y1 $x2 $y2 -start $a -extent $delta \ -style arc -outline $color -width $width $canvas create arc $x1 $y1 $x2 $y2 -start $b -extent $delta \ -style arc -outline $color -width $width } } main $argc $argv ### end of file # Local Variables: # mode: tcl # page-delimiter: "^#PAGE" # End:
MG Apr 2 2005 - Very nicely done!
arjen - 2010-08-12 05:18:08
I have put this code and several other related packages into the "controlwidget" module in Tklib.