Updated 2014-06-01 20:01:17 by dkf

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 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