#!/usr/bin/perl # http://perlmonks.org/?node_id=1213205 use strict; use warnings; use Tk; use Tk::ROText; my $mw = MainWindow->new( -bg=> "#000000", -borderwidth=> 0); $mw->geometry( '1000x600' ); my $LB = $mw->Scrolled ( 'ROText', -bg => '#C0C0C0', -fg => '#000000', -selectforeground => '#000000', -selectbackground => '#C0C0C0', -font => 'Courier 16 normal', -relief => 'groove', -cursor => 'top_left_arrow', -scrollbars => 'e', )->pack( -side => 'right', -expand => 1, -fill => 'both', ); sub selectAccount { my $this = shift; print "select: $this\n"; $LB->tagConfigure("A$_", -background => 'grey') for 1..200; $LB->tagConfigure("A$this", -background => 'yellow'); } sub markAccount { my $this = shift; print "mark: $this\n"; my $fontref = $LB->tagCget("A$this", -font); my $font = $fontref ? $$fontref : 'Courier 16 normal'; my $new = $font =~ /normal/ ? 'Courier 16 bold' : 'Courier 16 norm +al'; $LB->tagConfigure("A$this", -font => $new); } sub InitializeListBox { $LB->delete('1.0','end'); #for (my $i=1; $i<200; $i++) { for my $i (1..200) { $LB->insert('end', $i x 10, "A$i" ); $LB->tag( 'bind', "A$i", '<Button-1>' => sub { selectAccount( +$i) } ); $LB->tag( 'bind', "A$i", '<Double-1>' => sub { markAccount($i +) } ); $LB->insert('end', "\n" ); } } InitializeListBox(); MainLoop;
In reply to Re^3: problem with TK, tag, passing param with binding, destroying binds
by tybalt89
in thread problem with TK, tag, passing param with binding, destroying binds
by jsteng
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |