Hi to all,

I whish to builda "PixelCOlor" function based on WxPerl.
I have used a sample from Matti Barbon and tweaked it.
So far I have a working hack. When I click into the window I get the positon 
and a Wx::Colur Object.

Output:
Position: 152 375 
Color: Wx::Colour=SCALAR(0xa09ca0)

Questions:
- What is needed to get the RBB or RGBA vaulues for this pixel.
- Is there a way to click outside the "window" - anywhere on the screen - and 
get the pixel color?

Help and hints are welcome.
Greetings Alexander

#! /Users/ademmler/Library/perl/bin/perl -w

#############################################################################
## Name:        samples/hello/hello.pl
## Purpose:     Hello wxPerl sample
## Author:      Mattia Barbon
## Modified by:
## Created:     02/11/2000
## RCS-ID:      $Id: hello.pl,v 1.3 2004/10/19 20:28:14 mbarbon Exp $
## Copyright:   (c) 2000 Mattia Barbon
## Licence:     This program is free software; you can redistribute it and/or
##              modify it under the same terms as Perl itself
#############################################################################

use strict;
use Wx;

# every program must have a Wx::App-derive class
package MyApp;

use vars qw(@ISA);
use Data::Dumper;

@ISA = qw(Wx::App);

# this is called automatically on object creation
sub OnInit {
  my( $this ) = shift;

  # create a new frame
  my( $frame ) = MyFrame->new();

  # set as top frame
  $this->SetTopWindow( $frame );
  # show it
  $frame->Show( 1 );
}

package MyFrame;

use vars qw(@ISA);

@ISA = qw(Wx::Frame);

use Wx::Event qw(EVT_PAINT EVT_LEFT_UP);
# this imports some constants
use Wx qw(wxDECORATIVE wxNORMAL wxBOLD);
use Wx qw(wxDefaultPosition);
use Wx qw(wxWHITE);
use Wx qw( wxGREEN_BRUSH wxRED_BRUSH wxBLUE_BRUSH wxBLACK_BRUSH);

our $dc;

sub new {
  # new frame with no parent, id -1, title 'Hello, world!'
  # default position and size 350, 100
  my( $this ) = shift->SUPER::new( undef, -1, 'Hello, world!',
                                   wxDefaultPosition , [350, 450] );

  # create a new font object and store it
  $this->{FONT} = Wx::Font->new(24, wxDECORATIVE, wxNORMAL, wxBOLD, 0 );
  # set background colour
  $this->SetBackgroundColour( wxWHITE );

  $this->SetIcon( Wx::GetWxPerlIcon() );

  # declare that all paint events will be handled with the OnPaint method
  EVT_PAINT( $this, \&OnPaint );
  EVT_LEFT_UP($this, \&GetPixel);
  
  return $this;
}

sub OnPaint {
  my( $this, $event ) = @_;
  # create a device context (DC) used for drawing
  #my( $dc ) = Wx::PaintDC->new( $this );
  $dc = Wx::PaintDC->new( $this );
  
  # select the font
  $dc->SetFont( $this->font );
  # darw a friendly message
  $dc->DrawText( 'Click to get the color value!', 10, 10 );
  
  #$dc->SetPen( wxGREEN_PEN );
  $dc->SetBrush( wxGREEN_BRUSH );
  $dc->DrawRectangle(50,100,100, 100);	

  $dc->SetBrush( wxRED_BRUSH );
  $dc->DrawRectangle(200,100,100, 100);		

  $dc->SetBrush( wxBLUE_BRUSH );
  $dc->DrawRectangle(50,250,100, 100);		

  $dc->SetBrush( wxBLACK_BRUSH );
  $dc->DrawRectangle(200,250,100, 100);		

}

sub GetPixel {
	my ($this, $event) = @_;

    my $position = Wx::GetMousePosition->new;		
	my $m = Wx::MouseEvent->new;
	my $x = $event->GetX; 
	my $y = $event->GetY;		
	print "Position: $x $y \n"; 
	
	my $color = Wx::DC::GetPixel($dc, $x, $y);
	print "Color: $color\n";
}
		
sub font {
  $_[0]->{FONT};
}

package main;

# create an instance of the Wx::App-derived class
my( $app ) = MyApp->new();
# start processing events
$app->MainLoop();

# Local variables: #
# mode: cperl #
# End: #

Reply via email to