1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
#!/usr/bin/perl -w
# $Header: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/t/GtkColorButton.t,v 1.5 2004/03/17 03:52:24 muppetman Exp $
use Gtk2::TestHelper
tests => 8,
at_least_version => [2, 4, 0, "GtkColorButton is new in 2.4"],
;
sub color_eq {
my ($a, $b) = @_;
return $a->red == $b->red
&&
$a->green == $b->green
&&
$a->blue == $b->blue
}
my ($cbn, $color);
$cbn = Gtk2::ColorButton->new;
isa_ok ($cbn, "Gtk2::ColorButton");
$color = Gtk2::Gdk::Color->new (0, 0, 65535);
$cbn = Gtk2::ColorButton->new_with_color ($color);
isa_ok ($cbn, "Gtk2::ColorButton");
ok (color_eq ($color, $cbn->get_color));
$color = Gtk2::Gdk::Color->new (65535, 0, 0);
$cbn->set_color ($color);
ok (color_eq ($color, $cbn->get_color));
$cbn->set_alpha (32768);
is ($cbn->get_alpha, 32768);
$cbn->set_use_alpha (TRUE);
ok ($cbn->get_use_alpha);
$cbn->set_use_alpha (FALSE);
ok (!$cbn->get_use_alpha);
$cbn->set_title ("title");
is ($cbn->get_title, "title");
__END__
Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the
full list). See LICENSE for more information.
|
