1# -*- perl -*-
2
3#
4# Author: Slaven Rezic
5#
6# Copyright (C) 2000-2002,2010 Slaven Rezic. All rights reserved.
7#
8
9package Tk::Ruler;
10
11=head1 NAME
12
13Tk::Ruler - draw a horizontal ruler
14
15=head1 SYNOPSIS
16
17=head1 DESCRIPTION
18
19=cut
20
21use Tk qw(NORMAL_BG BLACK WHITE);
22use base qw(Tk::Frame);
23
24use strict;
25use vars qw($VERSION);
26$VERSION = 1.2;
27
28Construct Tk::Widget 'Ruler';
29
30=head1 STANDARD OPTIONS
31
32=over 4
33
34=back
35
36=head1 WIDGET-SPECIFIC OPTIONS
37
38=over 4
39
40=back
41
42=cut
43
44sub Populate {
45    my($w, $args) = @_;
46
47    if ($Tk::platform ne 'MSWin32') {
48	$args->{"-relief"} = "sunken" unless exists $args->{"-relief"};
49	# XXX -orient: horiz/vert
50	$args->{"-border"} = 2        unless exists $args->{"-border"};
51    }
52    $args->{"-height"} = 3        unless exists $args->{"-height"};
53
54    $w->SUPER::Populate($args);
55
56    if ($Tk::platform eq 'MSWin32') {
57    	#$w->packPropagate(0); # efficiency
58	$w->Label(-background => BLACK
59		  )->place(-relx => 0, -rely => 0,
60			   -relwidth => 1, -height => 1);
61	$w->Label(-background => BLACK
62		  )->place(-relx => 0, -rely => 0,
63			   -width => 1, -relheight => 1);
64	$w->Label(-background => WHITE
65		  )->place(-relx => 1, '-x' => -1, -rely => 0,
66			   -width => 1, -relheight => 1);
67	$w->Label(-background => WHITE
68		  )->place(-relx => 0, -rely => 1, '-y' => -1,
69			   -relwidth => 1, -height => 1);
70    }
71
72    $w->ConfigSpecs
73	("-padx" => ['PASSIVE', "padX", "Pad", undef],
74	 "-pady" => ['PASSIVE', "padY", "Pad", undef],
75	 "-background" => [[qw/SELF/], "background", "Background", undef],
76	);
77}
78
79=head1 METHODS
80
81=cut
82
83sub rulerGrid {
84    my($w, %args) = @_;
85    $w->grid(%args,
86#	     -sticky => "news",
87	     -sticky => "ew",
88	     (defined $w->cget(-padx) ? (-padx => $w->cget(-padx)) : ()),
89	     (defined $w->cget(-pady) ? (-pady => $w->cget(-pady)) : ()),
90	    );
91    $w->parent->gridRowconfigure
92	($args{-row},
93	 -weight => 0,
94	);
95    $w;
96}
97
98sub rulerPack {
99    my($w, %args) = @_;
100    $w->pack(%args,
101	     -fill => 'x',
102	     (defined $w->cget(-padx) ? (-padx => $w->cget(-padx)) : ()),
103	     (defined $w->cget(-pady) ? (-pady => $w->cget(-pady)) : ()),
104	    );
105}
106
1071;
108
109__END__
110
111=head1 COPYRIGHT
112
113(c) 2000-2002,2010 Slaven Rezic
114
115=cut
116