ulis, 2006-01-29. Une procédure pour redimensionner une map.
Pourquoi
Pour avoir des images de toutes les dimensions. En particulier pour faire de beaux boutons, comme c'est à la mode.
Comment
En ajoutant/retranchant des lignes/colonnes dans la map.
Utilisation
sizemap map width height {keep 4} # map : une map # width : la nouvelle largeur (ou 0 pour ne pas la changer) # height : la nouvelle hauteur (ou 0 pour ne pas la changer) # keep : largeur de la bordure à ne pas toucher (4 pixels par défaut)
La procédure
# size a map proc sizemap {map width height {keep 4}} \ { set keep1 [expr {$keep - 1}] set keep2 [expr {$keep * 2}] # size width set maxy [llength $map]; incr maxy -1 if {$width > 0} \ { set maxx [string length [lindex $map 1]] if {$width < $keep2 + 1} \ { # xtrem shrink if {$maxx > $keep2} \ { set map2 [lindex $map 0] for {set i 1} {$i <= $maxy} {incr i} \ { # keep only first & last set line [lindex $map $i] set line2 [string range $line 0 $keep1] append line2 [string range $line end-$keep1 end] lappend map2 $line2 } set map $map2 } } \ elseif {$width < $maxx} \ { # shrink set map2 [lindex $map 0] set step [expr {double($maxx - $keep2) / ($maxx - $width + 1)}] for {set i 1} {$i <= $maxy} {incr i} \ { set line [lindex $map $i] set line2 [string range $line 0 $keep1] set ip $keep set p $keep # suppress chars between line[2] & line[end-2] while {($p + $step + 1 - $maxx + $keep) < 1.e-5} \ { set iq [expr {int(ceil($p + $step - 1))}] append line2 [string range $line $ip $iq] while {($p + $step - $iq - 1) < 1.e-5} \ { set line2 [string range $line2 0 end-1] set p [expr {$p + $step}] } set ip [incr iq] } append line2 [string range $line $ip end] lappend map2 $line2 } set map $map2 } \ elseif {$width > $maxx} \ { # extend set map2 [lindex $map 0] set step [expr {double($maxx - $keep2) / ($width - $maxx)}] for {set i 1} {$i <= $maxy} {incr i} \ { set line [lindex $map $i] set line2 [string range $line 0 $keep1] set ip $keep set p $keep # intersperse new chars between [lindex $line $keep1] & [lindex $line end-$keep1] while {($p + $step - $maxx + $keep) < 1.e-5} \ { set iq [expr {int(ceil($p + $step - 1))}] append line2 [string range $line $ip $iq] while {($p + $step - $iq - 1) < 1.e-5} \ { append line2 [string index $line2 end] set p [expr {$p + $step}] } set ip [incr iq] } append line2 [string range $line $ip end] lappend map2 $line2 } set map $map2 } } # size height if {$height > 0} \ { set keep3 [expr {$keep + 1}] if {$height < $keep2 + 1} \ { # xtrem shrink if {$maxy > $keep2} \ { set map2 [lrange $map 0 $keep] set map2 [concat $map2 [lrange $map end-$keep1 end]] set map $map2 } } \ elseif {$height < $maxy} \ { # shrink set map2 [lrange $map 0 $keep] set step [expr {double($maxy - $keep2) / ($maxy - $height + 1)}] set ip $keep3 set p $keep3 # intersperse new lines between [lindex $map $keep] & [lindex $map end-$keep1] while {($p + $step - $maxy + $keep) < 1.e-5} \ { set iq [expr {int(ceil($p + $step - 1))}] set map2 [concat $map2 [lrange $map $ip $iq]] while {($p + $step - $iq - 1) < 1.e-5} \ { set map2 [lrange $map2 0 end-1] set p [expr {$p + $step}] } set ip [incr iq] } set map2 [concat $map2 [lrange $map $ip end]] set map $map2 } \ elseif {$height > $maxy} \ { # extend set map2 [lrange $map 0 $keep] set step [expr {double($maxy - $keep2) / ($height - $maxy)}] set ip $keep3 set p $keep3 # intersperse new lines between [lindex $map $keep] & [lindex $map end-$keep1] while {($p + $step - 1 - $maxy + $keep) < 1.e-5} \ { set iq [expr {int(ceil($p + $step - 1))}] set map2 [concat $map2 [lrange $map $ip $iq]] while {($p + $step - $iq - 1) < 1.e-5} \ { lappend map2 [lindex $map2 end] set p [expr {$p + $step}] } set ip [incr iq] } set map2 [concat $map2 [lrange $map $ip end]] set map $map2 } } return $map }
Démo
set map \ { 0 0000aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa0000 00aaddddddddddddddddddddddddddddddddddddddddddaa00 0adddddddddddddddddddddddddddddddddddddddddddddda0 0adddddddddddddddddddddddddddddddddddddddddddddda0 adddddddddddddddddddddddddddddddddddddddddddddddda adddddddddddddddddddddddddddddddddddddddddddddddda adddddddddddddddddddddddddddddddddddddddddddddddda adddddddddddddddddddddddddddddddddddddddddddddddda adddddddddddddddddddddddddddddddddddddddddddddddda adddddddddddddddddddddddddddddddddddddddddddddddda adddddddddddddddddddddddddddddddddddddddddddddddda 9cccccccccccccccccccccccccccccccccccccccccccccccc9 9cccccccccccccccccccccccccccccccccccccccccccccccc9 9cccccccccccccccccccccccccccccccccccccccccccccccc9 9cccccccccccccccccccccccccccccccccccccccccccccccc9 9cccccccccccccccccccccccccccccccccccccccccccccccc9 09cccccccccccccccccccccccccccccccccccccccccccccc90 09cccccccccccccccccccccccccccccccccccccccccccccc90 0099dddddddddddddddddddddddddddddddddddddddddd9900 00009999999999999999999999999999999999999999990000 } package require Tk wm title . resizemap set row 0 set col 0 foreach hh {10 20 40} \ { foreach ww {25 50 100} \ { set w .${ww}x$hh frame $w label $w.l -text "$ww x $hh" -anchor center button $w.b -bd 0 -highlightt 0 \ -image [map2img [sizemap $map $ww $hh]] pack $w.l $w.b -pady 2 grid $w -row $row -column $col -padx 10 -pady 10 if {[incr col] == 3} \ { set col 0 incr row } } }
Voir aussi
Discussion
Catégorie Exemple | Catégorie Traitement d'image