phig.tcl

很不错的tcl编程实例

# Copyright 1996


# Authors

# Lakshmi Sastry
# Computing and Information Systems Department
# Rutherford Appleton Laboratory, Chilton, Didcot. OX11 0QX
# [e-mail]

#                         and

# Venkat VSS Sastry
# Department of Applied Mathematics and Operational Research
# Cranfield University, RMCS Shrivenham, Swindon, SN6 8LA
# [e-mail]

# Permission to use, copy, modify, and distribute this
# software and its documentation for any purpose and without
# fee is hereby granted, provided that this copyright
# notice appears in all copies.
  
# The authors, RAL, RMCS Shrivenham, Cranfield University and AGOCG
# make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without
# express or implied warranty. Likewise they accept no responsibility
# whatsoever for any public domain software modules used (which are
# hereby acknowledged) in this software 



frame .fr1 -width 18c -height 15.0c -bd 2 ;#main frame
#toplevel .fr1
pack .fr1
frame .fr1.menubar -relief raised -bd 2
pack .fr1.menubar -padx 1 -fill x

menubutton .fr1.menubar.graphics -text Graphics -underline 0 -menu \
		.fr1.menubar.graphics.menu
button .fr1.menubar.qb -text Quit -underline 0 -com exit
pack .fr1.menubar.graphics -side left 
pack .fr1.menubar.qb -side right
#Graphics menu
menu .fr1.menubar.graphics.menu
.fr1.menubar.graphics.menu add cascade -label "Line Colour" \
	-menu .fr1.menubar.graphics.menu.fmenu

menu .fr1.menubar.graphics.menu.fmenu
.fr1.menubar.graphics.menu.fmenu add radiobutton -label "Magenta" \
		-com {ChangeColour "Magenta"}
.fr1.menubar.graphics.menu.fmenu add radiobutton -label "Yellow" \
	-com {ChangeColour "Yellow"}

.fr1.menubar.graphics.menu.fmenu add radiobutton -label "White" \
	-com {ChangeColour "White"}

frame .fr1.panl -width 2.0c -height 12.0c -bg black
frame .cfr -width 16.0c -height 12.0c -bd 1

pack .fr1.panl .cfr -in .fr1 -side left -padx 2 -fill x

canvas .can -width 12.0c -height 11.8c -xscrollcommand ".xs set" \
	-yscrollcommand ".ys set"

scrollbar .ys -command ".can yview" 
pack .can .ys -in .cfr -side left -fill x -fill y
scrollbar .xs -orient horizontal -command ".can xview"
place .xs -in .fr1 -x 3.2c -y 13.2c -width 12.0c

scale .scal -label "rotate box throu" -bigincrement 30 \
-from 0 -to 360 -showvalue True -orient horizontal -tickinterval 0  \
-variable cval -com {rotate_box $cval}
pack .scal -in .fr1.panl 

tkwait visibility .scal
SetupPhigs .can
MakeCube


proc ChangeColour { curcolour } {
ChCol $curcolour
}