util/src/TclTk/blt2.5/demos/tabset4.tcl

   1 #!../src/bltwish
   2
   3 package require BLT
   4 # --------------------------------------------------------------------------
   5 # Starting with Tcl 8.x, the BLT commands are stored in their own
   6 # namespace called "blt".  The idea is to prevent name clashes with
   7 # Tcl commands and variables from other packages, such as a "table"
   8 # command in two different packages.
   9 #
  10 # You can access the BLT commands in a couple of ways.  You can prefix
  11 # all the BLT commands with the namespace qualifier "blt::"
  12 #
  13 #    blt::graph .g
  14 #    blt::table . .g -resize both
  15 #
  16 # or you can import all the command into the global namespace.
  17 #
  18 #    namespace import blt::*
  19 #    graph .g
  20 #    table . .g -resize both
  21 #
  22 # --------------------------------------------------------------------------
  23 if { $tcl_version >= 8.0 } {
  24     namespace import blt::*
  25     namespace import -force blt::tile::*
  26 }
  27 source scripts/demo.tcl
  28 #bltdebug 100
  29
  30 source scripts/stipples.tcl
  31
  32 tabset .t \
  33     -samewidth yes \
  34     -side left \
  35     -textside bottom \
  36     -textside top \
  37     -bg red \
  38     -tiers 1 \
  39     -scrollincrement 10 \
  40     -scrollcommand { .s set } \
  41     -rotate 0 \
  42     -selectcommand {  MakePhoto %W %n }
  43
  44
  45 scrollbar .s -command { .t view } -orient horizontal
  46
  47 option clear
  48 option add *Tabset.Tab.font -*-helvetica-bold-r-*-*-10-*-*-*-*-*-*-*
  49
  50 set files [glob ./images/*.gif]
  51 set files [lsort $files]
  52 #set vertFilter sinc
  53 #set horzFilter sinc
  54 set vertFilter none
  55 set horzFilter none
  56
  57
  58 proc ResizePhoto { src dest maxSize } {
  59     set maxSize [winfo fpixels . $maxSize]
  60     set w [image width $src]
  61     set h [image height $src]
  62     set sw [expr double($maxSize) / $w]
  63     set sh [expr double($maxSize) / $h]
  64     set s [expr min($sw, $sh)]
  65     set w [expr round($s * $w)]
  66     set h [expr round($s * $h)]
  67     $dest configure -width $w -height $h
  68
  69     global horzFilter vertFilter
  70     winop image resample $src $dest $horzFilter $vertFilter
  71 }
  72
  73 image create photo src
  74 image create photo dest
  75
  76 label .t.label -image dest -bg purple
  77
  78 proc MakePhoto { w name } {
  79     set file ./images/$name.gif
  80     src configure -file $file
  81
  82     set width [$w tab pagewidth]
  83     set height [$w tab pageheight]
  84     if { $width < $height } {
  85         ResizePhoto src dest $width
  86     } else {
  87         ResizePhoto src dest $height
  88     }
  89     .t tab dockall
  90     .t tab configure $name -window .t.label -padx 4m -pady 4m -fill both
  91 }
  92
  93 table . \
  94     .t 0,0 -fill both \
  95     .s 1,0 -fill x
  96
  97 table configure . r1 -resize none
  98 focus .t
  99
 100 foreach f $files {
 101     src configure -file $f
 102     set f [file tail [file root $f]]
 103     set thumb [image create photo]
 104     ResizePhoto src $thumb 0.5i
 105     .t insert end $f -image $thumb -fill both
 106 }
 107
 108 .t focus 0
 109 .t invoke 0