Forum Programmation.perl Checkbutton

Posté par  .
Étiquettes : aucune
0
28
août
2007
Bonjour,

J'ai un petit probleme
Voila, mon programme ci-dessous cree une frame avec 4 boutons.
Le premier (globale option) quand il est active, il active les 3 autres, sinon on active manuellement les 3 autres.
Puis selon les choix, le bouton exec prend en compte les choix et ouvre des fenetres xterm selon les choix.

Mais le probleme tous les choix sont manuels.
Quelqu'un a une solution ?
Je vous remercie d'avance.


#!/usr/bin/perl -w
use strict;
use Tk;
use Tk::FileSelect;
use Tk::LabFrame;


my $fenetre_planet = MainWindow->new();
$fenetre_planet->minsize(qw(250 150));
$fenetre_planet->title(" * * * LA PLANET");
# my ( $cadre_planet ) ;
# $cadre_planet->LabFrame(-label=>PLANET)->pack();
my $lf2 = $fenetre_planet->Labelframe(qw/-pady 2 -padx 2/);
$lf2->grid(qw/-row 0 -column 1 -pady 2m -padx 2m/);
my $lfdummy2;
my $cb;
$cb = $lf2->Checkbutton(
-text => 'Globale option',
-variable => \$lfdummy2,
-command => sub {&labelframe_buttons($lf2, $cb, \$lfdummy2)},
-padx => 0,
);
$lf2->configure(-labelwidget => $cb);

foreach my $str (qw/Option1 Option2 Option3/) {
$lf2->Checkbutton(-text => $str)->pack(qw/-side top -fill x -pady 2/);
}

# &labelframe_buttons($lf2, $cb, \$lfdummy2);
#$fenetre_planet->Button(
# -text => 'Exec',
# -command => sub { exit })->place(-relx => 0.85, -rely => 0.5);
$fenetre_planet->gridColumnconfigure([0, 1], -weight => 1);

MainLoop;

  • # chez moi

    Posté par  . Évalué à 1.

    si je cliques sur global, ca me renvoie une erreur :

    neox@amd64-full-linux:~$ ./test.pl
    Tk::Error: Undefined subroutine &main::labelframe_buttons called at ./test.pl line 17.
    Tk callback for .labelframe.checkbutton
    Tk::__ANON__ at /usr/lib/perl5/Tk.pm line 247
    Tk::Checkbutton::Invoke at /usr/lib/perl5/Tk/Checkbutton.pm line 39
    <Button-1>
    (command bound to event)


    par contre ca ne dit rien si je clique sur option1, option2 et option3

    en gros je penses que tu ne fais pas d'action, ou alors l'action plante pile au moment de changer l'etat des boutons si on clique sur globale

    • [^] # Re: chez moi

      Posté par  . Évalué à 1.

      Exact et c'est la ou est le probleme.

      je pense que c'est pas la bonne command
      -command => sub {&labelframe_buttons($lf2, $cb, \$lfdummy2)},


      En shell c'est a peu pres ça.

      if selecte button_Globalr = on
      alors action liste $button_option
      fi

      Mais en Perl , c'est certainement tres simple, mais je ne trouve pas

      • [^] # Re: chez moi

        Posté par  . Évalué à 1.

        ben oui, tu n'as pas cree ta fonction labelframe_button

        du coup il ne fait rien et c'est pour ca qu'il plante.

        • [^] # Re: chez moi

          Posté par  . Évalué à 1.

          exact autant pour moi. oups....

          sub labelframe_buttons {
          my ($lf, $cb, $var_ref) = @_;

          foreach my $child ($lf->children) {
          next if $child == $cb;
          if ($$var_ref) {$child->configure(qw/-state normal/);
          } else {$child->configure(qw/-state active/);
          }
          }

          }

          • [^] # Re: chez moi

            Posté par  . Évalué à 1.

            AMHA ce n'est pas la propriété -state qu'il faut changer (ca change juste le fond de couleur)

            mais plutot un truc genre -variable checked

            j'ai pas trouvé, par contre j'ai trouvé :
            http://lionel.romain.free.fr/checkbutton.html

            et mon code fait "presque" ce que tu veux

            sub labelframe_buttons {
            my ($lf, $cb, $var_ref) = @_;

            foreach my $child ($lf->children) {
            next if $child == $cb;
            if ($$var_ref)
            {
            $child->configure(-variable => $var_ref);
            }
            else
            {
            $child->configure(-variable => $var_ref);
            }
            }

            }
            [...]
            $cb = $lf2->Checkbutton(
            -text => 'Globale option',
            -variable => \$lfdummy2,
            -onvalue => '1',
            -offvalue => '0',
            -command => sub {&labelframe_buttons($lf2, $cb, \$lfdummy2)},
            -padx => 0,
            );



            une hypothese sur ce que je viens de trouver :
            on a peut-etre un probleme d'heritage.
            les boutons option1 à 3 sont les fils du bouton "global"

            du coup la commande labelframe_buttons est peut-etre repercutée sur les actions des fils.

          • [^] # Re: chez moi

            Posté par  . Évalué à 1.

            le post precedent donne une piste, mais fausse.

            la solution est là
            http://perl.enstimac.fr/perl5.6.1/site_perl/5.6.1/sun4-solar(...)

            il faut simplement utilise la methode select et deselect pour que les boutons changent d'etat

            le code devient donc le suivant :

            #!/usr/bin/perl -w
            use strict;
            use Tk;
            use Tk::FileSelect;
            use Tk::LabFrame;

            #
            #sub labelframe_buttons {
            #my ($lf, $cb, $var_ref) = @_;
            #foreach my $child ($lf->children) {
            #next if $child == $cb;
            #if ($$var_ref) {$child->configure(qw/-state normal/);}
            # else {$child->configure(qw/-state active/);}
            #
            #}
            sub labelframe_buttons {
            my ($lf, $cb, $var_ref) = @_;

            foreach my $child ($lf->children) {
            next if $child == $cb;
            if ($$var_ref) { $child->select; }
            else { $child->deselect; }
            }

            }

            #
            my $fenetre_planet = MainWindow->new();
            $fenetre_planet->minsize(qw(250 150));
            $fenetre_planet->title(" * * * LA PLANET * * * ");
            # my ( $cadre_planet ) ;
            # $cadre_planet->LabFrame(-label=>PLANET)->pack();
            my $lf2 = $fenetre_planet->Labelframe(qw/-pady 2 -padx 2/);
            $lf2->grid(qw/-row 0 -column 1 -pady 2m -padx 2m/);
            my $lfdummy2;
            my $cb;
            $cb = $lf2->Checkbutton(
            -text => 'Globale option',
            -variable => \$lfdummy2,
            -onvalue => 1,
            -offvalue => 0,
            -command => sub { &labelframe_buttons($lf2, $cb, \$lfdummy2)},
            -padx => 0,
            );
            $lf2->configure(-labelwidget => $cb);

            foreach my $str (qw/Option1 Option2 Option3/) {
            my $bt;
            $bt=$lf2->Checkbutton(-text => $str,
            -onvalue => 1,
            -offvalue => 0,
            )->pack(qw/-side top -fill x -pady 2/);
            }

            # &labelframe_buttons($lf2, $cb, \$lfdummy2);
            #$fenetre_planet->Button(
            # -text => 'Exec',
            # -command => sub { exit })->place(-relx => 0.85, -rely => 0.5);
            $fenetre_planet->gridColumnconfigure([0, 1], -weight => 1);

            MainLoop;

            • [^] # Re: chez moi

              Posté par  . Évalué à 1.

              Super c'est exactement ce que je voulais.
              Effectivement c'est bien un probleme d'heritage.

              Je te remercie beaucoup.

Suivre le flux des commentaires

Note : les commentaires appartiennent à celles et ceux qui les ont postés. Nous n’en sommes pas responsables.