Tk::DoubleClick - Correctly handle single-click vs double-click events, calling only the appropriate callback for the given event.
Version 0.02
use Tk::Doubleclick;
bind_clicks(
$widget,
[ \&single_callback, @args ], # Single callback with args
\&double_callback, # Double callback without args
-delay => 500,
-button => 'right',
);
bind_clicks()
Widget to bind to mousebuttons. Typically a Tk::Button object, but could actually be almost any widget.
The callback subroutine to invoke when the event is a single-click, along with the arguments to pass. When no arguments are passed, the brackets can be omitted.
The callback subroutine to invoke when the event is a double-click, along with the arguments to pass. When no arguments are passed, the brackets can be omitted.
Maximum delay time detween clicks in milliseconds. Default is 300. If the second click of a two proximate mouse clicks occurs within the given delay time, the event is considered a double-click. If not, the two clicks are considered two separate (albeit nearly simultaneous) single-clicks.
Mouse button to bind. Options are 1, 2, 3, or the corresponding synonyms 'left', 'middle', or 'right'. The default is 1 ('left').
# Libraries
use strict;
use warnings;
use Tk;
use Tk::DoubleClick;
# User-defined
my $a_colors = [
[ '#8800FF', '#88FF88', '#88FFFF' ],
[ '#FF0000', '#FF0088', '#FF00FF' ],
[ '#FF8800', '#FF8888', '#FF88FF' ],
[ '#FFFF00', '#FFFF88', '#FFFFFF' ],
];
# Main program
my $nsingle = my $ndouble = 0;
my $mw = new MainWindow(-title => "Double-click example");
my $f1 = $mw->Frame->pack(-expand => 1, -fill => 'both');
my @args = qw( -width 12 -height 2 -relief groove -borderwidth 4 );
my @pack = qw( -side left -expand 1 -fill both );
# Display single/double click counts
my $lb1 = $f1->Label(-text => "Single Clicks", @args);
my $lb2 = $f1->Label(-textvar => \$nsingle, @args);
my $lb3 = $f1->Label(-text => "Double Clicks", @args);
my $lb4 = $f1->Label(-textvar => \$ndouble, @args);
$lb1->pack($lb2, $lb3, $lb4, @pack);
# Create button for each color, and bind single/double clicks to it
foreach my $a_color (@$a_colors) {
my $fr = $mw->Frame->pack(-expand => 1, -fill => 'both');
foreach my $bg (@$a_color) {
my $b = $fr->Button(-bg => $bg, -text => $bg, @args);
$b->pack(@pack);
bind_clicks($b, [\&single, $lb2, $bg], [\&double, $lb4, $bg]);
}
}
# Make 'Escape' quit the program
$mw->bind("<Escape>" => sub { exit });
MainLoop;
# Callbacks
sub single {
my ($lbl, $color) = @_;
$lbl->configure(-bg => $color);
++$nsingle;
}
sub double {
my ($lbl, $color) = @_;
$lbl->configure(-bg => $color);
++$ndouble;
}
Thanks to Mark Freeman for numerous great suggestions and documentation help.
John C. Norton, <jchnorton at verizon.net>
Please report any bugs or feature requests to bug-tk-doubleclick at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Tk-DoubleClick. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
You can find documentation for this module with the perldoc command.
perldoc Tk::DoubleClick
You can also look for information at:
Thanks to Mark Freeman for numerous great suggestions and documentation help.
Copyright 2009 John C. Norton.
This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
