Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Tk photo pixel colors

by zentara (Archbishop)
on Sep 25, 2006 at 15:09 UTC ( #574745=snippet: print w/ replies, xml ) Need Help??

Description: I saw this type of app in the Gtk2 examples, and thought it would be nice to have a Tk version. It loads a bmp, gif, jpg, or png and gives the pixel position, decimal rgb color, hex rgb color, and a color swatch.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::JPEG;
use Tk::PNG;

my $file = shift || die "need a bmp, gif,jpg or png as arg 1\n";

my $mw  = Tk::MainWindow->new;

my $topframe = $mw->Frame(-bg => 'black')->pack(-fill=>'x');
my $tf1 = $topframe->Frame(-bg => 'black')->pack(-side=>'left',-fill=>
+'x');

my $xy = $tf1->Label(-text => '  X - Y  ',
                       -fg => 'hotpink',
               -bg => 'black',
                  )->pack(-side => 'top',-padx=>2);

my $rgb = $tf1->Label(-text => 'R - G - B',
                       -fg => 'hotpink',
               -bg => 'black',
                  )->pack(-side => 'top', -padx=>2);

my $hex = $tf1->Label(-text => '   HEX   ',
                       -fg => 'hotpink',
               -bg => 'black',
                  )->pack(-side => 'top',-padx=>2);

my $tf2 = $topframe->Frame(-bg => 'black')->pack(-side=>'left',-fill=>
+'x');

my $xycurrent;
my $xyr = $tf2->Label(-textvariable => \$xycurrent,
                       -fg => 'lightgreen',
               -bg => 'black',
                  )->pack(-side => 'top',-padx=>2);
my $rgbcurrent;
my $rgbr = $tf2->Label(-textvariable => \$rgbcurrent,
                       -fg => 'lightgreen',
               -bg => 'black',
                  )->pack(-side => 'top', -padx=>2);

my $hexcurrent;
my $hexr = $tf2->Label(-textvariable => \$hexcurrent,
                       -fg => 'lightgreen',
               -bg => 'black',
                  )->pack(-side => 'top',-padx=>2);

my $swatch = $topframe->Label(
                     -text => '       ',
                     -bg=>'black',
                    )->pack(-side=>'left',-fill=>'y',-pady => 5); 

my $tf3 = $mw->Frame(-bg => 'hotpink')->pack(-fill=>'x');
my $divider = $tf3->Label(
                     -text => '       ',
                     -bg=>'hotpink',
                    )->pack(-side=>'left',-fill=>'y',-pady => 1); 


my $can = $mw->Scrolled('Canvas',
                 -height => 400,
         -width  => 400,
         -scrollbars => 'osoe',
                 -highlightthickness=>0,
         -borderwidth =>0,
                 )->pack( -fill =>'both',-expand=>1);

my $realcan = $can->Subwidget('scrolled');

my $img = $mw->Photo( -file => "$file", 
              -palette => '256/256/256' );

$can->createImage(0,0,  #hardcoded offset
                  -image => $img, 
          -anchor => 'nw',
          -tags => ['img'],
           );

my @bbox = $can->bbox( 'img'  );

$can->configure(-scrollregion => [@bbox] );

$realcan->Tk::bind("<Motion>", [ \&print_xy, Ev('x'), Ev('y') ]);

$realcan->Tk::bind("<Leave>", sub{
            $xycurrent  = '';
            $rgbcurrent = '';
        $hexcurrent = '';
       });


MainLoop();
###########################################################
# a cheap hack to prevent the Tk Photo object from issuing
# an out of bounds error if the window is expanded bigger 
# than the photo
sub Tk::Error { }
#####################################################
sub print_xy {
  my ($canv, $x, $y) = @_;
  $xycurrent = $canv->canvasx($x).' - '.$canv->canvasy($y);    
 
   my($r,$g,$b) = $img->get($canv->canvasx($x), $canv->canvasy($y) );

   $rgbcurrent = sprintf('%.3d', $r).'-'.sprintf('%.3d', $g).'-'.sprin
+tf('%.3d', $b); 

  #convert to hex from decimal
   $r = sprintf('%.2x', $r);
   $g = sprintf('%.2x', $g);
   $b = sprintf('%.2x', $b);
   $hexcurrent = $r.'-'.$g.'-'.$b; 

$swatch->configure(-bg=>"#$r$g$b");

}

Comment on Tk photo pixel colors
Download Code
Re: Tk photo pixel colors
by chanio (Priest) on Nov 12, 2006 at 18:38 UTC
        Right! Very illuminating.

        Some friends used to paint complementary colors as borders of some images to make them shine!

        On the other hand, when doing this effect inside a color symphony (or color salad) the results are difficult to predict...

        Perhaps, doing a 'weird' color average of an image it could be possible to know the resulting ghost-layer's color? It is not a color competition, but a color symphony. There is taste involved. Or human perception ( or limitation of perception ). Just adding and substracting colors through all the image, I guess (not sure)...

Re: Tk photo pixel colors
by parv (Priest) on Nov 13, 2006 at 03:35 UTC
    What chanio said; ++zentara.

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://574745]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (15)
As of 2015-07-01 16:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (9 votes), past polls