ulis, 2006-11-17. Un package rapidement hacké pour faire des panneaux empilés.
Pourquoi
Pour 'mettre au propre' le megawidget panes de Tk par l'exemple - le megawidget panes.
C'est aussi pour comparer l'effort entre une procédure (50 lignes) et un package (500 lignes).
Comment
Voir Tk par l'exemple - le megawidget panes.
Utilisation
stackedpanes .sp -titles {firefox opera iexplorer} # ==================================== # options : # # - toutes les options du frame, plus # -button commande pour créer un bouton (commande 'button') # -count nombre de panneaux (aucun bouton visible) # -orient orientation (horizontal ou vertical) # -pane commande pour créer un panneau (commande 'frame') # -titles liste des titres des boutons (si visibles) # # - toutes les options des boutons sous la forme : # -b:option valeur (donne la valeur à cette option pour tous les boutons) # -b($n):option valeur (donne la valeur à cette option pour le bouton $n) # # - toutes les options des panneaux sous la forme : # -p:option valeur (donne la valeur à cette option pour tous les panneaux) # -p($n):option valeur (donne la valeur à cette option pour le panneau $n) # ------------------------------------ # opérations : # # cget : retourne la valeur d'une option # create : crée un widget panes # configure : modifie les valeurs des options # get : retourne une valeur par défaut # set : modifie des valeurs par défaut # ------------------------------------ # sous-widgets # # $w.b($n) (le bouton $n) # $w.p($n) (le panneau $n) # ====================================
Configuration
Installation
Utilisation
package require StackedPanes
Le package StackedPanes
if {[info exists ::stackedpanes::version]} { return } namespace eval ::stackedpanes \ { # ############################# # # package (Staked)Panes # variable version 1.0 # # (C) ulis, 2006 # Licence NOL (No Obligation Licence) # # ==================================== # options : # # - toutes les options du frame, plus # -button commande pour créer un bouton (commande 'button') # -count nombre de panneaux (aucun bouton visible) # -orient orientation (horizontal ou vertical) # -pane commande pour créer un panneau (commande 'frame') # -titles liste des titres des boutons (si visibles) # # - toutes les options des boutons sous la forme : # -b:option valeur (donne la valeur à cette option pour tous les boutons) # -b($n):option valeur (donne la valeur à cette option pour le bouton $n) # # - toutes les options des panneaux sous la forme : # -p:option valeur (donne la valeur à cette option pour tous les panneaux) # -p($n):option valeur (donne la valeur à cette option pour le panneau $n) # ------------------------------------ # opérations : # # cget : retourne la valeur d'une option # create : crée un widget panes # configure : modifie les valeurs des options # get : retourne une valeur par défaut # set : modifie des valeurs par défaut # ------------------------------------ # sous-widgets # # $w.b($n) (le bouton $n) # $w.p($n) (le panneau $n) # ==================================== # ############################# ########################## # # entry point # ########################## namespace export stackedpanes ########################## # # package # ########################## package require Tk 8.4 package provide StackedPanes $version ########################## # # globals # ########################## variable {} variable options set w ._stackedpanes_ frame $w set options [list -bd -bg] foreach option [$w config] \ { if {[llength $option] == 5} \ { foreach {key - - - value} $option break if {[string match *color $key] || [string match *ground $key]} \ { foreach {r g b} [winfo rgb . $value] break foreach c {r g b} \ { set $c [expr [set $c] & 255] } set value [format #%2.2x%2.2x%2.2x $r $g $b] } switch -glob -- $key \ { -padx - -pady {} -high* { set key [string range $key 0 10]* } default { set key [string range $key 0 3]* } } array set {} [list $key $value] lappend options $key } } destroy $w unset w array set {} \ { :-button button :-count 0 :-height 200 :-orient horizontal :-pane frame :-relief ridge :-titles {"1" "2"} :-width 150 } ########################## # # panes proc # ########################## proc stackedpanes {{oper {}} args} \ { set code [catch \ { if {$oper == ""} \ { error "panes operations are create, get or set" } switch -glob -- $oper \ { cre* { uplevel 1 ::stackedpanes::panes:create $args } get { uplevel 1 ::stackedpanes::panes:get $args } set { uplevel 1 ::stackedpanes::panes:set $args } default \ { if {[string match .* $oper]} \ { uplevel 1 ::stackedpanes::panes:create $oper $args } \ else \ { error "unknown panes operation '$oper'" } } } } result] return -code $code $result } ########################## # # panes:get proc # ########################## proc panes:get {args} \ { variable {} variable options if {[llength $args] != 1} \ { error "use is 'panes get -option'" } set key [lindex $args 0] switch -glob -- $key \ { -but* { set $(:-button) } -cou* { set $(:-count) } -hei* { set $(:-height) } -ori* { set $(:-orient) } -pan* { set $(:-pane) } -rel* { set $(:-relief) } -tit* { set $(:-titles) } -wid* { set $(:-width) } default \ { if {[set n [lsearch -glob $options $key]] > -1} \ { switch -- $key \ { -bd { set (:-bor*) } -bg { set (:-bac*) } default { set (:[lindex $options $n]) } } } \ else \ { error "unknown panes option '$key'" } } } } ########################## # # panes:set proc # ########################## proc panes:set {args} \ { variable {} variable options if {[llength $args] % 2 != 0} \ { error "use is 'panes set ?-option value?...'" } foreach {key value} $args \ { switch -glob -- $key \ { -but* { set $(:-button) $value } -cou* { check:count "" $value } -ori* { check:orient "" $value } -pan* { set $(:-pane) $value } -tit* { set (:-titles) $value } default \ { if {[lsearch -glob $options $key] > -1} \ { switch -- $key \ { -bd { set (:-bor*) $value } -bg { set (:-bac*) $value } default { set (:[lindex $options $n]) $value } } } \ else \ { error "unknown panes option '$key'" } } } } } ########################## # # panes:create proc # ########################## proc panes:create {{w ""} args} \ { variable {} # default values set defaults [list] foreach name [array names {} :-*] \ { lappend defaults [lindex [split $name :] 1] $($name) } # create panes frame $w -class Panes $w config canvas $w.c -bd 1 -highlightt 0 canvas $w.cc -bd 0 -highlightt 0 grid rowconfig $w 1000 -weight 1 grid columnconf $w 1000 -weight 1 grid $w.c -row 1 -column 1 -sticky nsew \ -rowspan 1000 -columnspan 1000 # create reference rename $w ::stackedpanes::_$w interp alias {} ::$w {} ::stackedpanes::panes:dispatch $w # configure set ($w:-orient) horizontal set ($w:-titles) {} set ($w:-count) 0 set ($w:count) 0 eval ::stackedpanes::panes:config $w $defaults eval ::stackedpanes::panes:config $w $args # select first ::stackedpanes::panes:select $w 0 # return reference return $w } ########################## # # panes:dispatch proc # ########################## proc panes:dispatch {w {oper ""} args} \ { set code [catch \ { if {$oper == ""} \ { error "pane $w operations are cget, configure or select" } switch -glob -- $oper \ { cge* { uplevel 1 ::stackedpanes::panes:cget $w $args } con* { uplevel 1 ::stackedpanes::panes:config $w $args } sel* { uplevel 1 ::stackedpanes::panes:select $w $args } default \ { error "unknown pane operation '$oper'" } } } result] return -code $code $result } ########################## # # panes:cget proc # ########################## proc panes:cget {w args} \ { variable {} variable options if {[llength $args] != 1} \ { error "use is '$w cget -option'" } set key [lindex $args 0] switch -glob -- $key \ { -but* { set ($w:-button) } -hei* { set ($w:-height) } -ori* { set ($w:-orient) } -pan* { set ($w:-pane) } -rel* { set ($w:-relief) } -tit* { set ($w:-titles) } -wid* { set ($w:-width) } default \ { if {[set n [lsearch -glob $options $key]] > -1} \ { ::stackedpanes::_$w cget $key } else \ { error "unknown panes option '$key'" } } } } ########################## # # panes:config proc # ########################## proc panes:config {w args} \ { variable {} variable options if {[llength $args] % 2 != 0} \ { error "use is '$w config ?-option value?...'" } set fdraw 0 set ioptions [list] foreach {key value} $args \ { switch -glob -- $key \ { -*:* { lappend ioptions $key $value } -but* { set ($w:-button) $value } -cou* \ { check:count $w $value set ($w:titles) 0 set fdraw 1 } -hei* { $w.c config -height $value } -ori* \ { check:orient $w $value set fdraw 1 } -pan* { set ($w:-pane) $value } -rel* { $w.c config -relief $value } -tit* \ { set ($w:-titles) $value set ($w:titles) [llength $value] set fdraw 1 } -wid* { $w.c config -width $value } default \ { if {[lsearch -glob $options $key] > -1} \ { ::stackedpanes::_$w config $key $value } \ else \ { error "unknown panes option '$key'" } } } } if {$fdraw} { draw:panes $w } eval item:config $w $ioptions } ########################## # # panes:select proc # ########################## proc panes:select {w args} \ { variable {} switch [llength $args] \ { 0 \ { return $($w:selected)} 1 \ { set n [lindex $args 0] incr n 0 set count [llength $($w:-titles)] if {$n < 0 || $n > $count - 1} \ { error "index '$n' is out of range" } if {[winfo exists $w.b($n)]} \ { set dim3 width; set dim4 height; set relx 0.0; set rely 1.0; set x -2; set y 2 if {$($w:-orient) == "vertical"} \ { set dim3 height; set dim4 width; set relx 1.0; set rely 0.0; set x 2; set y -2 } set dim [winfo $dim3 $w.b($n)] incr dim -3 $w.cc config -$dim3 $dim -$dim4 2 -bg [$w.p($n) cget -bg] place $w.cc -in $w.b($n) -x $x -y $y -relx $relx -rely $rely raise $w.cc } raise $w.p($n) set ($w:selected) $n } default \ { error "use is '$w select count'" } } } ########################## # # draw:panes proc # ########################## proc draw:panes {w} \ { variable {} set titles $($w:-titles) set oldcount $($w:count) set butcount $($w:titles) set newcount $butcount if {$newcount == 0} { set newcount $($w:-count) } set ($w:count) $newcount set mincount $oldcount if {$mincount > $newcount} { set mincount $newcount } set maxcount $oldcount if {$maxcount < $newcount} { set maxcount $newcount } set dim1 row; set dim2 column if {$($w:-orient) == "vertical"} \ { set dim1 column; set dim2 row } for {set n 0} {$n < $mincount} {incr n} \ { if {$butcount == 0 && [winfo exists $w.b($n)]} \ { destroy $w.b($n) } \ elseif {![winfo exists $w.b($n)]} \ { $($w:-button) $w.b($n) -bd 1 -relief ridge \ -text [lindex $titles $n] \ -command [list ::stackedpanes::panes:select $w $n] grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}] } \ else \ { $w.b($n) config -text [lindex $titles $n] grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}] } grid $w.p($n) -row 1 -column 1 -sticky nsew \ -rowspan 1000 -columnspan 1000 -padx 1 -pady 1 } for {set n $mincount} {$n < $maxcount} {incr n} \ { if {$newcount > $mincount} \ { if {![winfo exists $w.b($n)]} \ { $($w:-button) $w.b($n) -bd 1 -relief ridge \ -text [lindex $titles $n] \ -command [list ::stackedpanes::panes:select $w $n] grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}] } \ else \ { $w.b($n) config -text [lindex $titles $n] grid $w.b($n) -$dim1 0 -$dim2 [expr {$n + 1}] } if {![winfo exists $w.p($n)]} \ { $($w:-pane) $w.p($n) grid $w.p($n) -row 1 -column 1 -sticky nsew \ -rowspan 1000 -columnspan 1000 -padx 1 -pady 1 } \ else \ { grid $w.p($n) -row 1 -column 1 -sticky nsew \ -rowspan 1000 -columnspan 1000 } } \ else \ { if {[winfo exists $w.b($n)]} \ { destroy $w.b($n) } destroy $w.p($n) } } } ########################## # # item:config proc # ########################## proc item:config {w args} \ { variable {} set count $($w:count) foreach {key value} $args \ { foreach {type n option} [item:option $key] break if {$n == ""} \ { for {set n 0} {$n < $count} {incr n} \ { $w.${type}($n) config -$option $value } } \ else \ { if {$n < 0 || $n > $count - 1} \ { error "index in '$key' is out of range" } $w.${type}($n) config -$option $value } } } proc item:option {key} \ { set items [split $key -:()] set id "" if {[llength $items] == 3} \ { foreach {- type option} $items break } \ else \ { foreach {- type id - option} $items break } return [list $type $id $option] } ########################## # # check procs # ########################## proc check:int {value} \ { set x 0 incr x $value } proc check:color {w key value} \ { variable {} if {$value != "" && [catch { winfo rgb . $value }]} \ { error "bad $key value '$value'" } set ($w:$key) $value } proc check:count {w value} \ { variable {} if {![string is integer -strict $value] || $value < 0} \ { error "bad -count value '$value'" } set ($w:-count) $value } proc check:orient {w value} \ { variable {} switch -glob -- $value \ { hor* { set ($w:-orient) horizontal } ver* { set ($w:-orient) vertical } default \ { error "bad -orient value '$value'" } } } } namespace import ::stackedpanes::stackedpanes
Script de description pkgIndex.tcl
package ifneeded StackedPanes 1.0 [list source [file join $dir StackedPanes.tcl]]
La démo
package require StackedPanes . config -padx 10 -pady 10 set titles {firefox iexplorer opera} set colors {#fee #eef #efe} set w .sp stackedpanes $w -titles $titles -orient vert -b:width 8 -b:height 5 set n -1 foreach title $titles color $colors \ { incr n $w config -p($n):bg $color -b($n):bg $color label $w.p($n).l -text $title -bg $color grid $w.p($n).l } grid $w after 1 $w select 0 after 2000 [list $w select 2] after 4000 [list $w config -orient horiz -b:height 1] after 4001 [list $w select 1] after 6000 [list $w config -count 2] after 6001 [list $w select 1] after 7000 [list $w select 0]
Voir aussi
Discussion
Catégorie Paquet | Catégorie Interface utilisateur