The application name is Hours and the application library is the folder saving the application’s packages and required modules.
The application consists of four clickTk projects main.pl , dlg_hours.pl , dlg_new.pl and dlg_options.pl ,
A folder named demo/hours should be created in the clickTk project folder. It will save all projects of the application.
The template standard.pl may be applied as foundation of the main line.
The script main.pl requires all dialogs scripts explicitly.
The script main_logic.pl contains all application’s code which is not strictly related to Perl/Tk.

See the sketch

Content

The implementation

The application Hours consists of several files

Main.pl	main window
Dlg_hours.pl	modal dialog
Dlg_New.pl	modal dialog
Dlg_options.pl	modal dialog
Main_logic.pl	application’s logic

Csv.pm	model of CSV file
Cal.pm	do calendar calculations
ctkFile.pm	do file operations
hours.pm	generate CSV file for the given month
spreadsheed.pm	spreadsheet functions

main_logic.pl	application’s logic

Csv.pm, Cal.pm, ctkFile.pm, hours.pm and spreadsheed.pm are packages of the application.

Scripts main.pl , dlg_hours.pl , dlg_new.pl and dlg_Options.pl are fully generated by clickTk.

Script main_logic.pl and the packages are imported via property ‘application library’.

Content

Developing the application

The script dlg_hours

Enter the application’s libraries

Dialog dlg_hours belongs to the application named Hours

Content

Enter the widgets

ClickTk main windows to create and modify the dialog dlg_hours.pl

Content

The generated application

Screenshots of the running application

Content

The exported code

The main script main.pl

#!perl.exe

## ctk: description Register monthly work time, main script

## ctk: title work time

## ctk: application 'Hours' 'c:/Dokumente und Einstellungen/marco/Utilities/ClickTk/test/demo/hours'

## ctk: strict 0

## ctk: code 1

## ctk: subroutineName thisDialog

## ctk: autoExtractVariables 1

## ctk: autoExtract2Local 1

## ctk: modal 0

## ctk: isolGeom 0

## ctk: version 3.095

## ctk: onDeleteWindow sub { 1}

## ctk: Toplevel 1

## ctk: 2006 12 03 - 18:49:19

## ctk: uselib start

use lib 'c:/Dokumente und Einstellungen/marco/Utilities/ClickTk/test/demo/hours';

## ctk: uselib end

use Tk;

use Tk::Frame;

use Tk::Label;

use Tk::Menu;

use Tk::Menubutton;

$mw=MainWindow->new(-title=>'work time');

## ctk: Globalvars

use vars qw/ $activity1 $activity2 $debug $fName $from1 $from2 $jan1 $month $now $project $send $sheet $statusbar $to1 $to2 $typ $url $year/;

## ctk: Globalvars end

&main::init();

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

## ctk: instantiate and display widgets

$w_Frame_001 = $mw -> Frame ( -background , '#fbfbfb' , -relief , 'raised' ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'x', -expand=>1);

$w_Menubutton_004 = $w_Frame_001 -> Menubutton ( -background , '#ffffff' , -foreground , '#000000' , -state , 'normal' , -justify , 'left' , -relief , 'raised' , -text , 'File' ) -> pack(-side=>'left', -anchor=>'nw');

$wr_016 = $w_Frame_001 -> Menubutton ( -background , '#ffffff' , -state , 'normal' , -justify , 'left' , -text , 'Options' , -relief , 'raised' ) -> pack(-side=>'left', -anchor=>'nw');

$wr_017 = $wr_016 -> Menu ( ); $wr_016->configure(-menu=>$wr_017);

$wr_018 = $wr_017 -> command ( -label , 'Options' , -command , \&do_options );

$w_Menubutton_007 = $w_Frame_001 -> Menubutton ( -background , '#ffffff' , -foreground , '#000000' , -state , 'normal' , -justify , 'left' , -relief , 'raised' , -text , 'Help' ) -> pack(-side=>'right', -anchor=>'ne');

$w_Menu_008 = $w_Menubutton_007 -> Menu ( -background , '#ffffff' , -tearoff , 0 , -relief , 'raised' , -foreground , '#000000' ); $w_Menubutton_007->configure(-menu=>$w_Menu_008);

$w_command_009 = $w_Menu_008 -> command ( -label , 'help' , -command , \&do_help );

$w_Menu_005 = $w_Menubutton_004 -> Menu ( -background , '#ffffff' , -foreground , '#000000' , -tearoff , 0 , -relief , 'raised' ); $w_Menubutton_004->configure(-menu=>$w_Menu_005);

$wr_013 = $w_Menu_005 -> command ( -label , 'New sheet' , -command , \&do_newSheet );

$wr_014 = $w_Menu_005 -> command ( -label , 'Enter hours' , -command , \&do_enterHours );

$wr_015 = $w_Menu_005 -> command ( -label , 'save sheet' , -command , \&do_saveSheet );

$wr_019 = $w_Menu_005 -> separator ( );

$w_command_006 = $w_Menu_005 -> command ( -label , 'Exit' , -command , \&do_exit );

$w_Frame_003 = $mw -> Frame ( -background , '#f3f3f3' , -relief , 'flat' ) -> pack();

$wr_020 = $w_Frame_003 -> Label ( -background , '#0000ff' , -foreground , '#ffff00' , -justify , 'left' , -text , 'Test And Demo Application ' , -relief , 'flat' , -font , [-family,Vivaldi,-size,20,-weight,bold,-slant,roman,-underline,0 ,-overstrike,0] ) -> pack(-side=>'top', -anchor=>'nw', -pady=>10, -fill=>'both', -expand=>1, -padx=>10);

$w_Frame_002 = $mw -> Frame ( -background , '#f7f7f7' , -relief , 'ridge' ) -> pack(-side=>'bottom', -anchor=>'sw', -fill=>'x', -expand=>1);

$w_Label_010 = $w_Frame_002 -> Label ( -anchor , 'nw' , -background , '#0080ff' , -foreground , '#ffff00' , -justify , 'left' , -relief , 'flat' , -textvariable , \$statusbar ) -> pack(-side=>'left', -anchor=>'nw', -fill=>'x', -expand=>1);

## ctk: end of gened Tk-code

MainLoop;

## ctk: callbacks

sub init {

use spreadsheet;

use csv;

use hours;

use cal;

use Time::localtime;

require "main_logic.pl";

$year = $cal::year;

$jan1 = $cal::jan1;

$month = 'Januar';

$typ ='EXCEL';

$fName ="$month$year";

$from1 = 9; $from2 = 13;

$to1 = 12; $to2 = 17;

$activity1 = 'act I';

$activity2 ='act II';

$statusbar = &getDateAndTime . ' ready';

$project = 'clickTk';

$url = 'project.accounting@eds.com';

$send = 1;

return 1

}

sub do_exit {

## TODO: check if spreadsheet has been changed, and

## ask user whether to save

exit

}

sub do_help {

}

sub do_newSheet {

print "\nnewSheet";

return undef if defined $sheet;

require "dlg_New.pl";

my $ans = &newSheet($mw);

if ($ans eq 'OK') {

$sheet = hours->new(year => $year, month => $month);

$sheet->generate();

}

sub do_saveSheet {

print "\nsaveSheet";

$sheet->writeCsv(undef,$fName) if defined $sheet;

}

sub do_enterHours {

print "\nenterHours";

require "dlg_hours.pl";

&enterHours($mw) if defined $sheet;

}

sub do_options {

print "\noptions";

require "dlg_options.pl";

&options($mw);

}

## ctk: other code

## ctk: eof 2006 12 03 - 18:49:19

1; ## make perl compiler happy...

Content

The script dlg_hours.pl

## ctk: description Enter dayly hours

## ctk: title Dayly hours

## ctk: application 'Hours' 'c:/Dokumente und Einstellungen/marco/Utilities/ClickTk/test/demo/hours'

## ctk: strict 0

## ctk: code 0

## ctk: subroutineName enterHours

## ctk: autoExtractVariables 0

## ctk: autoExtract2Local 0

## ctk: modalDialogClassName DialogBox

## ctk: modal 1

## ctk: isolGeom 0

## ctk: version 3.099

## ctk: onDeleteWindow sub{1}

## ctk: Toplevel 0

## ctk: argList -title , '???'

## ctk: 2007 11 07 - 17:51:15

use Tk;

use Tk::Button;

use Tk::Entry;

use Tk::Frame;

use Tk::LabFrame;

use Tk::Label;

use Tk::Listbox;

sub enterHours {

my $hwnd = shift;

my (%args) = @_;

my $rv;

## ctk: Localvars

## ctk: Localvars end

my $mw = $hwnd->DialogBox(

-title=> (exists $args{-title})? $args{-title}:'Dayly hours',

-buttons=> (exists $args{-buttons}) ? $args{-buttons} : ['OK','Cancel']);

$mw->protocol('WM_DELETE_WINDOW',sub{1});

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

## ctk: instantiate and display widgets

$wr_001 = $mw -> Frame ( -relief , 'solid' ) -> pack(-anchor=>'nw', -side=>'left', -fill=>'both', -expand=>1);

$wr_002 = $mw -> Frame ( -relief , 'solid' ) -> pack(-anchor=>'nw', -side=>'left', -fill=>'both', -expand=>1);

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

$wr_004 = $wr_002 -> LabFrame ( -label , '1. Morning' , -labelside , 'acrosstop' ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'both', -expand=>1);

$wr_006 = $wr_002 -> LabFrame ( -label , '2. Afternoon' , -relief , 'ridge' , -labelside , 'acrosstop' ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'both', -expand=>1);

$wr_030 = $wr_002 -> Frame ( -borderwidth , 1 , -relief , 'solid' ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'both', -expand=>1);

$wr_007 = $wr_004 -> Frame ( -relief , 'solid' ) -> pack(-anchor=>'nw', -side=>'left', -fill=>'both', -expand=>1);

$wr_008 = $wr_004 -> Frame ( -relief , 'solid' ) -> pack(-anchor=>'nw', -side=>'left', -fill=>'both', -expand=>1);

$wr_032 = $wr_030 -> Button ( -background , '#ffffff' , -state , 'normal' , -relief , 'raised' , -text , 'Select' ) -> pack(-side=>'left', -anchor=>'nw', -fill=>'x', -expand=>1);

$wr_033 = $wr_030 -> Button ( -background , '#ffffff' , -state , 'normal' , -text , 'save' , -relief , 'raised' ) -> pack(-side=>'left', -anchor=>'nw', -fill=>'x', -expand=>1);

$wr_009 = $wr_006 -> Frame ( -relief , 'solid' ) -> pack(-anchor=>'nw', -side=>'left', -fill=>'both', -expand=>1);

$wr_010 = $wr_006 -> Frame ( -relief , 'solid' ) -> pack(-anchor=>'nw', -side=>'left', -fill=>'both', -expand=>1);

$wr_011 = $wr_007 -> Label ( -justify , 'left' , -text , 'From' , -relief , 'flat' ) -> pack(-side=>'top', -anchor=>'nw', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

$wr_012 = $wr_007 -> Label ( -justify , 'left' , -text , 'To' , -relief , 'flat' ) -> pack(-anchor=>'nw', -side=>'top', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

$wr_014 = $wr_008 -> Entry ( -justify , 'left' , -relief , 'sunken' , -textvariable , \$from1 , -state , 'normal' ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'x', -expand=>1);

$wr_015 = $wr_008 -> Entry ( -justify , 'left' , -relief , 'sunken' , -textvariable , \$to1 , -state , 'normal' ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'x', -expand=>1);

$wr_016 = $wr_008 -> Entry ( -justify , 'left' , -relief , 'sunken' , -textvariable , \$project , -state , 'normal' ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'x', -expand=>1);

$wr_017 = $wr_009 -> Label ( -justify , 'left' , -text , 'From' , -relief , 'flat' ) -> pack(-side=>'top', -anchor=>'nw', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

$wr_019 = $wr_009 -> Label ( -justify , 'left' , -text , 'To' , -relief , 'flat' ) -> pack(-side=>'top', -anchor=>'nw', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

$wr_021 = $wr_009 -> Label ( -justify , 'left' , -text , 'Project' , -relief , 'flat' ) -> pack(-anchor=>'nw', -side=>'top', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

$wr_023 = $wr_010 -> Entry ( -justify , 'left' , -relief , 'sunken' , -textvariable , \$from2 , -state , 'normal' ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'x', -expand=>1);

$wr_026 = $wr_010 -> Entry ( -justify , 'left' , -relief , 'sunken' , -textvariable , \$to2 , -state , 'normal' ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'x', -expand=>1);

$wr_028 = $wr_010 -> Entry ( -justify , 'left' , -relief , 'sunken' , -textvariable , \$project , -state , 'normal' ) -> pack(-anchor=>'nw', -side=>'top', -fill=>'x', -expand=>1);

$wr_022 = $wr_007 -> Label ( -justify , 'left' , -text , 'Project' , -relief , 'flat' ) -> pack(-anchor=>'nw', -side=>'top', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

$wr_024 = $wr_007 -> Label ( -justify , 'left' , -text , 'To' , -relief , 'flat' ) -> pack(-anchor=>'nw', -side=>'top', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

$wr_027 = $wr_008 -> Entry ( -justify , 'left' , -relief , 'sunken' , -textvariable , \$activity1 , -state , 'normal' ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'x', -expand=>1);

$wr_029 = $wr_009 -> Label ( -justify , 'left' , -text , 'Activities' , -relief , 'flat' ) -> pack(-anchor=>'nw', -side=>'top', -pady=>5, -fill=>'x', -expand=>1, -padx=>5);

$wr_031 = $wr_010 -> Entry ( -justify , 'left' , -relief , 'sunken' , -textvariable , \$activity2 , -state , 'normal' ) -> pack(-side=>'top', -anchor=>'nw', -fill=>'x', -expand=>1);

## ctk: end of gened Tk-code

$rv = $mw->Show();

return $rv;

} ## end of enterHours

## ctk: end of dialog code

## ctk: callbacks

sub select {

## TODO : copy data from the listbox into input variables.

}

sub save {

## TODO : copy data from the input variables into the listbox.

}

## ctk: other code

## ctk: eof 2007 11 07 - 17:51:15

1; ## make perl compiler happy...

Content

The application folder

Content