X-Git-Url: http://git.osdn.net/view?a=blobdiff_plain;f=util%2Fsrc%2FTclTk%2Fblt2.5%2Fdemos%2Ftabset4.tcl;fp=util%2Fsrc%2FTclTk%2Fblt2.5%2Fdemos%2Ftabset4.tcl;h=419d43ee1a2b2903b77e5a79e7bb544ae658859b;hb=c46db33a83894f24189046ef665713fe320fef71;hp=0000000000000000000000000000000000000000;hpb=542a195bc3d4acf4245305f6be3f1ca58d072076;p=eos%2Fbase.git diff --git a/util/src/TclTk/blt2.5/demos/tabset4.tcl b/util/src/TclTk/blt2.5/demos/tabset4.tcl new file mode 100755 index 0000000000..419d43ee1a --- /dev/null +++ b/util/src/TclTk/blt2.5/demos/tabset4.tcl @@ -0,0 +1,109 @@ +#!../src/bltwish + +package require BLT +# -------------------------------------------------------------------------- +# Starting with Tcl 8.x, the BLT commands are stored in their own +# namespace called "blt". The idea is to prevent name clashes with +# Tcl commands and variables from other packages, such as a "table" +# command in two different packages. +# +# You can access the BLT commands in a couple of ways. You can prefix +# all the BLT commands with the namespace qualifier "blt::" +# +# blt::graph .g +# blt::table . .g -resize both +# +# or you can import all the command into the global namespace. +# +# namespace import blt::* +# graph .g +# table . .g -resize both +# +# -------------------------------------------------------------------------- +if { $tcl_version >= 8.0 } { + namespace import blt::* + namespace import -force blt::tile::* +} +source scripts/demo.tcl +#bltdebug 100 + +source scripts/stipples.tcl + +tabset .t \ + -samewidth yes \ + -side left \ + -textside bottom \ + -textside top \ + -bg red \ + -tiers 1 \ + -scrollincrement 10 \ + -scrollcommand { .s set } \ + -rotate 0 \ + -selectcommand { MakePhoto %W %n } + + +scrollbar .s -command { .t view } -orient horizontal + +option clear +option add *Tabset.Tab.font -*-helvetica-bold-r-*-*-10-*-*-*-*-*-*-* + +set files [glob ./images/*.gif] +set files [lsort $files] +#set vertFilter sinc +#set horzFilter sinc +set vertFilter none +set horzFilter none + + +proc ResizePhoto { src dest maxSize } { + set maxSize [winfo fpixels . $maxSize] + set w [image width $src] + set h [image height $src] + set sw [expr double($maxSize) / $w] + set sh [expr double($maxSize) / $h] + set s [expr min($sw, $sh)] + set w [expr round($s * $w)] + set h [expr round($s * $h)] + $dest configure -width $w -height $h + + global horzFilter vertFilter + winop image resample $src $dest $horzFilter $vertFilter +} + +image create photo src +image create photo dest + +label .t.label -image dest -bg purple + +proc MakePhoto { w name } { + set file ./images/$name.gif + src configure -file $file + + set width [$w tab pagewidth] + set height [$w tab pageheight] + if { $width < $height } { + ResizePhoto src dest $width + } else { + ResizePhoto src dest $height + } + .t tab dockall + .t tab configure $name -window .t.label -padx 4m -pady 4m -fill both +} + +table . \ + .t 0,0 -fill both \ + .s 1,0 -fill x + +table configure . r1 -resize none +focus .t + +foreach f $files { + src configure -file $f + set f [file tail [file root $f]] + set thumb [image create photo] + ResizePhoto src $thumb 0.5i + .t insert end $f -image $thumb -fill both +} + +.t focus 0 +.t invoke 0