ulis, 2007-04-29. Un package pour habiller une image comme une photo sur papier.
Pourquoi
Pour tous ceux qui, comme moi, veulent mettre en album les photos d'un animal qui leur tient à coeur.
Comment
En dessinant une bordure et une petite ombre autour de la photo.
L'idée originale vient de Keith Vetter : http://wiki.tcl.tk/ShadowPhoto
Le package
if {[info exists ::3dphoto::version]} { return } namespace eval ::3dphoto \ { ##################################### # # 3dphoto widget # ----------------------------------- # # From Shadow Photo by Keith Vetter # (see http://wiki.tcl.tk/ShadowPhoto) # variable version 1.0 # # ulis, (C) 2005 # NOL Licence # ##################################### # ========================== # # package # # ========================== package provide 3dphoto $version package require Tk # ==================== # # entry point # # ==================== namespace export 3dphoto # ==================== # # global variables # # ==================== variable {} set (map) \ { fdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfd fdfdf7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7fdfd fdf7f7eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeef7f7fd fdf7eeeed0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0eeeef7fd fdf7eed0d0bebebebebebebebebebebebebebebebebebed0d0eef7fd fdf7eed0bebe8d8d8d8d8d8d8d8d8d8d8d8d8d8d8d8dbebed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd fdf7eed0bebe8d8d8d8d8d8d8d8d8d8d8d8d8d8d8d8dbebed0eef7fd fdf7eed0d0bebebebebebebebebebebebebebebebebebed0d0eef7fd fdf7eeeed0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0eeeef7fd fdf7f7eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeef7f7fd fdfdf7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7fdfd fdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfd } # ==================== # # 3dphoto proc # # ==================== proc 3dphoto {photo {bg1 ""} {bg2 ""}} \ { variable {} if {$bg1 == ""} { set bg1 [. cget -bg] } if {$bg2 == ""} { set bg2 $bg1 } if {![info exists (borders:$bg1:$bg2)]} \ { set (borders:$bg1:$bg2) [map2img $(map) $bg1 $bg2] } set width [image width $photo] set height [image height $photo] set width1 [incr width 14] set height1 [incr height 14] incr width 14 incr height 14 set new [image create photo -width $width -height $height] set bds $(borders:$bg1:$bg2) $new copy $bds -from 0 0 14 14 -to 0 0 $new copy $bds -from 14 0 15 14 -to 14 0 $width1 14 $new copy $bds -from 14 0 28 14 -to $width1 0 $new copy $bds -from 0 14 14 15 -to 0 14 28 $height1 $new copy $photo -to 14 14 $new copy $bds -from 14 14 28 15 -to $width1 14 $width $height1 $new copy $bds -from 0 14 14 28 -to 0 $height1 $new copy $bds -from 14 14 15 28 -to 14 $height1 $width1 $height $new copy $bds -from 14 14 28 28 -to $width1 $height1 return $new } # ==================== # # map2img proc # # ==================== proc map2img {map bg1 bg2} \ { # v3d # get data set data [list] foreach {(R) (G) (B)} [winfo rgb . $bg1] break foreach C {R G B} { set ($C) [expr {$($C) & 255}] } foreach {r g b} [winfo rgb . $bg2] break foreach c {r g b} { set v [set $c]; set $c [expr {$v & 255}] } set bg2 [format #%2.2x%2.2x%2.2x $r $g $b] # create pixels map set y 0 foreach line $map \ { set x 0 set row [list] foreach {pix1 pix2} [split $line {}] \ { if {[string equal -nocase $pix1$pix2 ff]} \ { lappend row $bg2 } \ else \ { set m [expr 0x$pix1$pix2 / 255.0] foreach C {R G B} c {r g b} \ { set ($c) [expr {round($($C) * $m)}] if {$($c) > 255} { set ($c) 255 } } lappend row [format #%2.2x%2.2x%2.2x $(r) $(g) $(b)] } incr x } lappend data $row incr y } # create photo set photo [image create photo] $photo put $data # return photo return $photo } } namespace import ::3dphoto::3dphoto
La démo
##################################### # # 3dphoto demo # ##################################### package require 3dphoto # http://www.huskyhaven.net/images/album/ulis/photo_1.jpg # http://www.huskyhaven.net/images/album/ulis/photo_2.jpg # http://www.huskyhaven.net/images/album/ulis/photo_3.jpg # http://www.huskyhaven.net/images/album/ulis/photo_4.jpg set width [winfo pixel . 21c] set height [winfo pixel . 27c] set bg1 white set bg2 beige . config -bg $bg1 wm geometry . =${width}x$height foreach i {1 2 3 4} \ { set img [image create photo -file photo_$i.gif] frame .f$i label .f$i.i -image [3dphoto $img $bg1 $bg2] -padx 0 -pady 0 label .f$i.t -text photo_$i.gif pack .f$i.i .f$i.t } grid .f1 .f2 grid .f3 .f4 grid rowconfig . {0 1} -weight 1 grid columnconf . {0 1} -weight 1
Voir aussi
Discussion
Catégorie Paquet | Catégorie Traitement d'image