uniquename 2013aug18For those readers who do not have the time/facilities/whatever to setup the code below and execute it, here are a couple of images that indicate what the following code can do.
/usr/share/tcltk/tk8.5/images $ ls README logo64.gif pwrdLogo.eps pwrdLogo175.gif tai-ku.gif logo.eps logoLarge.gif pwrdLogo100.gif pwrdLogo200.gif logo100.gif logoMed.gif pwrdLogo150.gif pwrdLogo75.gifVetter's script skipped over the two '.eps' files (and the README file) in this directory and showed just the '.gif' files.Note that the photos in the image above are displayed on a Tk canvas, and Vetter made the canvas scrollable.The scrollbar on the right of the image above indicates that the user can scroll down to see more images. I scrolled down and captured the image below.
##+##########################################################################
#
# gallery.tcl -- resizable gallery of images
# by Keith Vetter, March 16, 2006
#
package require Tk
package require Img
namespace eval ::Gallery {
variable photoData
}
##+##########################################################################
#
# ::Gallery::Show -- creates a gallery of images
#
proc ::Gallery::Show {} {
catch {font create boldFont -family Helvetica -size 10 -weight bold}
::Gallery::GetPhotoData
wm title . "Gallery"
scrollbar .sb -orient vertical -command [list .c yview]
canvas .c -bd 0 -highlightthickness 0 -bg white \
-yscrollcommand [list .sb set] -width 540 -height 500
pack .sb -side right -fill y
pack .c -side left -fill both -expand 1
bind .c <Configure> ::Gallery::FillGallery
}
##+##########################################################################
#
# ::Gallery::FillGallery -- manually lays out our image gallery based on the
# size of the canvas. Called from <Configure> binding callback.
#
proc ::Gallery::FillGallery {} {
variable photoData
.c delete all
set w [winfo width .c]
if {$w == 0} { set w [winfo reqwidth .c] } ;# Just be safe
if {$w == 0} return
set cols [expr {$w / $photoData(maxW)}]
if {$cols == 0} {set cols 1}
set cwidth [expr {$w / $cols}]
set clr white
for {set idx 0} {$idx < $photoData(cnt)} {incr idx} {
set row [expr {$idx / $cols}]
set col [expr {$idx % $cols}]
#set clr [expr {(($row+$col) & 1) ? "green" : "yellow"}]
set img $photoData($idx,img)
set txt [file tail $photoData($idx,name)]
set x0 [expr {$col * $cwidth+1}]
set y0 [expr {$row * $photoData(maxH)+1}]
set x1 [expr {$x0 + $cwidth-2}]
set y1 [expr {$y0 + $photoData(maxH)-1}]
.c create rect $x0 $y0 $x1 $y1 -fill $clr -width 0
set x [expr {($x0+$x1)/2}]
set y [expr {($y0+$y1)/2}]
.c create image $x $y -image $img
set y2 [expr {$y + [image height $img] / 2 - 5}]
.c create text $x $y2 -text $txt -font boldFont -anchor n
}
.c config -scrollregion [.c bbox all]
}
##+##########################################################################
#
# ::Gallery::GetPhotoData -- creates images for all files for the
# gallery. For this demo we use some built in tcl images.
#
proc ::Gallery::GetPhotoData {} {
variable photoData
unset -nocomplain photoData
set idir [file join $::tk_library images]
set maxW 0 ;# Max dimension of our images
set maxH 0
set idx -1
foreach iname [glob -nocomplain -types f -directory $idir *] {
if {! [regexp -nocase {\.gif$|\.jpg$|\.png$} $iname]} continue
set img [::Gallery::MakeShadowPhoto $iname]
set w [image width $img]
set h [image height $img]
if {$w > 250 || $h > 250} { ;# Too big for our demo
image delete $img
continue
}
incr idx
set photoData($idx,name) $iname
set photoData($idx,img) $img
if {$w > $maxW} {set maxW $w}
if {$h > $maxH} {set maxH $h}
}
if {$idx == 0} {
tk_messageBox -message "Couldn't find any images for the demo" \
-icon error
exit
}
set photoData(cnt) [incr idx]
set photoData(maxW) $maxW
set photoData(maxH) [expr {$maxH + 20}]
}
##+##########################################################################
#
# ::Gallery::MakeShadowPhoto -- creates an image with a shadow border
# see http://wiki.tcl.tk/ShadowPhoto
#
proc ::Gallery::MakeShadowPhoto {fname} {
::Gallery::_MakeBorderImages
set imgTemp [image create photo -file $fname]
set w [image width $imgTemp]
set h [image height $imgTemp]
set w1 [expr {$w + 25}]
set w2 [expr {$w + 50}]
set h1 [expr {$h + 25}]
set h2 [expr {$h + 50}]
set img [image create photo -width $w2 -height $h2]
$img copy ::img::border::TL
$img copy ::img::border::T -to 25 0 $w1 25
$img copy ::img::border::TR -to $w1 0
$img copy ::img::border::L -to 0 25 25 $h1
$img copy ::img::border::R -to $w1 25 $w2 $h1
$img copy ::img::border::BL -to 0 $h1
$img copy ::img::border::B -to 25 $h1 $w1 $h2
$img copy ::img::border::BR -to $w1 $h1
$img copy $imgTemp -to 25 25
image delete $imgTemp
return $img
}
##+##########################################################################
#
# ::Gallery::_MakeBorderImages -- makes 8 images which forming the shadow
# gradient for the four sides and four corners.
#
proc ::Gallery::_MakeBorderImages {} {
if {[info commands ::img::border::T] ne ""} return
set gradient {\#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#8d8d8d \#999999
\#a6a6a6 \#b2b2b2 \#bebebe \#c8c8c8 \#d0d0d0 \#dadada \#e2e2e2 \#e8e8e8
\#eeeeee \#f2f2f2 \#f7f7f7 \#fcfcfc \#fdfdfd \#fdfdfd \#ffffff \#ffffff
\#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff
\#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff}
image create photo ::img::border::T -width 1 -height 25
image create photo ::img::border::B -width 1 -height 25
image create photo ::img::border::L -width 25 -height 1
image create photo ::img::border::R -width 25 -height 1
image create photo ::img::border::TR -width 25 -height 25
image create photo ::img::border::TL -width 25 -height 25
image create photo ::img::border::BR -width 25 -height 25
image create photo ::img::border::BL -width 25 -height 25
for {set x 0} {$x < 25} {incr x} {
::img::border::B put [lindex $gradient $x] -to 0 $x
::img::border::R put [lindex $gradient $x] -to $x 0
for {set y 0} {$y < 25} {incr y} {
set idx [expr {$x<5&& $y<5 ? 0 : round(hypot($x,$y))}]
::img::border::BR put [lindex $gradient $idx] -to $x $y
}
}
::img::border::TL copy ::img::border::BR -subsample -1 -1
::img::border::TR copy ::img::border::BR -subsample 1 -1
::img::border::BL copy ::img::border::BR -subsample -1 1
::img::border::L copy ::img::border::R -subsample -1 1
::img::border::T copy ::img::border::B -subsample 1 -1
}
::Gallery::Show
return