accès aux groupes de discussion, consultation et publication d'articles, recherche de "newsgroups"...
membres, identifiez-vous
é-mail Mot de passe
nouveau ? mot de passe oublié ?
Chargement... Chargement en cours...

Groupes français belges canadiens suisses internationaux Nétiquette
Échangez opinions et commentaires dans les forums de discussion.

Re: changement de formes avec shape

 [  Nouvelle Discussion Nouvelle discussion  |  Répondre au groupe Répondre au groupe  |  fr.comp.lang.tcl ] 

Retour : Accueil du site fr comp lang tcl   charte stats de ce groupe


  Sujet:   Re: changement de formes avec shape  
 De: david.co...@gmail.com (david cobac)
 Groupes: fr.comp.lang.tcl
 Organisation: Guest of ProXad - France
 Date: 13. May 2008, 22:27:45
 References: 1 2 3 4
Eric Hassold <hassold@evolane.com> a écrit :
>[...]
>Et pour le redimensionnement fluide, pixel par pixel, pour un look&feel
>facon dock MacOSX, suffira alors de faire grandir l'image selon la
>distance du pointeur au centre de l'image.
>

Ça doit plus ou moins ressembler à ça (dans le comportement) :

package require Tk
package require pixane
package require shape


proc genIconeMax {src} {
    set icone [pixane create]
    pixane load $icone -file $src

    ## creation icone en taille ::t
    set ::iconeMax [pixane create]
    pixane resize $::iconeMax $::t $::t
    pixane blank $::iconeMax
    pixane scale $::iconeMax $icone -width $::t -height $::t
    return [pixcopy $::iconeMax]
}


proc retailleIcone {{reduc .75}} {

    ## creation reduction icone
    set nvIcone [pixane create]
    set t [expr {int($reduc*$::t)}]
    pixane resize $nvIcone $t $t
    pixane blank $nvIcone
    pixane scale $nvIcone $::iconeMax -width $t -height $t
    # creation icone réduite en taille ::t 
    set nnvIcone [pixane create]
    pixane resize $nnvIcone $::t $::t
    pixane blank $nnvIcone
    set d [expr {int((1-$reduc)*$::t/2)}]
    pixane copy $nnvIcone $nvIcone -to $d $d
    set k [pixcopy $nnvIcone]
    #
    pixane delete $nvIcone
    pixane delete $nnvIcone

    return $k

}

proc executeApp {com} {
    eval exec $com  &
}

proc ajouteApplication {app nom com icone position} {

    genIconeMax $icone
    set app .$app
    toplevel $app
    wm overrideredirect $app 1
    pack [canvas $app.c -width $::largeur -height $::hauteur\
	      -highlightt 0 -bd 0]

    set i [retailleIcone .5]
    $app.c create image 0 0 -anchor nw\
	-image $i -tags ico
    #
    bind $app <1> [list executeApp $com]
    #
    set bb [$app.c bbox ico]
    eval [list $app.c create rectangle] $bb \
	[list -fill "" -outline "" -tags icozone]
    #
    $app.c bind icozone <Motion> [list entreeIcone $app %x %y]
    $app.c bind icozone <Leave> [list sortieIcone $app $i]
    bind $app <Configure> [list modifie $app $i $position]
}

proc entreeIcone {fen x y} {
    set d [expr {hypot($x-$::t/2.,$y-$::t/2)}]
    set r [expr {-2./$::t*$d+1}]
    set j [retailleIcone $r]
    $fen.c itemconfigure ico -image $j
    t $fen $j
}

proc sortieIcone {fen icone} {
    $fen.c itemconfigure ico -image $icone
    t $fen $icone
}

proc t {fen icone {xoff 0} {yoff 0}} {
    shape set $fen photo $icone
}

proc modifie {fen icone position} {
    t $fen $icone
}


proc affichageBoutons {} {
    set i 0
    foreach app $::ordre {
	ajouteApplication \
	    $app \
	    [set ::[set app](nom)] \
	    [set ::[set app](commande)]\
	    [set ::[set app](icone)]\
	    [incr i]
    }
    
}

# t taille de la grande icone
set t 80
# largeur et hauteur : dimensions des canvas contenant l'icone
set largeur $::t
set hauteur $::t
#
set Lecran [winfo screenwidth .]
set Hecran [winfo screenheight .]
wm withdraw .


############################################################################

array set navigateur {
    nom Firefox
    commande firefox
    icone /usr/share/pixmaps/firefox-3.0.png
}

set ordre {navigateur}
###############

affichageBoutons
# pour l'exemple
wm geometry .navigateur +[expr {$::Lecran/2}]+[expr {$::Hecran/2}]


DateSujet  Auteur
01.01.
o 
Groups Explorer contact votre avis comment ça marche? rechercher un groupe suggérer un groupe abuse accueil du site   Imprimer cette page   Envoyer cette page à un(e) ami(e)
Usenet Gratuit