Creating Custom Widgets

by Steve Lidie
January 09, 2002

In this Perl/Tk article, I'll discuss balloon help, photos and widget subclassing. Help balloons can be attached to widgets, menu items, and, as we'll see here, individual canvas items. Subclassing a Perl/Tk widget is also known as creating a derived (mega) widget. For this article, I'll presume basic knowledge of mega widgets. If the subject is new to you, or if there are points you don't understand, then please read Mastering Perl/Tk, Chapter 14, Creating Custom Widgets in Pure Perl/Tk, for complete details. Photos are described in Chapter 17, Images and Animations, and balloon help is discussed in Chapter 23, Plethora of pTk Potpourri.

We are going to develop a color picker, a window that allows us to select a color that we might use to configure an application. This widget differs from most other color pickers you've seen because our palette is a box of crayons.

Tk::CrayolaCrayonColorPicker is a Tk::DialogBox-derived widget that allows a user to select a color from a photo of a box of 64 Crayola crayons. Nominally, one positions the cursor over the desired crayon and clicks button-1, whereupon the RGB values of the pixel under the cursor are returned. However, in reality, one can click anywhere over the photo.

Related Reading Mastering Perl/Tk By Steve Lidie & Nancy Walsh Full Description

Balloon help is provided, so that if the cursor lingers over a crayon, then a ballon pops up, displaying the crayon's actual color - for instance, "robin's egg blue."

Because Tk::CrayolaCrayonColorPicker is a subclass of Tk::DialogBox, the widget can have one or more buttons, with the default being a single Cancel button. This functionality is provided automatically by the superclass, Tk::DialogBox.

Our widget also overrides the Tk::DialogBox::Show() method with one of its own. We do this because, by definition, dialogs are modal, which means they perform a grab. Unfortunately, balloon help does not work with a grab in effect, so Tk::CrayolaCrayonColorPicker::Show() deiconifies the color picker window itself, waits for a color selection or a click on the Cancel button, and then hides the window.

The return value from our Show() method is either a reference to an array of three integers, the red, green and blue pixel triplet, or a string indicating which dialog button was clicked.

Here's an example, which creates the window seen in Figure 1:

    use Tk::CrayolaCrayonColorPicker;
    my $cccp = $mw->CrayolaCrayonColorPicker(-title => 'Crayon Picker');
    my $color = $cccp->Show;

    if ( ref($color) =~ /ARRAY/ ) {
        my ($r, $g, $b) = @$color;
        print "r/g/b=$r/$g/$b!\n";
    } else {
        print "no color selected, response=$color!\n";
    }

Figure 1

Notice the use of the -title option. Since Tk::CrayolaCrayonColorPicker is derived from Tk::DialogBox, it supports all the option/value pairs defined by its superclass, of which -title is one.

Now let's look at the definition of class Tk::CrayolaCrayonColorPicker. I like to place the module's version number as the first line of the file, making it easy for MakeMaker (and humans) to find it. (MakeMaker usage is also explained in Mastering Perl/Tk, Chapter 14, Creating Custom Widgets in Pure Perl/Tk.)

Next is the package definition.

Tk::widgets is a fast way to use a list of widgets. It expands to "use Tk::Widget1; use Tk::Widget2;", and so on.

The "use base" statement is important. It tells us two things: First, that we are defining a derived widget (i.e. subclassing an existing widget), and, second, the precise widget being subclassed. Including Tk::Derived in a widget's @ISA array is the telltale marker of a derived widget. Without Tk::Derived, the assumption is that we are creating a composite widget.

We then pre-declare a subroutine and enable a strict programming style.

The final statement in the module prologue actually defines the widget contructor name by modifying our symbol table, and performs other heavy magic, allowing us to use the new widget in the same manner as any other Perl/Tk widget.

$Tk::CrayolaCrayonColorPicker::VERSION = '1.0';

package Tk::CrayolaCrayonColorPicker;

use Tk::widgets qw/Balloon/;
use base        qw/Tk::Derived Tk::DialogBox/;
use subs        qw/pick_color/;

use strict;

Construct Tk::Widget 'CrayolaCrayonColorPicker';
  

A CrayolaCrayonColorPicker widget is simply a canvas with a photo of a box of Crayola crayons covering it. Since photos are objects that persist until they are destroyed, all widget instances can share the same photo. So we can create the photo from an image file once, and store its reference in a class global variable. For sizing the canvas, we keep the photo's width and height in class variables, too.

our (
     $crayons,                  # Photo of a bunch of crayons
     $cray_w,                   # Photo width
     $cray_h,                   # Photo height
);
  

As part of class initialization, Perl/Tk makes a call to the ClassInit() method. This method serves to perform tasks for the class as a whole. Here we create the photo object and define its dimensions.

sub ClassInit {

    my ($class, $mw) = @_;

    $crayons = $mw->Photo(-file => 'crayons.gif', -format => 'gif');
    ($cray_w, $cray_h) = ($crayons->width, $crayons->height);

    $class->SUPER::ClassInit($mw);

} # end ClassInit
  

The heart of a widget module is Populate(), where we create new widget instances. A CrayolaCrayonColorPicker widget consists of a canvas with a photo of a box of Crayola crayons (taken with my handy digital camera). Clicking anywhere on the photo invokes a callback that fetches the RGB components of the pixel under the click.

Additionally, transparent, trapezoidal, canvas polygons are superimposed over the tips of each crayon, and each of these items has a ballon help message associated with it. The message indicates the crayon's color.

sub Populate {

    my ($self, $args) = @_;
  

Pages: 1, 2

Next Page