Re: tk image map like button with hover effect

It's alot simpler than you are trying to make it, but I realize you are trying to work with the tricks you are familiar with. The following code is the way to do this. In Tk ImageMap-color-zones there are more tricks shown, such as base64 encoding the images for more speed. Tk likes all it's images in base64encoded format, and uses it internally, so you can pre-prepare your images base64 encoded, and stuff them into a hash for quicker response.

There are also tag bindings which you can use on a canvas. Anyways, here is the basic code you need.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw = MainWindow->new;

my $c = $mw->Canvas(-width => 400,-height => 210,-bd => 2,-relief => '
+sunken',-background => 'black',)->pack;

my $image1 = $mw->Photo(-file => './but1.gif', -format => 'gif');
my $image2 = $mw->Photo(-file => './but2.gif', -format => 'gif');


my $but1 = $c->createImage(150, 150, -image => $image1, 
                   -anchor => 'ne', -tags => ['but1']);

$c->bind( $but1,
          '<Enter>',
           sub {
             $c->itemconfigure( $but1, -image => $image2);
            });

$c->bind( $but1,
          '<Leave>',
           sub {
             $c->itemconfigure( $but1, -image => $image1);
            });

MainLoop;
[download]

and for an example of how to use tags to raise or lower images,

#!/usr/bin/perl 
use warnings;
use strict;
use Tk;
use Tk::JPEG;
use Tk::PNG;

#demonstrates need for subwidget method
#on Scrolled Canvas, to use lower or raise

my $mw = new MainWindow;

my $canvas  = $mw->Scrolled('Canvas', 
       -bg  => 'white',
       -xscrollincrement => 1,
       -yscrollincrement => 1,
       -confine => 1,
       -scrollbars => 'se',
       -width => 200,
       -height => 200,
       -closeenough =>3,
       -scrollregion => [ 0, 0, 500, 500 ], 
)->pack(qw/ -fill both -expand 1 -side top/);


my $realcanvas = $canvas->Subwidget('scrolled');

$mw->Button(-text=>"Raise Bunny",
            -command => sub{
     # $canvas->lower( 'bunny' ,'tux' ); # will cause error
     # need subwidget of the scrolled canvas

     $realcanvas->raise( 'bunny' ,'tux' );
        })->pack();

$mw->Button(-text=>"Lower Bunny",
            -command => sub{
         $realcanvas->lower( 'bunny' ,'tux' );
        })->pack();





my $tux = $mw->Photo(-data => get_tux() );
$canvas->createImage( 0, 0, -image => $tux, 
                            -anchor => 'nw',
                -tags => ['tux'],
                 );

my $bunny = $mw->Photo(-data => get_bunny() );
$canvas->createImage( 40, 40, -image => $bunny, 
                            -anchor => 'nw',
                -tags => ['bunny'],
                 );


my $lineseg = $canvas->createLine(
         1,1,200,200, 
         -fill => 'red',
         -tags => ['line']
     );

# $canvas->lower( 'bunny' ,'tux' ); # will cause error
# need subwidget
my $realcanvas = $canvas->Subwidget('scrolled');
$realcanvas->lower( 'bunny' ,'tux' );

MainLoop;


sub get_bunny{

return  
'iVBORw0KGgoAAAANSUhEUgAAAB4AAAAjEAIAAABcJvHFAAAACXBIWXMAAAsSAAALEgHS3
+X78AAAD
F0lEQVR42u1YL+yqUBj1vfcLbhY3C44is8BIREYSG9FoNBqNkok2aFhp2BhJDWyadCZN/i
+lOGxan
jRdOuRsPxl/f+23vJKfX7x6+73znu5dK5RviV9QPDMMwDIPP7/f7/X6XTWU0Go1Go06n0+
+l0PM/z
PC91CNu2bduWZVmW5bLpjsfj8XgcBEEQBJPJZDKZZAw0n8/n8zkCGYZhGIYgCIIgFEt3OB
+wOh8OA
gKZpmqZlDDedTqfTKRnO933f95GVer1er9fz0BVFURRFxCR3QfyMQfv9fr/fDyLgOI7jON
+mo419k
JUkMBoPBYJCRNBrxdrvdbrco6qvVarVaIWdFpQO/5tIcFBbE4nQ6nU6nJIpHjlGlEklTFE
+VRFDIa
T32/3+/3+3jqHMdxHBcfB2sK6HFFURRFeb1er9crfksoNUrr0GvUfxGfnA+FmX+QALDItG
+LDA6O2
pQyCJFkPqxMDK2p9LodOAhQaLRjfoKRGo2wObl3G8PoDsA0Gb5Q5oonjfSNKTh96AOh+u9
+1ut1uS
FuZrONPJ7bJ06tA9TDDsD6QkCnDltEDRkV1Q9AnENyuk8hcyChkkcZKo5uv1er1er3S6cA
+PkFXSx
MQodPrXFg2zTEsVANhO2JNdEmVo80ub7K/lSDHPyLkNaXrVarVar2W46LMuyLFsKaZ7neZ
+4nvwFR
NGKeGjYajUajkXz9z+RLn8/n8/ms/ANIQXq5XC6Xy/v9fr/fvw3p9Xq9Xq9VVVVV9fF4PB
+6Pokhc
r9fr9Vr6s6Lf4dNpbS6/exQA3BHDt/fkPl3wwT85wlcEcrCHZyHO1tmOSl95iGLcQN80Td
+M0jTa1
LMuyLF3XdV03TdM0zWaz2Ww2Xdd1XRenDlDHgTbtvj/ykMZpDm/6LpfL5XLBmGi32+12G6
+Th5RAA
Pne73W63iwfGYFosFovF4kOZrtVqtVoN16TD4XA4HPAAKDp5yZUkSZIk1GGz2Ww2m91ut9
+vt0Mof
lcfxeDwej7PZbDaboRFbrVar1SJfIsLdYZfn8/l8Pue3y1zyiH9VAMFElb5Yp/+PcvAbH/
+25ox5S
PYYAAAAASUVORK5CYII=';
}


sub get_tux{

'/9j/4AAQSkZJRgABAQIASABIAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UH
+RofHh0a
HBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwhMj
+IyMjIy
MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjL/wAARCAA8AE
+MDASIA
AhEBAxEB/8QAHAAAAgIDAQEAAAAAAAAAAAAAAAQFBwIDCAYB/8QAMBAAAQMCBQMCBQMFAA
+AAAAAA
AQIDBAARBQYSITEHUXETYSIyQUKBFTOhI1KRscH/xAAaAQEBAQADAQAAAAAAAAAAAAAAAQ
+IDBQYE
/8QAIxEAAgEDAwQDAAAAAAAAAAAAAAECAwQREyExBRJBkVFSof/aAAwDAQACEQMRAD8Ap5
+brjgSF
uLUEgBIUomwACRb8ADwB2rCl5bymWgU8k2v2oiyPWGk/OP5oBiiilYkbEsanCJhsZ+S8r5
+Wo6CtR
97DegGqKZw3LWZpk6RDYwiY69GIS+0WiFNk8A34J+gPNaHW3GHVtPIU242opWhYsUkcgg8
+GgNa3E
Nga1AXr6CFC4NxUXKe9Z24+UbCm4CiWSD9DtQE07jmKvurdXiMrUo3Ol0pA8AbAew2FFR9
+FY0ofV
F7n8is9N2QexqPQstrCk8ipd1HqNKR3FQ6klKikixFbIS3qhcYuJ/tJ8V7LpFjWV8Pm4rh
+2aU6Yu
JMJZD11AJsoK0lSTqAJA3Haq9Ze0sutk7Ebb/WiEtpucwt9OppKwVp7i+9R8A6jVO/Ucfm
+TGMBZm
YEsxnI6npBaccdZvpeSLG4sQAFEXCQeDVV9a1uzsyJxVjBZUGO6wht5x1KbLdBVc3SSPl0
+jm/wAN
WejGn3mmpGH4Yqdh7qApp2K+gK8FKym1uOT+K8x1CzNHiZUmQMSYaRMmJ0sRQ6HFJTt8a7
+CwII2t
fgb828pa9avalyoSgmm+E91++POV6OzqWlGNPKb29FA1KQkaI4J+43qOab9V1KO53qZAsA
+BwK9Yd
YFFZBtZFwhVvFFTKGDGkpse49VPP3Cnaxct6ar8WNUELW+HEkT5bUSK0t191QQ22gXKiTY
+ACtFWR
0LQ0vqnh/qtayG3Sg2uEq9NW/wDugLEyX0XzHBw0KxDM8jDC4NRiRPj0+VXtfwD5rxHVLp
+PiOUo/
64nE14nDccCHXHEkONqPGrc3B7966qqMzBgcPMuAy8HnhRjSkaVaDYixBBHuCAfxWFTgpO
+SW7K5N
rBxFAaGlTvJ48U7Tmasrzsi5qfwmbct31NPWsHWz8qh/33BFJ1shaLs7qHiTpmwoOMRoz/
+8AUbai
IfDQB3ukEnY882322tRUE9nTMDjzjjeKS46VqKvSYkOIQm+5skKsB7DaigPF0vMVpjH32p
+ik8Q/b
R5oCPrq3ofktnL+UGsYebviOJoDhUoboa+1I87KPe47VyvHSFyWkngrAP+a71jR24kVmMy
+nS0yhL
aE9kgWAoDbRRRQFc9ZsnR8zZJkzUpAn4W2qSy59SgC60n2IF/IHvXLkVZcjpJ5GxrrzqfN
+dgdM8f
fZ06zFLXxC+yyEH+FGuQIP7Fve9AW9Iw+JIfU7h+TJaoqrFsuy1sqO290FSrb3+p7+1FQK
+HXEoAW
UuqAtrW2gqPnaivld3BPGGcmkz//2Q==';

}
[download]

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

Comment on Re: tk image map like button with hover effect Select or Download Code

Replies are listed 'Best First'.
Re^2: tk image map like button with hover effect by remiah (Hermit) on Jul 04, 2011 at 13:19 UTC
I will do like this... but Probably, I'm missing something. #!/usr/bin/perl use strict; use warnings; use Tk; my($mw,$img1,$img2,$c,$btn,$id); $mw = MainWindow->new; $c = $mw->Canvas(-width => 400,-height =>200,-background=>'black')->pa +ck; $img1=$c->Photo(-file=>'but1.gif'); $img2=$c->Photo(-file=>'but2.gif'); $btn=$c->Button( -command=>sub{exit;}, -image=>$img1)->pack; $id=$c->createWindow(200,150, -window=>$btn); $btn->bind('<Enter>', => sub{ $btn->configure(-image=>$img2);} ); $btn->bind('<Leave>', => sub{ $btn->configure(-image=>$img1);} ); MainLoop; [download]	[reply] [d/l]
Re^3: tk image map like button with hover effect by pashanoid (Scribe) on Jul 04, 2011 at 13:39 UTC
This code is very nice and simple, thank you! However, is there any way to get rid of the border that makes up the button? I like it, but the guy I'm doing this for will certainly not.	[reply]
Re^4: tk image map like button with hover effect by Tux (Canon) on Jul 04, 2011 at 14:33 UTC
Now that you have the basics, it's time to read the documentation :) $ perldoc Tk::Button BUTTON(1) User Contributed Perl Documentation B +UTTON(1) NAME Tk::Button - Create and manipulate Button widgets SYNOPSIS $button = $parent->Button(?options?); STANDARD OPTIONS -activebackground -activeforeground -anchor -background -bitmap -borderwidth -compound -cursor -disabledforeground -font -foreg +round -highlightbackground -highlightcolor -highlightthickness -image -justify -padx -pady -relief -repeatdelay -repeatinterval -take +focus -text -textvariable -underline -wraplength See Tk::options for details of the standard options. [download] `borderwidth` is described in Tk::options: `Name: activeBorderWidth Class: BorderWidth Switch: -activeborderwidth Specifies a non-negative value indicating the width of the +3-D border drawn around active elements. See above for definit +ion of active elements. The value may have any of the forms accep +table to Tk_GetPixels. This option is typically only available in w +idgets displaying more than one element at a time (e.g. menus but +not buttons).` [download] Further digging is up to you. As a side note: the book Mastering Perl/Tk is a very good reference. Learning Perl/Tk is not. Enjoy, Have FUN! H.Merijn	[reply] [d/l] [select]
Re^2: tk image map like button with hover effect by pashanoid (Scribe) on Jul 04, 2011 at 13:56 UTC
This is great! I figured out how to bind the button to a sub -- `$c->bind( $but1, '<ButtonPress>', sub { #$c->itemconfigure( $but1, -image => $image1); exit; });` [download]	[reply] [d/l]
Re^3: tk image map like button with hover effect by zentara (Cardinal) on Jul 04, 2011 at 15:09 UTC
You can also make an "action button" on a Tk canvas. Just make a slightly smaller copy of your active button, and bind ButtonPress and ButtonRelease to switch images, as was shown above. It will simulate a button press. For a pretty fancy way of doing this, using Tk::Zinc instead of the plain canvas, look at the following Read more... (17 kB) I'm not really a human, but I play one on earth. Old Perl Programmer Haiku ................... flash japh	[reply] [d/l]
Re^2: tk image map like button with hover effect by pashanoid (Scribe) on Jul 04, 2011 at 13:42 UTC
This is great! I'm already using base64 encoded images in the program, so the buttons will be an addition. In the first example, how do I make the "button" perform an action, call a sub or something?	[reply]