Example : composite DialogBoxX.pm

Example : composite DialogBoxX.pm 1

Screenshots 2

Properties 2

Advertise widgets 2

Run the project 3

Generated code 3

Project 3

Exported 5

Screenshots

Properties

Advertise widgets

Run the project

Generated code

Project

## ctk: description Test composite based on DialogBox

## ctk: title Extended DialogBox

## ctk: application '' ''

## ctk: strict 1

## ctk: code 3

## ctk: testCode 1

## ctk: subroutineName thisDialog

## ctk: autoExtractVariables 1

## ctk: autoExtract2Local 1

## ctk: modal 0

## ctk: buttons

## ctk: baseClass Tk::DialogBox

## ctk: isolGeom 0

## ctk: version 4.11

## ctk: onDeleteWindow sub{exit(0)}

## ctk: Toplevel 1

## ctk: argList

## ctk: treewalk D

## ctk: 2010 07 30 - 23:37:01

## ctk: uselib start

## ctk: uselib end

use strict;

use Tk;

use Tk::Button;

use Tk::Listbox;

my $mw=MainWindow->new(-title=>'Extended DialogBox');

package DialogBoxX;

use vars qw($VERSION);

$VERSION = '1.01';

require Tk::DialogBox;

require Tk::Derived;

@DialogBoxX::ISA = qw(Tk::Derived Tk::DialogBox);

Construct Tk::Widget 'DialogBoxX';

## ctk: Globalvars

my ($xyz);

## ctk: Globalvars end

sub ClassInit {

my $self = shift;

##

## init class

##

$self->SUPER::ClassInit(@_);

}

sub Populate {

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

##

## ctk: Localvars

## ctk: Localvars end

## move args to local variables)

##

$self->SUPER::Populate($self->arglist($args));

##

##

my $mw = $self;

## ctk: code generated by ctk_w version '4.11'

## ctk: lexically scoped variables for widgets

my (

$wr_001,

$wr_002

);

## ctk: instantiate and display widgets

## ctk: widgets generated using treewalk D

$wr_001 = $mw -> Listbox ( -background , '#ffffff' , -selectmode , 'single' , -relief , 'sunken' ) -> pack(-anchor=>'nw', -side=>'top', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

$wr_002 = $mw -> Button ( -background , '#ffffff' , -command , sub{1} , -state , 'normal' , -text , 'Test' ) -> pack(-anchor=>'nw', -side=>'top', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

## ctk: end of gened Tk-code

## ctk: public subwidgets

$self->Advertise('List'=>$wr_001);

$self->Advertise('Test'=>$wr_002);

## ctk: public subwidgets end

## ctkTargetComposite->ConfigSpecs();

## $self->Delegates(); (optional)

return $self;

}

## ctk: methods

sub arglist {

my $self = shift;

my ($args) = @_;

## no arguments

return $args

}

sub _show {

my $rv = shift->Show();

return $rv

}

## ctk: methods end

## ctk: testCode

# -----------------------------------------------

##

package main;

&main::init();

my (%args) =();

my $instance = $mw->DialogBoxX(%args);

$instance->protocol('WM_DELETE_WINDOW',sub{exit(0)});

&main::test_01($instance);

MainLoop;

##

## ctk: testCode end

## ctk: callbacks

sub init { 1 }

sub test_01 {

shift->_show()

}

## ctk: other code

## ctk: eof 2010 07 30 - 23:37:01

1; ## make perl compiler happy...

Exported

## ctk: description Test composite based on DialogBox

## ctk: title Extended DialogBox

## ctk: application '' ''

## ctk: strict 1

## ctk: code 3

## ctk: testCode 0

## ctk: subroutineName thisDialog

## ctk: autoExtractVariables 1

## ctk: autoExtract2Local 1

## ctk: modal 0

## ctk: buttons

## ctk: baseClass Tk::DialogBox

## ctk: isolGeom 0

## ctk: version 4.11

## ctk: onDeleteWindow sub{exit(0)}

## ctk: Toplevel 1

## ctk: argList

## ctk: treewalk D

## ctk: 2010 07 30 - 23:49:07

use strict;

use Tk;

use Tk::Button;

use Tk::Listbox;

package DialogBoxX;

use vars qw($VERSION);

$VERSION = '1.01';

require Tk::DialogBox;

require Tk::Derived;

@DialogBoxX::ISA = qw(Tk::Derived Tk::DialogBox);

Construct Tk::Widget 'DialogBoxX';

## ctk: Globalvars

my ($xyz);

## ctk: Globalvars end

sub ClassInit {

my $self = shift;

##

## init class

##

$self->SUPER::ClassInit(@_);

}

sub Populate {

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

##

## ctk: Localvars

## ctk: Localvars end

## move args to local variables)

##

$self->SUPER::Populate($self->arglist($args));

##

##

my $mw = $self;

## ctk: code generated by ctk_w version '4.11'

## ctk: lexically scoped variables for widgets

my (

$wr_001,

$wr_002

);

## ctk: instantiate and display widgets

## ctk: widgets generated using treewalk D

$wr_001 = $mw -> Listbox ( -background , '#ffffff' , -selectmode , 'single' , -relief , 'sunken' ) -> pack(-side=>'top', -anchor=>'nw', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

$wr_002 = $mw -> Button ( -background , '#ffffff' , -command , sub{1} , -state , 'normal' , -text , 'Test' ) -> pack(-side=>'top', -anchor=>'nw', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

## ctk: end of gened Tk-code

## ctk: public subwidgets

$self->Advertise('List'=>$wr_001);

$self->Advertise('Test'=>$wr_002);

## ctk: public subwidgets end

## ctkTargetComposite->ConfigSpecs();

## $self->Delegates(); (optional)

return $self;

}

## ctk: methods

sub arglist {

my $self = shift;

my ($args) = @_;

## no arguments

return $args

}

sub _show {

my $rv = shift->Show();

return $rv

}

## ctk: methods end

## ctk: other code

## ctk: eof 2010 07 30 - 23:49:07

1; ## make perl compiler happy...