Category: Code Catacombs
Author/Contact Info Lysander
Description: This script is my first effort at using Perl. The app converts RGB codes to WWW hex codes, and vice versa. Also, it shows the resulting converted color in a frame at the bottom of the app.

This is the new and improved version of the converter with a streamlined interface (using sliders).

#!/usr/local/bin/perl -w

use strict;
use diagnostics;
use Tk;
use Tk::Dialog;

my $mw = MainWindow->new;
$mw->geometry("500x225+400+400");
$mw->minsize(qw(500 225));
$mw->maxsize(qw(500 225));
$mw->title("Color Viewer");

my $leftFrm = $mw->Frame(-width => 250,
    -height => 225,
    -borderwidth => 2,
    -relief => 'sunken')
->pack(-side => 'left', -fill => 'y');

my $rightFrm = $mw->Frame(-width => 300,
    -height => 225,
    -borderwidth => 2,
    -relief => 'sunken')
->pack(-side => 'left');

my $redscale = $leftFrm->Scale(-label => 'Red (R)',
    -orient => 'horizontal',
    -from => 0,
    -to => 255,
    -width => 10,
    -sliderlength => 15,
    -length => 200,
    -foreground => 'red',
    -command => \&rgb2hex)->pack(-side => 'top');

my $greenscale = $leftFrm->Scale(-label => 'Green (G)',
    -orient => 'horizontal',
    -from => 0,
    -to => 255,
    -width => 10,
    -sliderlength => 15,
    -length => 200,
    -foreground => 'darkgreen',
    -command => \&rgb2hex)->pack(-side => 'top');

my $bluescale = $leftFrm->Scale(-label => 'Blue (B)',
    -orient => 'horizontal',
    -from => 0,
    -to => 255,
    -width => 10,
    -sliderlength => 15,
    -length => 200,
    -foreground => 'blue',
    -command => \&rgb2hex)->pack(-side => 'top');

my $hexLabel1 = $leftFrm->Label(-text => 'WWW Hex Code',
    -pady => 8)
    ->pack(-side => 'top');

my $leftFrm1 = $leftFrm->Frame->pack(-fill => 'x');
my $hexValueEnt = $leftFrm1->Entry(-width => 10)
    ->pack(-side => 'left', pady => 2, padx => 2);
$hexValueEnt->insert(0, "#000000");

my $btnHexToRGB = $leftFrm1->Button(-text => 'Hex -> RGB',
    -activebackground => 'purple',
    -highlightbackground => 'purple',
    -command => \&hex2rgb)
->pack(-side => 'left', pady => 2, padx => 2);

# Add a dialog widget
my $dialog = $mw->Dialog;

MainLoop;

sub rgb2hex {
    my $red = $redscale->get();
    my $green = $greenscale->get();
    my $blue = $bluescale->get();

    my $color = sprintf("#%02X%02X%02X", $red, $green, $blue);
    $hexValueEnt->delete(0, 'end');
        $hexValueEnt->insert(0, $color);
    setcolor();
}

# Converts the hex value to rgb
sub hex2rgb {
    my $hex = $hexValueEnt->get();

    if ($hex =~ m/^\#[0-9a-fA-F]+$/ and length($hex) == 7) {
            my @rgb = split(//, $hex);
        
            my $red = hex($rgb[1].$rgb[2]);
            $redscale->set($red);
            
            my $green = hex($rgb[3].$rgb[4]);
            $greenscale->set($green);
            
            my $blue = hex($rgb[5].$rgb[6]);
            $bluescale->set($blue);    
            
        setcolor();
    }
    else {
        $dialog->configure(-title => 'Invalid Entry', -text => 'Invali
+d hex code value.');
        $dialog->Show;
    }
}

# Resets the background color of the bottom frame
sub setcolor {
    $rightFrm->configure(-background => $hexValueEnt->get());    
}

__DATA__

This is the original script.


#!/usr/local/bin/perl -w

use strict;
use diagnostics;
use Tk;
use Tk::Dialog;

sub rgbtohex;

# Create main window
my $mw = MainWindow->new;
$mw->geometry("250x175+400+400");
$mw->minsize(qw(250 175));
$mw->maxsize(qw(250 175));
$mw->title("Hex<-->RGB Converter");

# Create a main frame for the window.
my $mainFrame = $mw->Frame(-width => 250,
    -height => 100,
    -borderwidth => 2,
    -relief => 'raised')->pack(-side => 'top', -fill=>'x');

# Create a bottom frame to display the converted color.
my $bottomFrm = $mw->Frame(
    -width =>250,
    -height => 100,
    -borderwidth => 2,
    -relief => 'ridge',
    -background => 'black')->pack(-side => 'top');

# Add child frames to the main frame
my $leftFrm = $mainFrame->Frame(-height =>100,
    -borderwidth => 2,
    -relief => 'raised')->pack(-side => 'left', -fill=>'y');

my $midFrm = $mainFrame->Frame(-height =>100)
    ->pack(-side => 'left', -fill=>'y', -padx => 8, -pady => 8);

my $rightFrm = $mainFrame->Frame(-height =>100)
    ->pack(-side => 'left', -fill=>'y');

# Add the label and entry box for red value
my $leftFrm1 = $leftFrm->Frame->pack(-fill=>'x', pady => 4, padx => 4)
+;
my $lblRed = $leftFrm1->Label(-text => 'R:', -foreground => 'red')
    ->pack(-side => 'left');
my $redEnt = $leftFrm1->Entry(-width => 8, -background => 'white')
    ->pack(-side => 'left');
$redEnt->insert(0, 0);

# Add the label and entry box for green value
my $leftFrm2 = $leftFrm->Frame->pack(-fill=>'x', pady => 4, padx => 4)
+;
my $lblGreen = $leftFrm2->Label(-text => 'G:', -foreground => 'darkgre
+en')
    ->pack(-side => 'left');
my $greenEnt = $leftFrm2->Entry(-width => 8, -background => 'white')
    ->pack(-side => 'left');
$greenEnt->insert(0, 0);

# Add the label and entry box for blue value
my $leftFrm3 = $leftFrm->Frame->pack( -fill=>'x', pady => 4, padx => 4
+);
my $lblBlue = $leftFrm3->Label(-text => 'B:', -foreground => 'blue')
    ->pack(-side => 'left');
my $blueEnt = $leftFrm3->Entry(-width => 8, -background => 'white')
    ->pack(-side => 'left');
$blueEnt->insert(0, 0);

# Add the "convert" buttons
my $midFrm1 = $midFrm->Frame->pack(-expand => 1, -anchor => 'center');
my $convertToHex = $midFrm1->Button(-text => '>>',
    -activebackground => 'purple',
    -highlightbackground => 'purple',
    -command => \&rgb2hex)->pack;

my $convertToRGB = $midFrm1->Button(-text => '<<',
    -activebackground => 'purple',
    -highlightbackground => 'purple',
    -command => \&hex2rgb)->pack;


# Add the label and entry box for the hex value
my $lblHex = $rightFrm->Label(-text => 'Hex Code:')->pack(-side => 'le
+ft');
my $hexEnt = $rightFrm->Entry(-width => 8, 
    -background => 'white')->pack(-side => 'left');
$hexEnt->insert(0, "#000000");

# Add a dialog widget
my $dialog = $mw->Dialog;

MainLoop;

# Converts the three rgb numbers into hex
sub rgb2hex {
    my $red = $redEnt->get();
    my $green = $greenEnt->get();
    my $blue = $blueEnt->get();

    my $pattern = "^[0-9]+\$";
    my $showerror = 0;

    if (($red =~ m/$pattern/) and ($green =~ m/$pattern/) and ($blue =
+~ m/$pattern/)) {
        if(($red >= 0 and $red <= 255) and ($green >= 0 and $green <= 
+255) and ($blue >= 0 and $blue <= 255)) {
                  my $hex = sprintf("#%02X%02X%02X", $red, $green, $bl
+ue);    
                    $hexEnt->delete(0, 'end');
                    $hexEnt->insert(0, $hex);
                    setcolor();
        }
        else { $showerror = 1; }
    }
    else { $showerror = 1; }
    
    if($showerror) {
        $dialog->configure(-title => 'Invalid Entry', -text => 'Invali
+d RGB values. Each value must be between 0 and 255.');
        $dialog->Show;
    }
}

# Converts the hex value to rgb
sub hex2rgb {
    my $hex = $hexEnt->get();

    if ($hex =~ m/^\#[0-9a-fA-F]+$/ and length($hex) == 7) {
            my @rgb = split(//, $hex);
        
            my $red = hex($rgb[1].$rgb[2]);
            $redEnt->delete(0, 'end');
            $redEnt->insert(0, $red);
            
            my $green = hex($rgb[3].$rgb[4]);
            $greenEnt->delete(0, 'end');
            $greenEnt->insert(0, $green);
            
            my $blue = hex($rgb[5].$rgb[6]);
            $blueEnt->delete(0, 'end');
            $blueEnt->insert(0, $blue);    
            
            setcolor();
    }
    else {
        $dialog->configure(-title => 'Invalid Entry', -text => 'Invali
+d hex code value.');
        $dialog->Show;
    }
}

# Resets the background color of the bottom frame
sub setcolor {
    $bottomFrm->configure(-background => $hexEnt->get());    
}

__DATA__
Replies are listed 'Best First'.
( Wx::HexOrRgb ) Re: Perl/Tk rgb2hex - hex2rgb converter
by PodMaster (Abbot) on Sep 01, 2002 at 16:32 UTC
    Cheers %^D
    =head1 NAME Wx::HexOrRgb - a Wx Dialog/App for converting color from/to hex/rgb =head1 SYNOPSIS perl -MWx::HexOrRgb -e Wx::HexOrRgb::App->new()->MainLoop() # or use Wx::HexOrRgb; Wx::HexOrRgb::App->new()->MainLoop(); # or even require Wx::HexOrRgb; system $^X, $INC{'Wx/HexOrRgb.pm'}; # or the oneliner version (quotes may vary ;) perl -mWx::HexOrRgb -e"system $^X, $INC{q{Wx/HexOrRgb.pm}};" # -m is equivalent to use Wx::HexOrRgb(); in case you was wonderin +g =head1 DESCRIPTION Run it as a standalone app, or embed it easily into any wxPerl application, cause you never know when it might come in handy to convert between rgb and hex You probably got Wx::HexOrRgb from http://perlmonks.org/index.pl?node_id=194461 $Id: HexOrRgb.pm,v 0.05 2002/09/1 16:21:00 _ Exp $ =cut package Wx::HexOrRgb; use Wx qw( :everything ); use Wx::Event qw( EVT_RIGHT_DOWN EVT_SLIDER EVT_BUTTON ); use base qw( Wx::Frame ); use vars qw( $VERSION ); use strict; $VERSION = 0.05; sub new { my $class = shift; my $SIZE = [500,160]; my $self = $class->SUPER::new( undef, -1, "Wx::HexOrRgb - you know what it is ;)", [ 50, 50], $SIZE, wxSIMPLE_BORDER # as perl boo_radley's instruction | wxTHICK_FRAME # allows for resizability -- i don't want taht | wxSYSTEM_MENU | wxCAPTION | wxSYSTEM_MENU | wxMINIMIZE_BOX | wxCLIP_CHILDREN, # removes flicker (windows only) ); $self->SetIcon( Wx::GetWxPerlIcon() ); my $p = Wx::Panel->new( $self, -1, [50,50], $SIZE, ); $self->GUI($p); ## and we construct the dialog EVT_BUTTON( $self, $self->ID('HEX2RGB_BUTTON'), \&OnHEX ); EVT_RIGHT_DOWN( $self, \&OnAbout ); EVT_RIGHT_DOWN( $p, \&OnAbout ); EVT_SLIDER( $self, $self->ID('R_SLIDER'), sub { my( $self, $event ) = @_; my $pos = $event->GetInt; $self->OnRGB($pos ); }); EVT_SLIDER( $self, $self->ID('G_SLIDER'), sub { my( $self, $event ) = @_; my $pos = $event->GetInt; $self->OnRGB(undef, $pos ); }); EVT_SLIDER( $self, $self->ID('B_SLIDER'), sub { my( $self, $event ) = @_; my $pos = $event->GetInt; $self->OnRGB(undef, undef, $pos ); }); for my $key( keys %{ $self->ID() } ) { EVT_RIGHT_DOWN( $self->FindWindow( $self->ID($key) ), \&OnAbo +ut ); } my( $MainSizer ) = Wx::BoxSizer->new( Wx::wxHORIZONTAL ); $MainSizer->Add( $p, 1, wxGROW ); $self->SetSizer( $MainSizer ); $self->SetAutoLayout( 1 ); ## ;) $self->Layout(); ##force layout of the children anew $MainSizer->Fit( $self ); $MainSizer->SetSizeHints( $self ); #die Wx::GetColourFromUser( $self ); return $self; } #### THE EVENT HANDLERS sub OnRGB { my( $self, $r, $g, $b ) = @_; $r ||= $self->FindWindow( $self->ID('R_SLIDER') )->GetValue; $g ||= $self->FindWindow( $self->ID('G_SLIDER') )->GetValue; $b ||= $self->FindWindow( $self->ID('B_SLIDER') )->GetValue; my $rgb = $self->FindWindow( $self->ID('RGB_PANEL') ); $rgb->Refresh; # or Clear ;) $rgb->SetBackgroundColour( new Wx::Colour( $r, $g, $b ) ); $self->FindWindow( $self->ID('HEX_TEXT') )->SetValue( sprintf '#%02X%02X%02X', $r, $g, $b ); } sub OnHEX { my( $self, $evt ) = @_; $_ = $self->FindWindow( $self->ID('HEX_TEXT') )->GetValue; my( $r, $g, $b ) = m/\#?([a-z0-9]{2})([a-z0-9]{2})([a-z0-9]{2})/i; unless( $r and $g and $b ) { Wx::MessageBox( "Sorry mate, missing a hex value someplace. ($_) Need 6 you know.", "EEEEEEEEK! Now how'd that happen?!?!?", wxICON_ERROR | wxOK, $self, ); return(); }; for ( $r, $g, $b ) { $_ = hex $_; } $self->FindWindow( $self->ID('R_SLIDER') )->SetValue( $r ); $self->FindWindow( $self->ID('G_SLIDER') )->SetValue( $g ); $self->FindWindow( $self->ID('B_SLIDER') )->SetValue( $b ); my $rgb = $self->FindWindow( $self->ID('RGB_PANEL') ); $rgb->Refresh; # or Clear ;) $rgb->SetBackgroundColour( new Wx::Colour( $r, $g, $b ) ); } sub OnAbout { my( $self, $event ) = @_; # display a simple about box (i just keep copying and pasting this) Wx::MessageBox( qq[ ${\__PACKAGE__} $VERSION Created by podmaster of perlmonks.org fame running on wxPerl $Wx::VERSION ${\wxVERSION_STRING()} This program is released under the same terms as perl itsel +f (if you don't know what that means, visit http://perl.com ) To learn more about wxPerl visit http://wxperl.sf.net/ ], "About ${\__PACKAGE__} $VERSION", # TITLE wxOK | wxICON_INFORMATION, $self ); } ##### GGGUI GENERATORs sub BOXS { my( $self, $parent, $str, $orient ) = @_; return Wx::StaticBoxSizer->new( Wx::StaticBox->new( $parent, $self->ID(time.{}.rand), # so I can register OnAbo +ut $str, ,), $orient, ,); } sub ID { ## ALL KEYS ARE UPPERCASED my($self, $key, $dontCreate ) = @_; return $self->{"\0ID_"} if not defined $key; $self->{"\0I"} ||=6660; # the perpetual ID incrementor $key = uc($key); if(exists $self->{"\0ID_"}->{$key} ) { return $self->{"\0ID_"}->{$key}; } else { return 0 if $dontCreate; return $self->{"\0ID_"}->{$key} = ++$self->{"\0I"}; } } sub GUI { my( $self, $parent ) = @_; my $RSizer = $self->BOXS($parent, "v. Red", wxVERTICAL); my $RScroll = Wx::Slider->new( $parent, $self->ID('R_SLIDER'), 255, 0, 255, [-1,-1], [-1,-1], wxSL_HORIZONTAL | wxSL_AUTOTICKS | wxSL_LABELS # not nice imho ;( ## wxSB_HORIZONTAL ## no different thant wxSL_HORIZONTAL ); $RSizer->Add( $RScroll, 1, wxGROW | wxALIGN_CENTRE, 0); my $GSizer = $self->BOXS($parent, "v. Green", wxVERTICAL); my $GScroll = Wx::Slider->new( $parent, $self->ID('G_SLIDER'), 255, 0, 255, [-1,-1], [-1,-1], wxSL_HORIZONTAL | wxSL_AUTOTICKS | wxSL_LABELS # not nice imho ;( ); $GSizer->Add( $GScroll, 1, wxGROW | wxALIGN_CENTRE, 0); my $BSizer = $self->BOXS($parent, "v. Blue", wxVERTICAL); my $BScroll = Wx::Slider->new( $parent, $self->ID('B_SLIDER'), 255, 0, 255, [-1,-1], [-1,-1], wxSL_HORIZONTAL | wxSL_AUTOTICKS | wxSL_LABELS # not nice imho ;( ); $BSizer->Add( $BScroll, 1, wxGROW | wxALIGN_CENTRE, 0); my $Hex2RGB = Wx::Button->new( $parent, $self->ID('HEX2RGB_BUTTON'), "HEX TO RGB", wxDefaultPosition, wxDefaultSize, wxNO_BORDER ); my $HexText = Wx::TextCtrl->new( $parent, $self->ID('HEX_TEXT'), '#FFFFFF', [-1,-1], [-1,-1], ); my $StaticLine = new Wx::StaticLine( $parent, $self->ID('HEX_LINE'), [-1,-1], [-1,-1], wxLI_HORIZONTAL | wxSIMPLE_BORDER | wxCLIP_CHILDREN ); warn $_.' '.$StaticLine->GetBackgroundColour->$_ for qw/Red Green +Blue/; warn $_.' '.$StaticLine->GetForegroundColour->$_ for qw/Red Green +Blue/; $StaticLine->Show(1); # won't cut it, but a string will, imagine t +hat?? $StaticLine->Show('string'); ## the following don't do anything, WTF??? $StaticLine->Refresh(); $StaticLine->Clear(); $StaticLine->SetBackgroundColour( new Wx::Colour(0,0,255) ); # RED $StaticLine->SetForegroundColour( new Wx::Colour(0,0,255) ); warn $_.' '.$StaticLine->GetBackgroundColour->$_ for qw/Red Green +Blue/; warn $_.' '. $StaticLine->GetForegroundColour->$_ for qw/Red Green + Blue/; my $ButtonSizer = Wx::BoxSizer->new( wxHORIZONTAL ); $ButtonSizer->Add( $Hex2RGB, 0, wxCENTRE | wxALIGN_LEFT | wxALL, 5 + ); $ButtonSizer->Add( $StaticLine, 1, wxCENTRE | wxGROW, 5 ); $ButtonSizer->Add( $HexText, 0, wxCENTRE | wxALIGN_RIGHT| wxALL, 5 + ); my $RGBSizer = Wx::BoxSizer->new( wxVERTICAL ); $RGBSizer->Add( $RSizer, 1, wxGROW | wxALIGN_CENTRE, 5 ); $RGBSizer->Add( $GSizer, 1, wxGROW | wxALIGN_CENTRE, 5 ); $RGBSizer->Add( $BSizer, 1, wxGROW | wxALIGN_CENTRE, 5 ); $RGBSizer->Add( $ButtonSizer, 1, wxGROW | wxALIGN_CENTRE, 5 ); my $RGBPanel = Wx::Panel->new( $parent, $self->ID('RGB_PANEL'), [-1, -1], [100, -1], ); $RGBPanel->SetBackgroundColour( new Wx::Colour(255, 255, 255) ); # + white my $RGBPanelSizer = $self->BOXS($parent, "h. RGB", wxHORIZONTAL); $RGBPanelSizer->Add( $RGBPanel, 1, wxGROW | wxALIGN_CENTRE, 5 ); my $RootSizer = Wx::BoxSizer->new( wxHORIZONTAL ); $RootSizer->Add( $RGBSizer, 1, wxGROW | wxALIGN_CENTRE, 5 ); $RootSizer->Add( $RGBPanelSizer, 0, wxGROW | wxALIGN_CENTRE, 5 ); $parent->SetAutoLayout( 1 ); $parent->SetSizer( $RootSizer ); # $RootSizer->Fit( $parent ); # cause I don't want it fitted $RootSizer->SetSizeHints( $parent ); return $RootSizer; } package Wx::HexOrRgb::App; use strict; use Wx; use base qw(Wx::App); sub OnInit { my( $self ) = @_; my( $frame ) = new Wx::HexOrRgb(); $frame->Show(1); $frame->Refresh(); 1; } package main; # if this file is invoked directly (not use'd), run the app unless( caller() ) { Wx::HexOrRgb::App->new()->MainLoop(); } __END__ =head1 AUTHOR podmaster - http://perlmonks.org/index.pl?node=podmaster =head1 LICENSE Copyright D.H ( podmaster ) http://crazyinsomniac.perlmonk.org 2002, All rights reserved. This program is released under the same terms as perl itself (if you don't know what that means, visit http://perl.com ) =cut http://perlmonks.org/index.pl?node_id=155288;#Holy Getopt::Long, Pod:: +Usage Man!

    ____________________________________________________
    ** The Third rule of perl club is a statement of fact: pod is sexy.

      This one is a little different, and the code is a little sloppy.
      =head1 NAME Wx::HexOrRgb - a Wx Dialog/App for converting color from/to hex/rgb =head1 SYNOPSIS perl -MWx::HexOrRgb -e Wx::HexOrRgb::App->new()->MainLoop() # or use Wx::HexOrRgb; Wx::HexOrRgb::App->new()->MainLoop(); # or even require Wx::HexOrRgb; system $^X, $INC{'Wx/HexOrRgb.pm'}; # or the oneliner version (quotes may vary ;) perl -mWx::HexOrRgb -e"system $^X, $INC{q{Wx/HexOrRgb.pm}};" # -m is equivalent to use Wx::HexOrRgb(); in case you was wonderin +g =head1 DESCRIPTION Run it as a standalone app, or embed it easily into any wxPerl application, cause you never know when it might come in handy to convert between rgb and hex You probably got Wx::HexOrRgb from http://perlmonks.com/index.pl?node_id=194166 $Id: HexOrRgb.pm,v 1.6 2002/08/25 13:00:26 _ Exp $ =cut package Wx::HexOrRgb; use Wx qw( :everything ); use Wx::Event qw( EVT_RIGHT_DOWN EVT_SLIDER EVT_BUTTON ); use base qw( Wx::Frame ); use vars qw( $VERSION ); use strict; $VERSION = 1.60; sub new { my $class = shift; my $SIZE = [450,250]; my $self = $class->SUPER::new( undef, -1, "Wx::HexOrRgb - you know what it is ;)", [ 50, 50], $SIZE, wxSIMPLE_BORDER # as perl boo_radley's instruction # | wxTHICK_FRAME # allows for resizability -- i don't want tah +t | wxSYSTEM_MENU | wxCAPTION | wxSYSTEM_MENU | wxMINIMIZE_BOX | wxCLIP_CHILDREN, # removes flicker (windows only) ); $self->SetIcon( Wx::GetWxPerlIcon() ); my $p = Wx::Panel->new( $self, -1, [50,50], $SIZE, ); $self->GUI($p); ## and we construct the dialog EVT_RIGHT_DOWN( $self, \&OnAbout ); EVT_RIGHT_DOWN( $p, \&OnAbout ); EVT_BUTTON( $self, $self->ID('HEX2RGB_BUTTON'), \&OnHEX ); EVT_SLIDER( $self, $self->ID('B_SLIDER'), sub { my( $self, $event ) = @_; my $pos = $event->GetInt; $self->ThePair('B',$pos); my $BL = $self->FindWindow( $self->ID('B_LINE') ); $BL->Refresh(); $BL->SetForegroundColour( new Wx::Colour(0, 0, $pos ) ); $BL->SetBackgroundColour( new Wx::Colour(0, 0, $pos ) ); $self->OnRGB(undef, undef, $pos ); ## $event->GetPosition; # since it's not a WxScrollEvent GetInt'll do }); EVT_SLIDER( $self, $self->ID('G_SLIDER'), sub { my( $self, $event ) = @_; my $pos = $event->GetInt; $self->ThePair( 'G', $pos ); my $BL = $self->FindWindow( $self->ID('G_LINE') ); $BL->Refresh(); $BL->SetForegroundColour( new Wx::Colour(0, $pos,0 ) ); $BL->SetBackgroundColour( new Wx::Colour(0, $pos,0 ) ); $self->OnRGB(undef, undef, $pos ); ## $event->GetPosition; # since it's not a WxScrollEvent GetInt'll do }); EVT_SLIDER( $self, $self->ID('R_SLIDER'), sub { my( $self, $event ) = @_; my $pos = $event->GetInt; $self->ThePair( 'R', $pos ); my $BL = $self->FindWindow( $self->ID('R_LINE') ); $BL->Refresh(); $BL->SetForegroundColour( new Wx::Colour($pos,0,0 ) ); $BL->SetBackgroundColour( new Wx::Colour($pos,0,0 ) ); $self->OnRGB(undef, undef, $pos ); ## $event->GetPosition; # since it's not a WxScrollEvent GetInt'll do }); # use Data::Dumper; die Dumper $self->ID(); for my $key( keys %{ $self->ID() } ) { EVT_RIGHT_DOWN( $self->FindWindow( $self->ID($key) ), \&OnAbo +ut ); } my( $MainSizer ) = Wx::BoxSizer->new( Wx::wxHORIZONTAL ); $MainSizer->Add( $p, 1, wxGROW ); $self->SetSizer( $MainSizer ); $self->SetAutoLayout( 1 ); ## ;) $self->Layout(); ##force layout of the children anew $MainSizer->Fit( $self ); $MainSizer->SetSizeHints( $self ); #die Wx::GetColourFromUser( $self ); return $self; } #### util sub ThePair { my( $self, $L, $pos ) = @_; $self->FindWindow( $self->ID($L.'_DEC') )->SetValue($pos); $self->FindWindow( $self->ID($L.'_HEX') )->SetValue(sprintf('#%02X +',$pos)); $self->FindWindow( $self->ID($L.'_SLIDER') )->SetValue( $pos ); } #### THE EVENT HANDLERS sub OnHEX { my( $self, $evt ) = @_; $_ = $self->FindWindow( $self->ID('HEX_TEXT') )->GetValue; my( $r, $g, $b ) = m/\#?([a-z0-9]{2})([a-z0-9]{2})([a-z0-9]{2})/i; unless( $r and $g and $b ) { Wx::MessageBox( "Sorry mate, missing a hex value someplace. ($_) Need 6 you know.", "EEEEEEEEK! Now how'd that happen?!?!?", wxICON_ERROR | wxOK, $self, ); return(); }; # UGH, I AM LAME!!! # for ( $r, $g, $b ) { # $_ = hex $_; # } ( $r, $g, $b ) = map hex, $r, $g, $b; $self->ThePair('R', $r ); $self->ThePair('G', $g ); $self->ThePair('B', $b ); my $rgb = $self->FindWindow( $self->ID('RGB_PANEL') ); $rgb->Refresh; # or Clear ;) $rgb->SetBackgroundColour( new Wx::Colour( $r, $g, $b ) ); } sub OnRGB { my( $self, $r, $g, $b ) = @_; $r ||= $self->FindWindow( $self->ID('R_SLIDER') )->GetValue; $g ||= $self->FindWindow( $self->ID('G_SLIDER') )->GetValue; $b ||= $self->FindWindow( $self->ID('B_SLIDER') )->GetValue; my $rgb = $self->FindWindow( $self->ID('RGB_PANEL') ); $rgb->Refresh; $rgb->SetBackgroundColour( new Wx::Colour( $r, $g, $b ) ); $self->FindWindow( $self->ID('HEX_TEXT') )->SetValue( sprintf '#%02X%02X%02X', $r, $g, $b ); } sub OnAbout { my( $self, $event ) = @_; # display a simple about box (i just keep copying and pasting this) Wx::MessageBox( qq[ ${\__PACKAGE__} $VERSION Created by podmaster of perlmonks.org fame running on wxPerl $Wx::VERSION ${\wxVERSION_STRING()} This program is released under the same terms as perl itsel +f (if you don't know what that means, visit http://perl.com ) To learn more about wxPerl visit http://wxperl.sf.net/ ], "About ${\__PACKAGE__} $VERSION", # TITLE wxOK | wxICON_INFORMATION, $self ); } ##### GGGUI GENERATORs sub BOXS { my( $self, $parent, $str, $orient ) = @_; return Wx::StaticBoxSizer->new( Wx::StaticBox->new( $parent, $self->ID(time.{}.rand), # so I can register OnAbo +ut $str, ,), $orient, ,); } sub ID { ## ALL KEYS ARE UPPERCASED my($self, $key, $dontCreate ) = @_; return $self->{"\0ID_"} if not defined $key; $self->{"\0I"} ||=6660; # the perpetual ID incrementor $key = uc($key); if(exists $self->{"\0ID_"}->{$key} ) { return $self->{"\0ID_"}->{$key}; } else { return 0 if $dontCreate; return $self->{"\0ID_"}->{$key} = ++$self->{"\0I"}; } } sub BoxAndSlider { my( $self, $parent, $L ) = @_; ### THIS ONE Don't SHOW, WTF? (the "H BOY" and $BDec ) my $LSizer = Wx::BoxSizer->new( wxHORIZONTAL ); my $LDec = Wx::TextCtrl->new( $parent, $self->ID($L.'_DEC'), "255", [-1,-1], [30,-1], # 30 seems to do the job, for max 3 chars, but I don' +t know # how portable this is DAMMIT!!!!!!! wxTE_READONLY, # SetEditable(0);#) ); my $LHex = Wx::TextCtrl->new( $parent, $self->ID($L.'_HEX'), "#FF", [-1,-1], [30,-1], # 30 seems to do the job, for max 3 chars, but I don' +t know # how portable this is DAMMIT!!!!!!! wxTE_READONLY, # SetEditable(0);#) ); my $LLine = new Wx::Panel( #StaticLine( $parent, $self->ID($L.'_LINE'), [-1,-1], [250,-1], # wxLI_HORIZONTAL, ); $LLine->Refresh(); $LLine->SetBackgroundColour($parent->GetBackgroundColour); $LSizer->Add( $LDec, 0, wxALIGN_LEFT|wxRIGHT, 5 ); $LSizer->Add( $LLine, 1, wxGROW | wxCENTRE ,5 ); $LSizer->Add( $LHex, 0, wxALIGN_RIGHT|wxLEFT, 5 ); $parent->SetSizer( $LSizer ); $parent->SetAutoLayout( 1 ); $LSizer->Fit( $parent ); # cause I don't want it fit $LSizer->SetSizeHints( $parent ); return $LSizer; } sub GUI { my( $self, $parent ) = @_; my $RSizer = $self->BOXS($parent, "V Red", wxVERTICAL); my $RPanel = Wx::Panel->new( $parent, $self->ID('R_PANEL'), [-1, -1], [320, 20], ); $RPanel->SetBackgroundColour( new Wx::Colour(255, 0, 0) ); # red $self->BoxAndSlider( $RPanel, 'R' ); my $RScroll = Wx::Slider->new( $parent, $self->ID('R_SLIDER'), 255, 0, 255, [-1,-1], [335, 20], wxSL_HORIZONTAL | wxSL_AUTOTICKS ## wxSB_HORIZONTAL ## no different thant wxSL_HORIZONTAL ); $RSizer->Add( $RScroll, 0, wxALIGN_CENTRE, 0 ); $RSizer->Add( $RPanel, 0, wxALIGN_CENTRE, 0 ); my $GSizer = $self->BOXS($parent, "V Green", wxVERTICAL); my $GPanel = Wx::Panel->new( $parent, $self->ID('G_PANEL'), [-1, -1], [335, 20], ); $GPanel->SetBackgroundColour( new Wx::Colour(0, 255, 0) ); # green $self->BoxAndSlider( $GPanel, 'G' ); my $GScroll = Wx::Slider->new( $parent, $self->ID('G_SLIDER'), 255, 0, 255, [-1,-1], [335, 20], wxSL_HORIZONTAL | wxSL_AUTOTICKS ); $GSizer->Add( $GScroll, 0, wxALIGN_CENTRE, 0 ); $GSizer->Add( $GPanel, 0, wxALIGN_CENTRE, 0 ); my $BSizer = $self->BOXS($parent, "V Blue", wxVERTICAL); my $BPanel = Wx::Panel->new( $parent, $self->ID('B_PANEL'), [-1, -1], [335, 20], ); $BPanel->SetBackgroundColour( new Wx::Colour(0, 0, 255) ); # blue $self->BoxAndSlider( $BPanel, 'B' ); my $BScroll = Wx::Slider->new( $parent, $self->ID('B_SLIDER'), 255, 0, 255, [-1,-1], [335, 20], wxSL_HORIZONTAL | wxSL_AUTOTICKS # | wxSL_LABELS # not nice imho ;( ); my $Hex2RGB = Wx::Button->new( $parent, $self->ID('HEX2RGB_BUTTON'), "HEX TO RGB", wxDefaultPosition, wxDefaultSize, wxNO_BORDER ); my $HexText = Wx::TextCtrl->new( $parent, $self->ID('HEX_TEXT'), '#FFFFFF', [-1,-1], [-1,-1], ); my $StaticLine = new Wx::StaticLine( $parent, $self->ID('HEX_LINE'), [-1,-1], [150,22], wxLI_HORIZONTAL | wxSIMPLE_BORDER | wxCLIP_CHILDREN ); $StaticLine->Show('show'); # weird as hell (makes it graaaay) my $ButtonSizer = Wx::BoxSizer->new( wxHORIZONTAL ); $ButtonSizer->Add( $Hex2RGB, 0, wxCENTRE | wxALIGN_LEFT | wxALL, 5 + ); $ButtonSizer->Add( $StaticLine, 0, wxCENTRE, 5 ); $ButtonSizer->Add( $HexText, 0, wxCENTRE | wxALIGN_RIGHT| wxALL, 5 + ); $BSizer->Add( $BScroll, 0, wxALIGN_CENTRE, 0); $BSizer->Add( $BPanel, 1, wxALIGN_CENTRE, 0 ); # CHAOS my $RGBSizer = Wx::BoxSizer->new( wxVERTICAL ); $RGBSizer->Add( $RSizer, 1, wxGROW | wxALIGN_CENTRE, 5 ); $RGBSizer->Add( $GSizer, 1, wxGROW | wxALIGN_CENTRE, 5 ); $RGBSizer->Add( $BSizer, 1, wxGROW | wxALIGN_CENTRE, 5 ); $RGBSizer->Add( $ButtonSizer, 0, wxALIGN_CENTRE, 5 ); my $RGBPanel = Wx::Panel->new( $parent, $self->ID('RGB_PANEL'), [-1, -1], [100, -1], ); $RGBPanel->SetBackgroundColour( new Wx::Colour(255, 255, 255) ); # + white my $RGBPanelSizer = $self->BOXS($parent, "H RGB", wxHORIZONTAL); $RGBPanelSizer->Add( $RGBPanel, 1, wxGROW | wxALIGN_CENTRE, 5 ); my $RootSizer = Wx::BoxSizer->new( wxHORIZONTAL ); $RootSizer->Add( $RGBSizer, 1, wxGROW | wxALIGN_CENTRE, 5 ); # $RootSizer->Add( $RGBPanel, 0, wxGROW, 5 ); $RootSizer->Add( $RGBPanelSizer, 0, wxGROW | wxALIGN_CENTRE, 5 ); $parent->SetAutoLayout( 1 ); $parent->SetSizer( $RootSizer ); $RootSizer->Fit( $parent ); # cause I don't want it fit $RootSizer->SetSizeHints( $parent ); return $RootSizer; } package Wx::HexOrRgb::App; use strict; use Wx; use base qw(Wx::App); sub OnInit { my( $self ) = @_; my( $frame ) = new Wx::HexOrRgb(); $frame->Show(1); $frame->Refresh(); 1; } package main; # if this file is invoked directly (not use'd), run the app unless( caller() ) { Wx::HexOrRgb::App->new()->MainLoop(); } __END__ =head1 AUTHOR podmaster - http://perlmonks.org/index.pl?node=podmaster =head1 LICENSE Copyright D.H ( podmaster ) http://crazyinsomniac.perlmonk.org 2002, All rights reserved. This program is released under the same terms as perl itself (if you don't know what that means, visit http://perl.com ) =cut # http://perlmonks.org/index.pl?node_id=155288;#The Dynamic Duo --or-- + Holy Getopt::Long, Pod::UsageMan!

      ____________________________________________________
      ** The Third rule of perl club is a statement of fact: pod is sexy.