Photo Gallery
Keith Vetter 2006-03-16 : For another project, I wanted to show a bunch of thumbnail images in window which the user could resize. The former was simple, the latter (resizing) was surprisingly difficult.
My first approach was to put each image into its own label widget, use the grid geometry manager to display everything, and then bind onto <Configure> for resizing. Unfortunately there are some very weird problems in this approach (which are too hard to explain here).
I found success, however, by instead using a canvas to display the images and doing my own geometry management.
For the demo, I left out the image->thumbnail code and instead just used the images that can be found in the ActiveTcl image dirctory ($tk_library/images/*). I did keep the addition of the shadow border as seen in Shadow Photo.
uniquename 2013aug18
For 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.
Vetter has a proc named '::Gallery::GetPhotoData' in the code below. It looks through an 'images' subdirectory of the $tk_library directory on the computer running this code and tries to display any '.gif' or '.jpg' or '.png' file in that library.
If there are '.jpg' files in that library (or '.png' files if you are using a 'wish' interpreter from before Tk 8.6), the 'Img' extension is needed.
I do not have the 'Img' extension package on my computer (and have no intention of ever installing it). So I commented out the 'package require Img' statement in the code and tried running it.
Luckily for me, the $tk_library on my Linux (Ubuntu 9.10) machine --- running Tk 8.5 --- contained no '.jpg' or '.png' files --- only the files seen here:
/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.gif
Vetter'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.
Kudos to Keith for the nice shading effect. Nice gallery.
##+##########################################################################
#
# 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 https://wiki.tcl-lang.org/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