ctkDialogBox

        Standard DialogBox for clickTk scripts and modules.
        It behaves like Tk::Dialogbox. Additionally it edits
        the title option's value adding the standard clickTk prefix.

Syntax

                use ctkDialogBox;

                my $dlg = $mw->ctkDialogBox(<options>);         ## same options as Tk::DialogBox

                $dlg->WidgetClass(<options>)->pack()
                my $ans = $dlg->Show();

Programming notes

Base class

        Tk::DialogBox

Globals

        - It uses main::ctkTitle to import the standard title prefix.

Class data

        clipboard content (array of items)

Member data

        See Tk::DialogBox

Properties

        None.

Methods

        _title   return the standard title for toplevel.

                 clickTk - <caller's title>

Maintenance

        Author: Marco
        date:   17.04.2007
        History 
                        17.04.2007 MO03301 mam First draft
                        14.03.2008 version 1.02 (unix port)
=cut

## ctk: description Standard clickTk DialogBox ## ctk: title Standard Dialogbox ## ctk: application '' '' ## ctk: strict 0 ## ctk: code 3 ## ctk: subroutineName thisDialog ## ctk: autoExtractVariables 1 ## ctk: autoExtract2Local 1 ## ctk: modal 0 ## ctk: baseClass Tk::DialogBox ## ctk: isolGeom 0 ## ctk: version 3.099 ## ctk: onDeleteWindow sub{exit(0)} ## ctk: Toplevel 1 ## ctk: argList -title , Test ## ctk: 2007 04 17 - 16:58:19

use Tk;

package ctkDialogBox; use vars qw($VERSION); $VERSION = '1.03'; require Tk::DialogBox; require Tk::Derived; ##@ctkDialogBox::ISA = qw(Tk::Derived Tk::DialogBox); @ctkDialogBox::ISA = qw(Tk::DialogBox); Construct Tk::Widget 'ctkDialogBox'; ## ctk: Globalvars ## ctk: Globalvars end sub ClassInit { my $self = shift; ## ## init class ## $self->SUPER::ClassInit(@_);

} sub Populate { my ($self,$args) = @_; my $text = delete $args->{-text} if exists $args->{-text}; ## i MO03601 my $bitmap = delete $args->{-bitmap} if exists $args->{-bitmap}; ## i MO03601 $args->{-title} = $self->_title($args->{-title}); $args->{-buttons} = [qw (Ok Cancel)] unless(exists $args->{-buttons}); $self->SUPER::Populate($args); ## ## set up ConfigSpecs (optional) unless(defined $self->Subwidget('message')) { my $message = $self->Label(-text => $text, -relief , 'flat')->pack(-padx => 20, -pady => 20, -fill => 'x', -expand => 1); $self->Advertise('message' => $message); } # my $mw = $self; ## ctk: code generated by ctk_w version '3.099' ## ctk: instantiate and display widgets

## ctk: end of gened Tk-code

        return $self;
        }
        ## ctk: methods
        sub _title {
        my $self = shift;
        my ($title) = @_;
        $title = &main::ctkTitle." - ". $title unless ($title =~ /^\w+\s+-\s+/) ;
        return $title
        }
        ## ctk: methods end
        ## ctk: other code
        ## ctk: eof 2007 04 17 - 16:58:19
        1;      ## make perl compiler happy...

Back to index