Hi,
I don't think it is available in wxPerl.
However, the default instance works and so you can use any of the
default Wx::ColourDatabase colours in a Wx::Colour constructor:
e.g.
my $colour = Wx::Colour->new('MAROON');
There's a pure perl version of ColourDatabase below that you could use,
or maybe improve. It currently doesn't handle identical colours with
different names very well.
#----------------------------------------------------------------------
package Wx::Perl::ColourDatabase;
use strict;
use Wx qw(wxNullColour);
sub new {
my $class = shift;
my $self = bless {}, $class;
$self->__init();
return $self;
}
sub AddColour {
my $self = shift;
my $name = shift;
my $col = shift;
my $colkey = $col->Red() . '-' . $col->Green() . '-' . $col->Blue();
my @RGB = split(/-/, $colkey);
if(exists($self->{__colours}->{$name})) {
# delete existing colkey
my $existingkey = join('-', @{ $self->{__colours}->{$name} });
delete($self->{__colourkeys}->{$existingkey});
}
$self->{__colourkeys}->{$colkey} = $name;
$self->{__colours}->{$name} = \@RGB;
}
sub Find {
my $self = shift;
my $name = shift;
my $colour = Wx::Colour->new(wxNullColour);
if(exists( $self->{__colours}->{$name} )) {
$colour->Set(@{ $self->{__colours}->{$name} });
}
return $colour;
}
sub FindName {
my $self = shift;
my $col = shift;
my $colname = "";
if($col->Ok()) {
my $colkey = $col->Red() . '-' . $col->Green() . '-' .
$col->Blue();
$colname = $self->{__colourkeys}->{$colkey} || "";
}
return $colname;
}
sub __init {
my $self = shift;
$self->{__colours} = {
'AQUAMARINE' => [ 112, 219, 147 ],
'BLACK' => [ 0, 0, 0 ],
'BLUE' => [ 0, 0, 255 ],
'BLUE VIOLET' => [ 159, 95, 159 ],
'BROWN' => [ 165, 42, 42 ],
'CADET BLUE' => [ 95, 159, 159 ],
'CORAL' => [ 255, 127, 0 ],
'CORNFLOWER BLUE' => [ 66, 66, 111 ],
'CYAN' => [ 0, 255, 255 ],
'DARK GREY' => [ 47, 47, 47 ],
'DARK GREEN' => [ 47, 79, 47 ],
'DARK OLIVE GREEN' => [ 79, 79, 47 ],
'DARK ORCHID' => [ 153, 50, 204 ],
'DARK SLATE BLUE' => [ 107, 35, 142 ],
'DARK SLATE GREY' => [ 47, 79, 79 ],
'DARK TURQUOISE' => [ 112, 147, 219 ],
'DIM GREY' => [ 84, 84, 84 ],
'FIREBRICK' => [ 142, 35, 35 ],
'FOREST GREEN' => [ 35, 142, 35 ],
'GOLD' => [ 204, 127, 50 ],
'GOLDENROD' => [ 219, 219, 112 ],
'GREY' => [ 128, 128, 128 ],
'GREEN' => [ 0, 255, 0 ],
'GREEN YELLOW' => [ 147, 219, 112 ],
'INDIAN RED' => [ 79, 47, 47 ],
'KHAKI' => [ 159, 159, 95 ],
'LIGHT BLUE' => [ 191, 216, 216 ],
'LIGHT GREY' => [ 192, 192, 192 ],
'LIGHT STEEL BLUE' => [ 143, 143, 188 ],
'LIME GREEN' => [ 50, 204, 50 ],
'MAGENTA' => [ 255, 0, 255 ],
'MAROON' => [ 142, 35, 107 ],
'MEDIUM AQUAMARINE' => [ 50, 204, 153 ],
'MEDIUM BLUE' => [ 50, 50, 204 ],
'MEDIUM FOREST GREEN' => [ 107, 142, 35 ],
'MEDIUM GOLDENROD' => [ 234, 234, 173 ],
'MEDIUM ORCHID' => [ 147, 112, 219 ],
'MEDIUM SEA GREEN' => [ 66, 111, 66 ],
'MEDIUM SLATE BLUE' => [ 127, 0, 255 ],
'MEDIUM SPRING GREEN' => [ 127, 255, 0 ],
'MEDIUM TURQUOISE' => [ 112, 219, 219 ],
'MEDIUM VIOLET RED' => [ 219, 112, 147 ],
'MIDNIGHT BLUE' => [ 47, 47, 79 ],
'NAVY' => [ 35, 35, 142 ],
'ORANGE' => [ 204, 50, 50 ],
'ORANGE RED' => [ 255, 0, 127 ],
'ORCHID' => [ 219, 112, 219 ],
'PALE GREEN' => [ 143, 188, 143 ],
'PINK' => [ 188, 143, 234 ],
'PLUM' => [ 234, 173, 234 ],
'PURPLE' => [ 176, 0, 255 ],
'RED' => [ 255, 0, 0 ],
'SALMON' => [ 111, 66, 66 ],
'SEA GREEN' => [ 35, 142, 107 ],
'SIENNA' => [ 142, 107, 35 ],
'SKY BLUE' => [ 50, 153, 204 ],
'SLATE BLUE' => [ 0, 127, 255 ],
'SPRING GREEN' => [ 0, 255, 127 ],
'STEEL BLUE' => [ 35, 107, 142 ],
'TAN' => [ 219, 147, 112 ],
'THISTLE' => [ 216, 191, 216 ],
'TURQUOISE' => [ 173, 234, 234 ],
'VIOLET' => [ 79, 47, 79 ],
'VIOLET RED' => [ 204, 50, 153 ],
'WHEAT' => [ 216, 216, 191 ],
'WHITE' => [ 255, 255, 255 ],
'YELLOW' => [ 255, 255, 0 ],
'YELLOW GREEN' => [ 153, 204, 50 ],
};
$self->{__colourkeys} = {};
foreach my $col (keys (%{ $self->{__colours} })) {
my $colkey = join('-', @{ $self->{__colours}->{$col} });
$self->{__colourkeys}->{$colkey} = $col;
}
}
1;
Paul Hoffman wrote:
Greetings again. I cannot figure out how to use the wxColourDatabase.
my($Table) = Wx::ColourDatabase();
yields "Error while autoloading 'Wx::ColourDatabase' at ColorPicker.pl line 45"
my($Table) = Wx::ColourDatabase->new();
yields "Can't locate object method "new" via package
"Wx::ColourDatabase" (perhaps you f
orgot to load "Wx::ColourDatabase"?) at ColorPicker.pl line 45."
I have loaded Wx and Wx::Event. Is there something else I am supposed
to add as well?
-------------------------------------------------------
This SF.net email is sponsored by: Splunk Inc. Do you grep through log files
for problems? Stop! Download the new AJAX search engine that makes
searching your log files as easy as surfing the web. DOWNLOAD SPLUNK!
http://ads.osdn.com/?ad_idv37&alloc_id865&op=click
_______________________________________________
wxperl-users mailing list
wxperl-users@xxxxxxxxxxxxxxxxxxxxx
https://lists.sourceforge.net/lists/listinfo/wxperl-users
-------------------------------------------------------
This SF.net email is sponsored by: Splunk Inc. Do you grep through log files
for problems? Stop! Download the new AJAX search engine that makes
searching your log files as easy as surfing the web. DOWNLOAD SPLUNK!
http://ads.osdn.com/?ad_id=7637&alloc_id=16865&op=click
|
