in reply to ( Wx::HexOrRgb ) Re: Perl/Tk rgb2hex - hex2rgb converter
in thread Perl/Tk rgb2hex - hex2rgb converter
=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.
|
|---|