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 
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::JPEG;
use Tk::Zinc;

my $width = 300;
my $height = 150;
my $xpos = -10;
my $ypos = -10;

my $mw = MainWindow->new(-background => 'black',
                         -cursor => "top_left_arrow");
$mw->geometry($width.'x'.$height.$xpos.$ypos);
$mw->overrideredirect(1);

my ($background,$imageon,$imageoff) = get_chrome();

my $zinc = $mw->Zinc(-width => $width,
                     -height => $height,
                     -reshape => 1,     #clips zinc 
                     -fullreshape => 1,  #clips $mw and xterm 
                     -backcolor => 'black',
                       )->pack;

my $ufo = $zinc->add('curve',1,[[$width/2,0],
                                          [2*$width,0, 'c'],
                                          [2*$width,$height, 'c'],
                                  [$width/2,$height],
                                          [-$width,$height, 'c'],
                                          [-$width,0, 'c'],
                                   [$width/2,0]],
                   -tags => ['bezier1'],
                   -closed => 1,
                   -visible => 1,
           -filled => 1, 
           -fillcolor => 'black',
                   -priority => 1,     
           );


my $ufo1 = $zinc->clone($ufo);
$zinc->itemconfigure($ufo1, -tile => $background,
                           -linecolor => 'black',
                           -linewidth => 3,    
               -priority => 2,
               );

my $bgroup = $zinc->add('group', 1 , -visible => 1);

#######################################################
my $toggle0 = -1;
my $hole0 = $zinc->add('arc',$bgroup, [10,35,50,75], 
                    -visible => 0 );
                                  
my $holeid0 = $zinc->contour($ufo1, 'add',1, $hole0);  # will produce 
+a see-thru because $arc3b

my $imageid0 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [10,35],
                   -priority => 1,
                   -tags => 'button',    
                   );

$zinc->bind($imageid0,"<Button 1>", [\&sub0] );

############################################################
my $toggle1 = -1;
my $hole1 = $zinc->add('arc',$bgroup, [50,15,90,55], 
                    -visible => 0);
                                  
my $holeid1 = $zinc->contour($ufo1, 'add',1, $hole1);  
# will produce a see-thru because $arc3b
my $imageid1 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [50,15],
                   -priority => 1,
                   -tags => 'button',    
                   );

$zinc->bind($imageid1,"<Button 1>", [\&sub1] );
###############################################################
my $toggle2 = -1;
my $hole2 = $zinc->add('arc',$bgroup, [98,5,138,45], 
                    -visible => 0,
                );
                              
my $holeid2 = $zinc->contour($ufo1, 'add',1, $hole2);  
# will produce a see-thru because $arc3b
my $imageid2 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [98,5],
                   -priority => 1,
                   -tags => 'button',    
                   );

$zinc->bind($imageid2,"<Button 1>", [\&sub2] );
###############################################################
my $toggle3 = -1;
my $hole3 = $zinc->add('arc',$bgroup, [152,5,192,45], 
                    -visible => 0,
                );
                                  
my $holeid3 = $zinc->contour($ufo1, 'add',1, $hole3);  # will produce 
+a see-thru because $arc3b

my $imageid3 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [152,5],
                   -priority => 1,
                   -tags => 'button',    
                   );

$zinc->bind($imageid3,"<Button 1>", [\&sub3] );
###############################################################
my $toggle4 = -1;
my $hole4 = $zinc->add('arc',$bgroup, [200,15,240,55], 
                    -visible => 0);
                                  
my $holeid4 = $zinc->contour($ufo1, 'add',1, $hole4);  # will produce 
+a see-thru because $arc3b

my $imageid4 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [200,15],
                   -priority => 1,
                   -tags => 'button',    
                   );
$zinc->bind($imageid4,"<Button 1>", [\&sub4] );
###############################################################
my $toggle5 = -1;
my $hole5 = $zinc->add('arc',$bgroup, [245,35,285,75], 
                    -visible => 0);

my $holeid5 = $zinc->contour($ufo1, 'add',1, $hole5);  # will produce 
+a see-thru because $arc3b

my $imageid5 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [245,35],
                   -priority => 1,
                   -tags => 'button',    
                   );

$zinc->bind($imageid5,"<Button 1>", [\&sub5] );
###############################################################

$zinc->bind('button',"<Enter>", sub{
                                 $zinc->configure(-cursor => 'hand2');
                                   });

$zinc->bind('button',"<Leave>", sub{
                                $zinc->configure(-cursor => 'top_left_
+arrow');
                                    });

$mw->bind("<Button 3>",sub{Tk::exit});

# using the curve to reshape both TkZinc and Mainwindow widgets  
$zinc->itemconfigure(1, -clip => $ufo);

MainLoop;


sub sub0{
if ($toggle0 == -1){$zinc->itemconfigure($imageid0,-image => $imageon)
+}
if ($toggle0 == 1){$zinc->itemconfigure($imageid0,-image => $imageoff)
+}
$toggle0 *= -1;
print "\007";
}

sub sub1{
if ($toggle1 == -1){$zinc->itemconfigure($imageid1,-image => $imageon)
+}
if ($toggle1 == 1){$zinc->itemconfigure($imageid1,-image => $imageoff)
+}
$toggle1 *= -1;
print "\007";
}

sub sub2{
if ($toggle2 == -1){$zinc->itemconfigure($imageid2,-image => $imageon)
+}
if ($toggle2 == 1){$zinc->itemconfigure($imageid2,-image => $imageoff)
+}
$toggle2 *= -1;
print "\007";
}

sub sub3{
if ($toggle3 == -1){$zinc->itemconfigure($imageid3,-image => $imageon)
+}
if ($toggle3 == 1){$zinc->itemconfigure($imageid3,-image => $imageoff)
+}
$toggle3 *= -1;
print "\007";
}

sub sub4{
if ($toggle4 == -1){$zinc->itemconfigure($imageid4,-image => $imageon)
+}
if ($toggle4 == 1){$zinc->itemconfigure($imageid4,-image => $imageoff)
+}
$toggle4 *= -1;
print "\007";
}

sub sub5{
if ($toggle5 == -1){$zinc->itemconfigure($imageid5,-image => $imageon)
+}
if ($toggle5 == 1){$zinc->itemconfigure($imageid5,-image => $imageoff)
+}
$toggle5 *= -1;
print "\007";
}

######################################################################
+#####
sub get_chrome{

my $backphoto =
'R0lGODdhYQBSAPEAAAAAAP///7+/vwAAACwAAAAAYQBSAAAC/oRkiarrbJAEbS462ZHZR
+gxmAWR1
JRVxiZaG1betqnxiB2x/uDbffQNB+VYuXQwXc9ROHpWSc1ESbyxW0vns1WimIOoLDovH4Q
+tZbD6r
z5u2bxNop9z0Oj1uv+brc7cB/xaYA8XUhWc0xyUA2HdkZxWYlAMz9PVGEpUwQoUkBCIz+A
+CU8WlJ
xfkg5wjpAbB5anMJ5Zp5SWnkJ/ikE4pp1bLTBLLZ2dE5VQQZ22IrSYo1yhM0tMRDPSu6Su
+0bqczM
Nbqd8hq9tDuJZOxpSpKeys3UbiwR5zmzho5/+iPr0lVpCx8YQnsKHrHEDli8TALzNFL1KF
+STPUTW
pLGXKxeS/lfO8q0DCC6jw2cGITqRxgskIDnS1F18VPLKNC3yWFYDdc3Vi4z2Ekl51nKiuW
+VZbtGK
F0yIpE9YCs2cFwwkP3k4mf0I16rVrXc/J1KKclFgsZ0/g7YsR/UYmpgHB9EAdUwcrF2yhJ
+WhuC+v
n56LvvXrCNFtWFMRl6J6pygNVJdFYLGBqSrkyXC4GrHrStcLYT19/vyKqxRRZpkfHZMaWB
+AIRrvO
pPoFvbcUwruRK+HKGy1u2cY5H55eTQfTyVVbRYvl5o5o8OBjt819oXkzRYQu+WWd99d6Ol
+q0+fhm
Wbx39qOCd5YXRfg12IHgomaFC7Rjsd9K9zrHqdHoW4Cz/r4KzlyRRHLdp1BpgqDlFoLNBP
+hdc1s5
ddB42w1Rj3r1hKXHcARONtow2uC3wiGMSdHdX/up5kGFnKB4YX+HlecTeiZVJdQOvBzXGl
+MRqveb
d86x1sQIJTpURV8CfgRXaM5wRONtpxF5zTmI+EVfCDyRZNYWwAn3VISjZYGXP/4dqE5nvY
+2VXC1P
KeRYbjaiV19bdYlZVH/qNQdNa9Cs5eJzU4iH2DJFDkiifDc2qEsvczpAjgnDYdDifi++x9
+d7DJ1Z
pkxf/gkffzbGOV5T5u0zITrNlIDNdrJZ9Us2Ov0zGGocLnIPVzpqBaaYyTnIJ3gJanPYni
+tKV5kw
FzD5/ttKDwHDaZQMkgETjQupyOBySdl3J6g2QYaSpUnV59N//pAK5FEm4XohcpNRx5M1CA
+jpoFeJ
GFgOUo/KGpmVb72Kp77ngCeOkIatI11grqHqqDvr+TuJvKreGiNi5CaJKjyKUVshlVWx22
+5FiZoD
0rV2fixutVdaUyzExv4bWgVtzQTvkKhQdbBXtlZc55+HWDRSyhxSRuJsqFVKJ1s+2lpkbl
+dhiG1j
utWy6J/3algvGmYu97KJiYILm2rxMoVvbdfF1i25UeM21LC9GtykUHJKaqp8j5rxEmQD91
+VWh51d
VuBzjsSKNR+LcbV1jb6CnTO0yykL+KxSpSLXV8yJy9WitTqFDeyU3cI9tZVGcza2pmIKHK
+eTNnd1
m2XLRkHM0kSjTmBKKOoKeYBBO23p2ZJVmnhgZAl4DeNoTbwy2MUJPVuNpXaKuHKLMRyoRV
+VA27Ci
CM9Xrtpi2V3SGAvRLDuO3IdpFZh1ZNyQGiOJ9CCuyrh66fltrCSi/KlpKuxCNUQqKvxzCX
+4upylJ
Yv6CX9v2hbdvnKg0prLe3PJHFFWJ7kN5Kl/CDKOVfj1PWkrTEQJpIjEssYBaG+Ic7MalCb
+lRMIWt
8tLwElAAADs=';

my $offphoto =
'/9j/4AAQSkZJRgABAQEASABIAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UH
+RofHh0a
HBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwhMj
+IyMjIy
MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjL/wAARCAAuAC
+4DASIA
AhEBAxEB/8QAGgAAAgMBAQAAAAAAAAAAAAAAAwYFBwgCBP/EADMQAAEDAwEFBwEIAwAAAA
+AAAAEC
AwQABREGByExQVESExQiYXGBIxUWJDNDU5GxksHR/8QAFwEAAwEAAAAAAAAAAAAAAAAABA
+UGA//E
ACMRAAICAgEEAgMAAAAAAAAAAAECAAMEERIFBiExE0EiYcH/2gAMAwEAAhEDEQA/AL6kSG
+YsdyRI
dQ0y2kqWtZwEgcSTVQan2vyFKU1YuxEjE4RLea7x171baO4D1Vx38xihbYtVrXO+7rCj4e
+OlLspA
/VcVvbbPPGPMetI1st2MyZJ7ySvepSuXoOgrG64VDZjDp3TrM6zivgD2Z1L1NqaevvftC+
+lWc9rx
3dA9fIkAJosPaBqyyuBQuk4pHFE1QkoV7kjI+N9e8IGOFAkRkOoIUkHIoQZrb8iUb9s0Fd
+I53+9a
lr6H2mwNVqTBlITCuuCQ12soeA5oP+uPvT3WQ5TLtsmtvR3FNKSsKQtJwW1g5BB5VpTQOq
+RqzS7E
1zAmN/RlJAx9QcT87j80cjh15CSeTjvjWmqz2JQGp5Cpuvbotw7jcnx8IPZT/AFTTP5YqO
+2h29dk
2g3NJSQhb/i0HGMpc3nHscj4osKWh1pOFDP90DmA8gZVds2J8Tp97/kaoL1sRaXUPNgyMb
+iR/VQi
sYOK57YoTzyUJyTgdKELblGlXAlt+5B38Atq6jBp12M3VcCddo6iS2ttt3GM+Y8aQbi4ub
+IRGaOV
uKwKedlMBcuddH2N7WAhJ3jyp4cuhpliAhPMh+v2K+V+P0I87VdFuaitjVygI7VxhAgI/d
+bPFP8A
z3PWqDZekRVqQhC8oJ7bRBC0e4rYBAIwRkGq+1nsztd8UqfH/CSxvK292T1ohkDjRimjIs
+ofnWdG
UYm+YTxIxyzihGfInOd1FaW4sjgkZwOvoPWmC56QudtkKaNwjv8AYyMvMhZ5nioHpRLdo2
+43gIbf
uafDqIV3ScpT/iBisBioDuNH67lOvGLcaIt57wcQiRNe8jjqN6GknilJ5k8CeGNwznNaN2
+f6ZRpy
wIbI+q4AVE4zivLpHZ5bdPNoeKUvOkcSMjNO1EAa8CJmYseTHzP/2Q==';

my $onphoto =
'/9j/4AAQSkZJRgABAQEASABIAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UH
+RofHh0a
HBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwhMj
+IyMjIy
MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjL/wAARCAAuAC
+4DASIA
AhEBAxEB/8QAHAAAAQQDAQAAAAAAAAAAAAAABwMEBggAAQUC/8QANBAAAQIEAwUGBQQDAA
+AAAAAA
AQIDAAQFEQYSIQdBUWFxExQiMVKBFiMyM6FCYpHBcrHw/8QAFwEBAQEBAAAAAAAAAAAAAA
+AABAYF
A//EACURAAEEAQQBBAMAAAAAAAAAAAEAAgMEEQYSIcExEyIycZHR8P/aAAwDAQACEQMRAD
+8APxIS
CSbAakmBpiXa5KyKnWaG0zNdmrIudmFlMuFbwkDxOH/HrqIY7XsYKlU/Dso6UJU2HZ5aSQ
+rKT4Wg
d2bfy94HlNpCC0ioVUXVazTA0CAP0gbrcf8AZuY5yyiMZKbRoyXJNjPA8ldKa2nYunFlyW
+qsykX+
mWprfZ87FV1H3heR2w4np7wE46zOp/Uiblgws9CjQcNRDRyrNIVkbaaQnytkzfk3jSzLT7
+RbebQp
J5f9+IILpzyFvnTTS32yc/X92jPhHHdJxewoSylS862PmyjxGdI4j1J5j8RKIqa6icw1Vp
+edp76m
1trzMOA6pPpPEGLK4PxKzivDcrVGwlDihlfbB+24PqHTeORENY8PG4KZsV5K8hikGCFX7E
+766ntI
qfbXN6k6g3N7hrwpH8CHVRdVlSlN/SIa4zl10XaVUw75d9VMX/a74r/mHz7YeQFDUHUEQC
+5neFW6
b2mu8D5Z6GO01lpHMLkX39YXSwGl3TpxELsuKaN0qKTxBjCMxHCBqka0NTGttByjulQ1SM
+w6jWJh
sKnnBO1enKV8soRMpHM2B/qIjX1lqQEqBd945Anfc7olWw9q2IKw6kgthkNJUDe+VQ1jRp
+g7CorU
jmmw3HnHZwu1tiwe9VJVmvSDRcmZVHZPtJGrjV76cwSf56QJaVWu7spbmLrYBslzzKeSot
+atKVpK
VC6SLEQJMc7MJNTy6pS3+5ur1Wi10qPSESRtkGHLIp3JaknqRH9FQ1mckHU5u9ADkAf7Ea
+mK3T5H
7BLz97J3m+6yRv8AeI1O06YkHMkwzIvkeSrLTp0TYQvISM/NuBpl6XlEK3sIsq3DN9VveD
+CmAfK2
36kkc3AZz98fjHa8TT8y9OWVdVRd8DbSTfsAfNSj6tfLdvsbQeNmWF/h6g5nE2ef1UbWMc
+fAezaQ
pyUTswoPrKQrfBPSkISEpACQLACGNaGjAU7NM+Z5kkOSV//Z';

my $imageoff = $mw->Photo(-data => $offphoto);
my $imageon  = $mw->Photo(-data => $onphoto);
my $background  = $mw->Photo(-data => $backphoto);

return($background,$imageon,$imageoff);
}

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

In reply to Re^3: tk image map like button with hover effect by zentara
in thread tk image map like button with hover effect by pashanoid

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.