Foro - Perl en Español

La comunidad de programadores en Perl de habla hispana.

Obviar


  • Publicidad

bind en Tk

¿Apenas comienzas con Perl? En este foro podrás encontrar y hacer preguntas básicas de Perl con respuestas aptas a tu nivel.
Publicar una respuesta

bind en Tk

Notapor princi » 2012-01-31 08:27 @394

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)

Sintáxis: [ Descargar ] [ Ocultar ]
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 );
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4


¡Muchas Gracias! Espero haber sido explicita en mi duda...
¡Saludos!
princi
Perlero nuevo
Perlero nuevo
 
Mensajes: 16
Registrado: 2012-01-31 08:00 @375
Arriba

Publicidad

Re: bind en Tk

Notapor explorer » 2012-01-31 15:25 @684

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 & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: bind en Tk

Notapor princi » 2012-01-31 19:48 @867

Así es, es entorno gráfico... el código completo sería este:
Sintáxis: [ Descargar ] [ Ocultar ]
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;
Coloreado en 0.007 segundos, usando GeSHi 1.0.8.4

(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 495 veces
Última edición por explorer el 2012-01-31 20:35 @899, editado 3 veces en total
Razón: Formateado de código con Perltidy y poner marcas Perl
princi
Perlero nuevo
Perlero nuevo
 
Mensajes: 16
Registrado: 2012-01-31 08:00 @375
Arriba

Re: bind en Tk

Notapor explorer » 2012-01-31 21:20 @931

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í:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1.     $tmp_label->bind('<Button-1>', [ \&sfile, $T ] );
  2.     $T->put( $i, 8, $tmp_label);
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

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():

Sintáxis: [ Descargar ] [ Ocultar ]
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. }
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

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 & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: bind en Tk

Notapor princi » 2012-02-01 09:41 @445

¡¡Muchas Gracias!!
princi
Perlero nuevo
Perlero nuevo
 
Mensajes: 16
Registrado: 2012-01-31 08:00 @375
Arriba
Publicar una respuesta

Volver a Básico

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 7 invitados

Powered by phpBB® Forum Software © phpBB Group
Traducción al Español Mexicano por nextgen en colaboración con phpbb-es.com
phpBB SEO
Advertisements by Advertisement Management
cron