Perl en Español
  1. Home
  2. Tutoriales
  3. Foro
  4. Artículos
  5. Donativos
  6. Publicidad
 
Índice general » Mundo Perl » Básico » bind en Tk  RESUELTO Responder al tema
Nuevo tema


Página 1 de 1  [ 5 mensajes ] 
  Imprimir vista
Nota 2012-01-31 08:27 @394
princiDesconectado
Perlero Nuevo 		Registrado: 2012-01-31 08:00 @375
Mensajes: 7
bind en Tk  RESUELTO
Hola, soy bastante nueva en Perl. Mi problema es que creé una tabla y necesito que por cada fila me genere un archivo txt, pero no conozco, ni encontré el funcionamiento de bind...

(acá está la tabla)

Syntax: [ Download ] [ Hide ]
Using perl Syntax Highlighting
  1. $mw1->Label (-text => "Informe", -font => 'ARIAL',-foreground=>'DARK BLUE') -> pack();
  2. my $frame = $mw1->Frame()->pack();
  3. my $T = $frame-> Table(-columns => 8, -rows => 11,-fixedrows => 1,-scrollbars => 'oe', -relief => 'raised');
  4. $tmp_label = $frame->Label(-text => $i, -padx => 2,-anchor => 'center', -background => 'white', -relief => "groove");
  5.  $T->put($i,1,$tmp_label);
  6.  $tmp_label = $frame->Label(-text => $A, -padx => 2,-anchor => 'center', -background => 'white', -relief => "groove");
  7.  $T->put($i,2,$tmp_label);
  8. $tmp_label = $frame->Label(-text => "txt" , -padx => 2,-anchor => 'center', -background => 'white', -relief => "groove");
  9. $T->put($i,8,$tmp_label);
  10. $tmp_label->bind('<Button-1>',\&file );


¡Muchas Gracias! Espero haber sido explicita en mi duda...
¡Saludos!
Nota 2012-01-31 15:25 @684
Avatar de Usuario explorerDesconectado
Administrador 		Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Mensajes: 10216
Re: bind en Tk
Bienvenida a los foros de Perl en español, princi.

No entiendo bien la pregunta. ¿A qué corresponde el código mostrado? Yo veo instrucciones para gestionar un entorno gráfico. Y no veo ningún 'bind' por ningún lado.

¿Estaríamos hablando de Tk?

Quizás lo que quieres hacer es guardar el contenido de las cajas de texto o tabla en un archivo de texto.

_________________
JF^D Perl programming

Nota 2012-01-31 19:48 @867
princiDesconectado
Perlero Nuevo 		Registrado: 2012-01-31 08:00 @375
Mensajes: 7
Re: bind en Tk
Así es, es entorno gráfico... el código completo sería este:
Syntax: [ Download ] [ Hide ]
Using perl Syntax Highlighting
  1. my $mw1 = MainWindow->new;
  2. $mw1->geometry("600x350");
  3. $mw1->resizable( 1, 1 );
  4. $mw1->title("Ultimos 10 ");
  5.  
  6. my $fichero = "C:\\DoNotCopyToEB\\old.dat";
  7.  
  8. open FICHERO, "$fichero";
  9. my @linea = <FICHERO>;
  10.  
  11. $mw1->Label( -text => "Informe", -font => 'ARIAL', -foreground => 'DARK BLUE' )->pack();
  12. my $frame = $mw1->Frame()->pack();
  13. my $T = $frame->Table( -columns => 8, -rows => 11, -fixedrows => 1, -scrollbars => 'oe', -relief => 'raised' );
  14.  
  15. #* * * * * * * ENCABEZADOS * * * * * *
  16. my $tmp_label = $frame->Label( -text => " N° ", -justify => 'center', -width => 3, -relief => 'raised' );
  17. $T->put( 0, 1, $tmp_label );
  18. $tmp_label = $frame->Label( -text => "FECHA ", -width => 12, -relief => 'raised' );
  19. $T->put( 0, 2, $tmp_label );
  20. $tmp_label = $frame->Label( -text => "HORA ", -width => 10, -relief => 'raised' );
  21. $T->put( 0, 3, $tmp_label );
  22. $tmp_label = $frame->Label( -text => "L ", -width => 10, -relief => 'raised' );
  23. $T->put( 0, 4, $tmp_label );
  24. $tmp_label = $frame->Label( -text => "Lo ", -width => 10, -relief => 'raised' );
  25. $T->put( 0, 5, $tmp_label );
  26. $tmp_label = $frame->Label( -text => "PR ", -width => 15, -relief => 'raised' );
  27. $T->put( 0, 6, $tmp_label );
  28. $tmp_label = $frame->Label( -text => "MA ", -width => 10, -relief => 'raised' );
  29. $T->put( 0, 7, $tmp_label );
  30. $tmp_label = $frame->Label( -text => "file ", -width => 8, -relief => 'raised' );
  31. $T->put( 0, 8, $tmp_label );
  32.  
  33. #* * * * * * * * LLENADO DE TABLA* * *  * * * * * * *
  34.  
  35. for ( $i = 1; $i < 11; $i++ ) {
  36.  
  37.     my @datos = split( /\s+/, $linea[ $i - 1 ] );    #/\s/ es un espacio en blanco (space)
  38.     $lat[$cont]   = sprintf( "%5.2f", $datos[1] );
  39.     $lon[$cont]   = sprintf( "%5.2f", $datos[2] );
  40.     $dep[$cont]   = sprintf( "%3.1f", $datos[6] );
  41.     $sta[$cont]   = $datos[9];
  42.     $m1mag[$cont] = sprintf( "%4.2f", $datos[3] );
  43.     $mag{Ms}      = $datos[16];
  44.  
  45.     #print "Ms $datos[16] \n";
  46.     $mag{Mw} = $datos[20];
  47.  
  48.     #print "Mw $datos[20] \n";
  49.     $mag{Ml} = $datos[14];
  50.  
  51.     #print "Ml $datos[14] \n";
  52.     $mag{Mwp} = $datos[18];
  53.  
  54.     #print "Mwp $datos[18] \n";
  55.     $mag{Mb} = $datos[12];
  56.  
  57.     #print "Mb $datos[12] \n";
  58.  
  59.     foreach my $value ( sort { $mag{$a} cmp $mag{$b} } keys %mag ) {
  60.  
  61.         #print "$value $mag{$value}\n";
  62.         $m1mag[$cont] = sprintf "%4.2f", $mag{$value};
  63.         $m1typ[$cont] = $value;
  64.     }
  65.     $origen[$cont] = $datos[0];
  66.     my @utc = gmtime( $origen[$cont] );
  67.  
  68.     #$origen[$cont] = int($origen[$cont]);
  69.  
  70.     $yr[$cont]   = sprintf "%4d",  $utc[5] + 1900;
  71.     $mo[$cont]   = sprintf "%02d", $utc[4] + 1;
  72.     $mday[$cont] = sprintf "%02d", $utc[3];
  73.     $hr[$cont]   = sprintf "%02d", $utc[2];
  74.     $mi[$cont]   = sprintf "%02d", $utc[1];
  75.     $se[$cont]   = sprintf "%02d", $utc[0];
  76.  
  77.     my $A = $mday[$cont] . "/" . $mo[$cont] . "/" . $yr[$cont];
  78.     my $B = $hr[$cont] . ":" . $mi[$cont] . ":" . $se[$cont];
  79.  
  80.     $tmp_label
  81.         = $frame->Label( -text => $i, -padx => 2, -anchor => 'center', -background => 'white', -relief => "groove" );
  82.     $T->put( $i, 1, $tmp_label );
  83.  
  84.     $tmp_label
  85.         = $frame->Label( -text => $A, -padx => 2, -anchor => 'center', -background => 'white', -relief => "groove" );
  86.     $T->put( $i, 2, $tmp_label );
  87.  
  88.     $tmp_label
  89.         = $frame->Label( -text => $B, -padx => 2, -anchor => 'center', -background => 'white', -relief => "groove" );
  90.     $T->put( $i, 3, $tmp_label );
  91.  
  92.     $tmp_label = $frame->Label(
  93.         -text       => $lat[$cont],
  94.         -padx       => 2,
  95.         -anchor     => 'center',
  96.         -background => 'white',
  97.         -relief     => "groove"
  98.     );
  99.     $T->put( $i, 4, $tmp_label );
  100.  
  101.     $tmp_label = $frame->Label(
  102.         -text       => $lon[$cont],
  103.         -padx       => 2,
  104.         -anchor     => 'center',
  105.         -background => 'white',
  106.         -relief     => "groove"
  107.     );
  108.     $T->put( $i, 5, $tmp_label );
  109.  
  110.     $tmp_label = $frame->Label(
  111.         -text       => $datos[6],
  112.         -padx       => 2,
  113.         -anchor     => 'center',
  114.         -background => 'white',
  115.         -relief     => "groove"
  116.     );
  117.     $T->put( $i, 6, $tmp_label );
  118.  
  119.     $tmp_label = $frame->Label(
  120.         -text       => $m1mag[$cont],
  121.         -padx       => 2,
  122.         -anchor     => 'center',
  123.         -background => 'white',
  124.         -relief     => "groove"
  125.     );
  126.     $T->put( $i, 7, $tmp_label );
  127.  
  128.     $tmp_label = $frame->Label( -text => "FILE", -padx => 2, -anchor => 'center', -background => 'white',
  129.         -relief => "groove" );
  130.     $T->put( $i, 8, $tmp_label );
  131.     $tmp_label->bind('<Button-1>',\&sfile );
  132.  
  133.  }
  134.  
  135.  $T->pack();
  136. my $button_frame = $mw1->Frame( -borderwidth => 4 )->pack();
  137. $button_frame->Button(-text => "Salir", -padx => 30, -command => sub {exit})->pack();
  138.  
  139. close FICHERO;

(en archivo adjunto está la pantalla)

Sí, es esa la pregunta: yo quiero hacer clic en la última columna (FILE) y crear un txt, con los datos de esa fila y otros datos más. ¿Es posible? ¿O tengo que buscar otra manera?

¡Muchas gracias por la respuesta!
y disculpen mi poco conocimiento...


Adjuntos:
pantalla.png
pantalla.png [ 33.58 KiB | Visto 62 veces ]


Última edición por explorer el 2012-01-31 20:35 @899, editado 3 veces en total
Formateado de código con Perltidy y poner marcas Perl
Nota 2012-01-31 21:20 @931
Avatar de Usuario explorerDesconectado
Administrador 		Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Mensajes: 10216
Re: bind en Tk
Veo que la variable $cont no se actualiza en ningún sitio... Si tuvieras el 'use warnings;' activado, Perl te hubiera avisado del error.

Sería algo así... (no probado)

Primero, debes intercambiar las líneas 130 y 131, y hacer un cambio en una de ellas. Quedaría así:

Syntax: [ Download ] [ Hide ]
Using perl Syntax Highlighting
  1.     $tmp_label->bind('<Button-1>', [ \&sfile, $T ] );
  2.     $T->put( $i, 8, $tmp_label);

Es decir, asignamos la captura del evento a la etiqueta, y luego "metemos" la etiqueta en la tabla.

Ahora queda por definir la subrutina sfile():

Syntax: [ Download ] [ Hide ]
Using perl Syntax Highlighting
  1. sub sfile {
  2.     my ($widget, $table) = @_;                       # Recibimos el widget que generó el evento, y la tabla donde ocurrió
  3.     my ($fila, $columna) = $table->Posn( $widget );  # Posición de la celda
  4.  
  5.     #    si el usuario no puede cambiar los datos de la tabla (porque son Label), podemos guardar al archivo
  6.     #        los datos que tenemos almacenados en los array
  7.     open my $ARCHIVO, '>', 'salida.txt';
  8.     print   $ARCHIVO join "\t", $fila, $A[$fila], $B[$fila], $lat[$fila], $lon[$fila], $datos[$fila], $m1mag[$fila];
  9.     close   $ARCHIVO;
  10. }

Pero esto solo funciona si tuvieras la información de la tabla guardada en array (en varios, o más sencillo, uno bidimensional).

_________________
JF^D Perl programming

Nota 2012-02-01 09:41 @445
princiDesconectado
Perlero Nuevo 		Registrado: 2012-01-31 08:00 @375
Mensajes: 7
Re: bind en Tk
¡¡Muchas Gracias!!
Responder al tema  Página 1 de 1
  [ 5 mensajes ] 

Reglas del Foro
No puedes abrir nuevos temas en este Foro
No puedes responder a temas en este Foro
No puedes editar tus mensajes en este Foro
No puedes borrar tus mensajes en este Foro
No puedes enviar adjuntos en este Foro

Publicidad

Socializa
Síguenos por Twitter

Suscríbete GRATUITAMENTE al Boletín de Perl en Español

Saltar a:  
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
Traducción al español por Huan Manwë para phpbb-es.com
phpBB SEO