Publicité
+ Répondre à la discussion
Affichage des résultats 1 à 2 sur 2
  1. #1
    Membre Expert Avatar de dmganges
    Homme Profil pro Michel DUFOUR
    Administrateur Unix / Oracle retraité
    Inscrit en
    septembre 2011
    Messages
    905
    Détails du profil
    Informations personnelles :
    Nom : Homme Michel DUFOUR
    Âge : 62
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Administrateur Unix / Oracle retraité
    Secteur : Service public

    Informations forums :
    Inscription : septembre 2011
    Messages : 905
    Points : 1 198
    Points
    1 198

    Par défaut Perl Tk scroll de plusieurs colonnes de Frames

    Bonjour,
    Rien d'opérationnel ici, juste un cas d'école, même si je n'ai plus l'âge !

    Je cherche à scroller plusieurs colonnes contenant plusieurs lignes contenant elles mêmes plusieurs Frames.

    Ça pourrait servir par exemple à générer une bataille navale sur un océan de cases (Frames)

    1er essai :
    La barre de scroll dépend du cadre général contenant les deux colonnes.
    Le scroll fonctionne, mais l'affichage se dégrade :
    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    #! /usr/bin/perl
    use strict;
    use warnings;
    use utf8;
    use Tk;
    use Tk::LabFrame;
    use Tk::Pane;
     
    my $NB_LIG = 30;
    my $NB_COL = 30;
     
    my(@lig_casesG, @CaseG, @lig_lig, @Lig, @lig_casesD, @CaseD);
    my @tab = (0..$NB_COL,0..$NB_LIG);
     
    # Creation du widget principal
    my $Wm = MainWindow->new(
      -title      => "Essais scroll 2 colonnes de frames découpées en cases",
      -background => 'white',
    );
    $Wm->minsize( 800, 400 );
     
    # Cadres
    my $couleur_commune = '#E0F0FF';
     
    my $cadreHAUT = $Wm->LabFrame(
    	-background => '#FFF111',
      -width => 20,
      -height => 20,
      -label => 'Cadre HAUT',
    )->pack( qw/ -side top -fill both -expand 1 / );
     
    # NB Le Scroll est dépendant de $cadre
    my $cadre = $Wm->Scrolled('Frame',
    	-scrollbars => 'e',
      -width => 20,
      -height => 20,
      -label => 'Pour voir',
    )->pack( qw/ -side bottom -fill both -expand 0 / );
     
    # j'ai essayé çà mais çà ne fait rien :
    $cadre->Subwidget("yscrollbar")->configure(
    	-repeatinterval => 1500,
    	-repeatdelay => 1500,
    );
     
    my $casesG = $cadre->LabFrame(
    	-background => $couleur_commune,
    	-relief      => 'groove',
    	-width => 60 ,
    	-label      => 'Cases gauches',
    );
     
    my $lignes = $cadre->LabFrame(
    	-background => $couleur_commune,
    	-relief      => 'groove',
    	-width => 10 ,
    	-label      => 'Lignes',
    );
     
    my $casesD = $cadre->LabFrame(
    	-background => $couleur_commune,
    	-relief      => 'groove',
    	-width => 60 ,
    	-label      => 'Cases droites',
    );
     
    # $cadre contient :
    # Deux cadres G & D qui vont contenir plusieurs lignes de cases
    # séparés par une colone qui contient le n° de ligne
    $cadre->pack(qw / -side bottom -fill both -expand 1 /);
    $casesG->pack(qw / -side left -fill both -expand 1 /);
    $lignes->pack(qw / -side left -fill both -expand 1 /);
    $casesD->pack(qw / -side left -fill both -expand 1 /);
     
    # Lignes dans cadres
    for ( my $numlig = 1 ; $numlig < $NB_LIG; $numlig++ ){
    	#CasesG
    	$lig_casesG[$numlig] = $casesG->Label (
      	-width => 2 ,
      	-background  => '#AAE0D0',
      	-height => 1, )->pack(qw / -side bottom								
      														-fill x
      														-expand 0 /);
     
     
      	for ( my $numcol = 1 ; $numcol < $NB_COL; $numcol++ ){
      		$CaseG[$numlig][$numcol] = $lig_casesG[$numlig]->Label (
      			-textvariable => \$tab[$numcol],
      			-width => 2 ,
      			-background  => '#AAE0D0',
      			-height => 1, )->pack(qw / -side left
      														-fill x
      														-expand 0 /);
     
      	}
     
      #lignes
    	$lig_lig[$numlig] = $lignes->Label (
      	-width => 2 ,
      	-background  => '#AAE0D0',
      	-height => 1, )->pack(qw / -side bottom								
      														-fill x
      														-expand 0 /);
     
     
      	for ( my $numcol = 1 ; $numcol < 2; $numcol++ ){
      		$Lig[$numlig][$numcol] = $lig_lig[$numlig]->Label (
      			-textvariable => \$tab[$numlig],
      			-width => 2 ,
      			-background  => '#AAE0D0',
      			-height => 1, )->pack(qw / -side left
      														-fill x
      														-expand 0 /);
     
      	}
     
      #CasesD
    	$lig_casesD[$numlig] = $casesD->Label (
      	-width => 2 ,
      	-background  => '#AAE0D0',
      	-height => 1, )->pack(qw / -side bottom								
      														-fill x
      														-expand 0 /);
     
     
      	for ( my $numcol = 1 ; $numcol < $NB_COL; $numcol++ ){
      		$CaseD[$numlig][$numcol] = $lig_casesD[$numlig]->Label (
      			-textvariable => \$tab[$numcol],
      			-width => 2 ,
      			-background  => '#AAE0D0',
      			-height => 1, )->pack(qw / -side left
      														-fill x
      														-expand 0 /);
     
      	}
     
    }
     
    $CaseG[1][1]->configure(
    		-background => '#FFE0D0',
    );
     
    $CaseD[5][5]->configure(
    		-background => '#FFE0D0',
    );
     
    MainLoop();
    # j'ai essayé çà pour ralentir, mais ça ne fait rien :
    Code :
    1
    2
    3
    4
    $cadre->Subwidget("yscrollbar")->configure(
    	-repeatinterval => 1500,
    	-repeatdelay => 1500,
    );
    Deuxième essai :
    La barre de scroll est indépendante.
    Le scroll fonctionne pas.
    Je constate que c'est la fenêtre de lancement (DOS) qui scrolle !!!
    Code :
    1
    2
    3
    Petit à petit j'ai ajouté des :
    $defil_v->configure( -command => sub {
    jusqu'au niveau le plus élémentaire, sans succès :
    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    #! /usr/bin/perl
    use strict;
    use warnings;
    use utf8;
    use Tk;
    use Tk::LabFrame;
     
    my $NB_LIG = 30;
    my $NB_COL = 30;
     
    my(@lig_casesG, @CaseG, @lig_lig, @Lig, @lig_casesD, @CaseD);
    my @tab = (0..$NB_COL,0..$NB_LIG);
     
    # Creation du widget principal
    my $Wm = MainWindow->new(
      -title      => "Essais scroll 2 colonnes de frames découpées en cases",
      -background => 'white',
    );
    $Wm->minsize( 800, 400 );
     
    # Cadres
    my $couleur_commune = '#E0F0FF';
     
    my $cadreHAUT = $Wm->LabFrame(
    	-background => '#FFF111',
      -width => 20,
      -height => 100,
      -label => 'Cadre HAUT',
    )->pack( qw/ -side top -fill both -expand 1 / );
     
    # NB Le Scroll est INdépendant
    my $defil_v = $Wm->Scrollbar(
    )->pack(qw/ -side right -fill y /);
     
    my $cadre = $Wm->LabFrame(
      -width => 20,
      -height => 20,
      -label => 'Pour voir',
    )->pack( qw/ -side bottom -fill both -expand 0 / );
     
    my $casesG = $cadre->LabFrame(
    	-background => $couleur_commune,
    	-relief      => 'groove',
    	-width => 60 ,
    	-label      => 'Cases gauches',
    );
     
    my $lignes = $cadre->LabFrame(
    	-background => $couleur_commune,
    	-relief      => 'groove',
    	-width => 10 ,
    	-label      => 'Lignes',
    );
     
    my $casesD = $cadre->LabFrame(
    	-background => $couleur_commune,
    	-relief      => 'groove',
    	-width => 60 ,
    	-label      => 'Cases droites',
    );
     
    # $cadre contient :
    # Deux cadres G & D qui vont contenir plusieurs lignes de cases
    # séparés par une colone qui contient le n° de ligne
    $cadre->pack(qw / -side bottom -fill both -expand 1 /);
    $casesG->pack(qw / -side left -fill both -expand 1 /);
    $lignes->pack(qw / -side left -fill both -expand 1 /);
    $casesD->pack(qw / -side left -fill both -expand 1 /);
     
    # cadre et listes doivent communiquer avec la barre
    $defil_v->configure( -command => sub {
    	[$cadre->yview(@_)],
      [$casesG->yview(@_)],
      [$lignes->yview(@_)],
      [$casesD->yview(@_)],
      }
    );
     
    # Lignes dans cadres
    for ( my $numlig = 1 ; $numlig < $NB_LIG; $numlig++ ){
    	#CasesG
    	$lig_casesG[$numlig] = $casesG->Label (
      	-width => 2 ,
      	-background  => '#AAE0D0',
      	-height => 1, )->pack(qw / -side bottom								
      														-fill x
      														-expand 0 /);
      	$defil_v->configure( -command => sub { [$lig_casesG[$numlig]->yview(@_)] } );
     
      	for ( my $numcol = 1 ; $numcol < $NB_COL; $numcol++ ){
      		$CaseG[$numlig][$numcol] = $lig_casesG[$numlig]->Label (
      			-textvariable => \$tab[$numcol],
      			-width => 2 ,
      			-background  => '#AAE0D0',
      			-height => 1, )->pack(qw / -side left
      														-fill x
      														-expand 0 /);
      		$defil_v->configure( -command => sub { [$CaseG[$numlig][$numcol]->yview(@_)] } );
      	}
     
      #lignes
    	$lig_lig[$numlig] = $lignes->Label (
      	-width => 2 ,
      	-background  => '#AAE0D0',
      	-height => 1, )->pack(qw / -side bottom								
      														-fill x
      														-expand 0 /);
      	$defil_v->configure( -command => sub { [$lig_lig[$numlig]->yview(@_)] } );
     
      	for ( my $numcol = 1 ; $numcol < 2; $numcol++ ){
      		$Lig[$numlig][$numcol] = $lig_lig[$numlig]->Label (
      			-textvariable => \$tab[$numlig],
      			-width => 2 ,
      			-background  => '#AAE0D0',
      			-height => 1, )->pack(qw / -side left
      														-fill x
      														-expand 0 /);
      		$defil_v->configure( -command => sub { [$Lig[$numlig][$numcol]->yview(@_)] } );
      	}
     
      #CasesD
    	$lig_casesD[$numlig] = $casesD->Label (
      	-width => 2 ,
      	-background  => '#AAE0D0',
      	-height => 1, )->pack(qw / -side bottom								
      														-fill x
      														-expand 0 /);
      	$defil_v->configure( -command => sub { [$lig_casesD[$numlig]->yview(@_)] } );
     
      	for ( my $numcol = 1 ; $numcol < $NB_COL; $numcol++ ){
      		$CaseD[$numlig][$numcol] = $lig_casesD[$numlig]->Label (
      			-textvariable => \$tab[$numcol],
      			-width => 2 ,
      			-background  => '#AAE0D0',
      			-height => 1, )->pack(qw / -side left
      														-fill x
      														-expand 0 /);
      		$defil_v->configure( -command => sub { [$CaseD[$numlig][$numcol]->yview(@_)] } );
      	}
     
    }
     
    $CaseG[1][1]->configure(
    		-background => '#FFE0D0',
    );
     
    $CaseD[5][5]->configure(
    		-background => '#FFE0D0',
    );
     
    MainLoop();
    Dans Introduction à Perl Tk 6-Barres de défilement p134, il est précisé que les barres fonctionnent avec les boîtes de liste, les canevas, les zones de saisie, les listes et les damiers, mais que ces derniers ne sont pas traités.

    Le premier exemple qui fonctionne presque me laisse penser que ce que j'ai fait n'est pas impossible et qu'il n'y aurait qu'un réglage du rafraîchissement à réaliser... pourtant lorsque je diminue le nombre de colonnes il n'y a aucune amélioration ?

    Auriez-vous quelques pistes ?
    N'y passez pas vos nuits, c'est juste pour occuper mon neurone
    MERCI !

  2. #2
    Membre Expert Avatar de dmganges
    Homme Profil pro Michel DUFOUR
    Administrateur Unix / Oracle retraité
    Inscrit en
    septembre 2011
    Messages
    905
    Détails du profil
    Informations personnelles :
    Nom : Homme Michel DUFOUR
    Âge : 62
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Administrateur Unix / Oracle retraité
    Secteur : Service public

    Informations forums :
    Inscription : septembre 2011
    Messages : 905
    Points : 1 198
    Points
    1 198

    Par défaut Perl Tk Canvas pour chaines arabes et non Scrolled !

    C'est une ânerie !
    Dans la précipitation j'ai collé des scrolls à une Frame... çà me semblait naturel
    Comme çà fonctionnait ""presque"" je me suis embarqué dans une mauvaise direction.

    Pour faire un vrai damier scrollable il vaut mieux passer par Canvas.

    Je fais donc mes premiers pas dans Canvas et je découvre qu'il gère mieux les chaînes arabes.
    Donc la bataille navale çà sera pour plus tard, je retourne à mon sujet initial, moins potache :

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    #!/usr/bin/perl
    use warnings;
    use strict;
    use utf8;
    use Tk;
    use Tk::ROText;
     
    my $Wm =  new MainWindow();
    $Wm->geometry("1000x500+100+100");
     
    my $midframe = $Wm->Frame(-bg=>'grey45')->pack();
    my $midframel = $midframe->Frame(-bg=>'grey45')
                       ->pack(-side=>'left',-expand=>1,-fill=>'y');
    my $midframer = $midframe->Frame(-bg=>'grey45')
                 ->pack(-side=>'right');
     
    # Scrolled qui affiche le texte
    my $widget_text_cours = $midframer->Scrolled(
      'ROText',
      -scrollbars => 'e',
      -takefocus  => 0,
      -wrap      => 'word',
      -relief    => 'flat',
      -background => '#ABFAA3',
    );
    $widget_text_cours->pack(qw / -side top -fill both -expand 1 /);
    configurer_tags($widget_text_cours);
     
    my $canvasp;
     
    #for canvasp and yscroll
    my $midframer1 = $midframer->Frame(-bg=>'grey45')
                       ->pack(-side=>'top');
     
    my $yscroll = $midframer1->Scrollbar( 
           -orient  => 'vertical',
           -command => \&yscrollit,
           -troughcolor =>'grey45',
           -activebackground =>'lightseagreen',
           -background => 'lightseagreen',
           )->pack(-side=>'right',-fill=>'y');
     
    #canvas qui affiche le texte
    $canvasp = $midframer1->Canvas(
                 -bg =>'lightsteelblue',
                 -width=>1400,
                 -height=> 700,
                 -scrollregion=>[0,0,1400,700],
          				-yscrollincrement => 1,
                 -yscrollcommand => [ 'set', $yscroll ],
    	     ) ->pack(-side=>'left');#,-fill=>'both');
     
    my $texte = "&#1601;&#1614;&#1589;&#1615;&#1608;&#1604;&#1615;  &#1575;&#1604;&#1587;&#1614;&#1617;&#1606;&#1614;&#1577;  : &#1575;&#1604;&#1585;&#1614;&#1617;&#1576;&#1616;&#1610;&#1593;   &#1575;&#1604;&#1589;&#1614;&#1617;&#1610;&#1618;&#1601;   &#1575;&#1604;&#1618;&#1582;&#1614;&#1585;&#1616;&#1610;&#1601;   &#1575;&#1604;&#1587;&#1616;&#1617;&#1578;&#1614;&#1575;&#1569;";
    my $font = 0;
    $font = $font + 36;
     
    $widget_text_cours->insert( 'end', "\n", "g12" );
    $widget_text_cours->insert( 'end', "Le texte dans Scrolled Text se fragmente\n si on clique dessus avec la souris\n", "g36" );
    $widget_text_cours->insert( 'end', $texte, "g36" );
    $widget_text_cours->insert( 'end', "\n", "g12" );
     
    $canvasp->createText(0,60,
    	-width=>1300,
    	-anchor => "w",
    	-justify => "left",
    	-font      => '{Simplified Arabic} 36 {bold}',
    	-text => "Le texte dans Canvas ne se fragmente pas au clic de la souris\n",
    );
     
    $canvasp->createText(1900,200,
    	-width=>1900,
    	-anchor => "e",
    	-justify => "right",
    	-font      => '{Simplified Arabic} 36 {bold}',
    	-text => $texte,
    );
     
     
    #---------------------------------------------------------------
    MainLoop;
    ################################################################
     
    sub xscrollit{
     my $fraction = $_[1];
     $canvasp->xviewMoveto($fraction);
    }
    ################################################################
    sub yscrollit{
      my $fraction = $_[1];
      $canvasp->yviewMoveto($fraction);
    }
    ################################################################
     
    #########################################
    # Configuration des polices de caractères
    #
    sub configurer_tags {
    	my $widget_text = shift;
    	for my $police ( 12 .. 72 ) {
    		if ( $police % 2 == 0 ) {
    			$widget_text->tagConfigure(
    				"g$police",
    				-background => '#ABFAA3',
    				-font      => "{Simplified Arabic} $police {bold}",
    				-justify    => 'center',
    			);
    		}
    	}
    }
    @+ si je m'en sors avec la gestion des indices dans le canvas...

Liens sociaux

Règles de messages

  • Vous ne pouvez pas créer de nouvelles discussions
  • Vous ne pouvez pas envoyer des réponses
  • Vous ne pouvez pas envoyer des pièces jointes
  • Vous ne pouvez pas modifier vos messages
  •