1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
sub edit_times{ # diese Funktion öffnet ein neues Toplevel-Widget # hier können bereits eingetragene Zeiten bearbeitet werden und # neue Tätigkeiten angelegt werde tie my @arr_data_set_timefile, 'Tie::File', $file_name_path_act_month or die $!; my @arr_ref_mlistbox_timedata = tied_times_to_2d_array_ref(\@arr_data_set_timefile); untie @arr_data_set_timefile; my $toplevel_edit_times = $mw->Toplevel( -title => 'Times in file', -background => 'white', ); $toplevel_edit_times->transient($mw); $toplevel_edit_times->focusForce(); $toplevel_edit_times->geometry('1000x500'); my $MListbox_edit_times = $toplevel_edit_times->Scrolled('MListbox', -columns=>[ [-text=>'Datum Beginn' ,-width=>14], #, -comparecommand => sub { $_[0] <=> $_[1]}], [-text=>'Uhrzeit Beginn', -width => 14], [-text=>'Projekt', , -width => 24], [-text=>'Arbeitspaket', -width=>25], [-text=>'Task', -width => 50], [-text=>'Datum Ende', -width => 14], [-text=>'Uhrzeit Ende', -width => 14],#, -comparecommand => sub { $_[0] <=> $_[1]}], ], -takefocus => 1, )->pack(-fill => 'both', -expand => 1, -side => 'top'); my $Frame_edit_times_workplace = $toplevel_edit_times->Frame()->pack(-fill=>'x', -expand=>1, -side=>'top'); my $Entry_Date = $Frame_edit_times_workplace->LabEntry(-label=>'Datum', -width=>10)->pack(-side=>'left'); my $Entry_Time_start = $Frame_edit_times_workplace->LabEntry(-label=>'Beginn', -width=>6)->pack(-side=>'left'); my $Entry_Time_stop = $Frame_edit_times_workplace->LabEntry(-label=>'Ende', -width=>6)->pack(-side=>'left'); my $JBrowseEntry_edit_times_Projects = $Frame_edit_times_workplace->JBrowseEntry( -label => 'Projekt:', -labelPack => [-side => 'top', -anchor => 'e'], -variable => \$project_selected, -state => 'normal', -choices => [@arr_projects,keys(%hoa_additionals)], -width => 12, -browsecmd => \&set_JBrowseEntry_choices, -tabcomplete => 1, )->pack( -side => 'left', -pady => '2', -anchor => 'w' ); my $JBrowseEntry_edit_times_Workpackages = $Frame_edit_times_workplace->JBrowseEntry( -label => 'Workpackage:', -labelPack => [-side => 'top', -anchor => 'e'], -variable => \$workpackage_selected, -state => 'normal', -choices => \@arr_work_packs, -width => 20, #-validate => 'focusin', #-validatecommand => \&set_JBrowseEntry_choices, )->pack( -side => 'left', -pady => '2', -anchor => 'w' ); my $Entry_Task = $Frame_edit_times_workplace->LabEntry(-label=>'Task')->pack(-fill=>'x', -expand=>1, -side=>'left'); my $Frame_edit_times_buttonmenue = $toplevel_edit_times->Frame()->pack(-fill=>'x', -expand=>1, -side=>'top'); my $Button_new_task = $Frame_edit_times_buttonmenue->Button(-text=>'add new task', -command=>\&add_new_task)->pack(-padx=>'2', -pady=>'2', -side=>'left',); my $Button_quit_edit_task = $Frame_edit_times_buttonmenue->Button(-text=>'quit', -command=>[\&quit_edit_times, \$toplevel_edit_times])->pack(-padx=>'2', -pady=>'2', -side=>'left', ); $MListbox_edit_times->bindRows("<Button-1>",\&get_mlistbox_cur_selection); fill_mlistbox(\$MListbox_edit_times); my @arr_ref_time_data; foreach my $cur_line (@arr_data_set_timefile){ print $; } my $index_cur_selection; sub get_mlistbox_cur_selection{ $index_cur_selection = $MListbox_edit_times->curselection(); # hole die Einträge der Selektion der MListbox my @arr_cur_sel = $MListbox_edit_times->getRow($index_cur_selection); # Lösche die alten Eintraege $Entry_Date->delete(0,'end'); $Entry_Time_start->delete(0,'end'); $Entry_Time_stop->delete(0,'end'); $Entry_Task->delete(0,'end'); # Trage die markierten Daten ein: $Entry_Date->insert('end',$arr_cur_sel[0]); $Entry_Time_start->insert('end',$arr_cur_sel[1]); $JBrowseEntry_edit_times_Projects->activate(get_mlistbox_choice_index(\$JBrowseEntry_edit_times_Projects,$arr_cur_sel[2])); $JBrowseEntry_edit_times_Workpackages->activate(get_mlistbox_choice_index(\$JBrowseEntry_edit_times_Workpackages,$arr_cur_sel[3])); $Entry_Task->insert('end',$arr_cur_sel[4]); $Entry_Time_stop->insert('end',$arr_cur_sel[6]); } sub add_new_task{ # übernimmt die Eingaben und hängt sie einfach an die Zeitliste an } sub fill_mlistbox{ my $listbox_widget = shift; ${$listbox_widget}->delete(0,'end'); ${$listbox_widget}->insert('end',@arr_ref_mlistbox_timedata); } sub get_mlistbox_choice_index{ # diese Funktion bekommt einen String und sucht die Index-Nummer # der Auwahl-Liste des übergebenen Stings my $ref_jbe = shift; my $string_value = shift; my $index=-1; my @arr_mlistbox_choices = ${$ref_jbe}->choices(); my $counter=0; foreach my $cur_elem (@arr_mlistbox_choices){ DEBUG "Vergleiche ".$string_value." mit ".$cur_elem."\n"." und Index ist z.Zt. ".$index; if($string_value eq $cur_elem){ $index = $counter; } $counter++; } return($index); } sub quit_edit_times{ sort @arr_data_set_timefile; untie @arr_data_set_timefile; $toplevel_edit_times->destroy if Tk::Exists($toplevel_edit_times); } }
Quotehe perl object $widget continues to exist while references to it still exist, e.g. until variable goes out of scope. However any attempt to use Tk methods on the object will fail. Exists($widget) will return false on such objects.
-command=>sub {quit_edit_times();$toplevel_edit_times->destroy;}
Guest JuergenDarf in keine "Subs" in "Subs" verwenden?
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
#!perl use strict; use warnings; use Tk; my $mw = tkinit(); my $toplevel = $mw->Toplevel(); $mw->Button(-text => 'show/hide', -command => [sub{ show_hide(@_); }, $toplevel],)->pack(); $mw->MainLoop(); sub show_hide { my $toplvl = shift; if( $toplvl->viewable ) { print "hide widget\n"; $toplvl->UnmapWindow(); }else{ print "display widget\n"; $toplvl->MapWindow(); } } # /show_hide
1 2 3
sub get_mlistbox_choice_index{ ... } ...->activate(get_mlistbox_choice_index(...));
1 2 3
my $get_mlistbox_choice_index = sub { ... } ...->activate($get_mlistbox_choice_index->(...));
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
#!/usr/local/bin/perl use strict; use warnings; use Tk; #main window my $mw = MainWindow->new(-title=>'Main Window'); create_widgets($mw); MainLoop(); sub create_toplevel_window { # create toplevel window my $top=$mw->Toplevel(-title=>"Toplevel Window"); # create toplevel frames create_widgets($top); } sub create_widgets { my $thiswindow = shift; my $frame_top = $thiswindow->Frame-> pack(-side=>'top',-fill => 'both', -anchor,'nw'); my $frame_bottom = $thiswindow->Frame-> pack(-side=>'top',-fill => 'both', -anchor,'nw'); my $edit_button = $thiswindow->Button(-text => "Create Toplevel Window",-state => 'normal',-width => 30,-activebackground=>'gray', -command => sub{create_toplevel_window()})->pack (-in => $frame_top,-side=>'top',-padx => 3,-pady => 5); my $mw_close_button = $thiswindow->Button(-text => 'Close',-background=>'gray',-width=>60,-command => sub{$thiswindow->destroy})->pack(-in=>$frame_bottom,-side => 'top',-expand => '0',-fill => 'x'); }
1
2
3
4
5
6
7
8
|-Toplevel
|- Toplevel|
| |-Toplevel|-Toplevel
| |-Toplevel
|
MainWindow|
|- Toplevel|-Toplevel
|- Toplevel
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
#!/usr/local/bin/perl use strict; use warnings; use Tk; #main window my $mw = MainWindow->new(-title=>'Main Window'); create_widgets($mw); MainLoop(); sub create_toplevel_window { my $thiswindow = shift; # create toplevel window my $top=$thiswindow->Toplevel(-title=>"Toplevel Window"); # create toplevel frames create_widgets($top); } sub create_widgets { my $thiswindow = shift; my $frame_top = $thiswindow->Frame-> pack(-side=>'top',-fill => 'both', -anchor,'nw'); my $frame_bottom = $thiswindow->Frame-> pack(-side=>'top',-fill => 'both', -anchor,'nw'); my $edit_button = $thiswindow->Button(-text => "Create Toplevel Window",-state => 'normal',-width => 30,-activebackground=>'gray', -command => sub{create_toplevel_window($thiswindow)})->pack (-in => $frame_top,-side=>'top',-padx => 3,-pady => 5); my $mw_close_button = $thiswindow->Button(-text => 'Close',-background=>'gray',-width=>60,-command => sub{$thiswindow->destroy})->pack(-in=>$frame_bottom,-side => 'top',-expand => '0',-fill => 'x'); }
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
#!/usr/local/bin/perl use strict; use warnings; use Tk; use Tk::MListbox; use Tk::DialogBox; use Tk::LabEntry; use Data::Dumper; #main window my $mw = MainWindow->new(-title=>'Main Window'); my $frame_top = $mw->Frame-> pack(-side=>'top',-fill => 'both', -anchor,'nw'); my $frame_bottom = $mw->Frame-> pack(-side=>'top',-fill => 'both', -anchor,'nw'); my $edit_button = $mw->Button(-text => "Edit Tasks",-state => 'normal',-width => 30,-activebackground=>'gray', -command => sub{edit_tasks()})->pack (-in => $frame_top,-side=>'top',-padx => 3,-pady => 5); my $mw_close_button = $mw->Button(-text => 'Close',-background=>'gray',-width=>60,-command => sub{$mw->destroy})->pack(-in=>$frame_bottom,-side => 'top',-expand => '0',-fill => 'x'); MainLoop(); sub edit_tasks { # load your data my $tasks=load_data(); # create toplevel window my $top=$mw->Toplevel(-title=>"Toplevel Window"); # create toplevel frames my $frame_top = $top->Frame-> pack(-side=>'top',-fill => 'both', -anchor,'nw'); my $frame_bottom = $top->Frame-> pack(-side=>'top',-fill => 'both', -anchor,'nw'); my $tasklist = $top->Scrolled('MListbox', -scrollbars => 'ose',-separatorcolor => 'darkgrey',-height=>15,-width=>300)->pack(-in=>$frame_top,-expand=>1,-fill=>'both'); $tasklist->columnInsert('end',-text=>'Task',-width=>15); $tasklist->columnInsert('end',-text=>'Date',-width=>15); $tasklist->columnInsert('end',-text=>'Time',-width=>15); #buttons my $add_button = $top->Button(-text => "Add Task",-state => 'normal',-width => 30,-activebackground=>'gray', -command => sub{add_task($top,\$tasks); fill_tasklist($tasklist,\$tasks);})->pack (-in => $frame_top,-side=>'top',-padx => 3,-pady => 5); my $refresh_button = $top->Button(-text => "Refresh",-state => 'normal',-width => 30,-activebackground=>'gray', -command => sub{fill_tasklist($tasklist,\$tasks);})->pack (-in => $frame_top,-side=>'top',-padx => 3,-pady => 5); my $mw_close_button = $top->Button(-text => 'Close',-background=>'gray',-width=>60,-command => sub{$top->destroy})->pack(-in=>$frame_bottom,-side => 'top',-expand => '0',-fill => 'x'); fill_tasklist($tasklist,\$tasks); } sub add_task { my $parent=shift; my $tasksref=shift; my $tasks=$$tasksref; my $ewidth=40; my $thistaskname; my $thisdate; my $thisstart; my $thisstop; my $add_dialog = $parent->DialogBox( -title => "Add task",-buttons => [ "Save", "Cancel" ] ); my $task_entry=$add_dialog->LabEntry(-label => "Task ", -bg=>'white', -labelFont => 'monospaced8', -labelPack => [-side => "left", -anchor => "w"], -width => 30, -textvariable => \$thistaskname)->pack(-side => "top", -anchor => "nw", -fill=>'x'); my $date_entry1=$add_dialog->LabEntry(-label => "Date ", -bg=>'white', -labelFont => 'monospaced8', -labelPack => [-side => "left", -anchor => "w"], -width => $ewidth, -textvariable => \$thisdate)->pack(-side => "top", -anchor => "nw", -fill=>'x'); my $time_start_entry=$add_dialog->LabEntry(-label => "Time Start ", -bg=>'white', -labelFont => 'monospaced8', -labelPack => [-side => "left", -anchor => "w"], -width => $ewidth, -textvariable => \$thisstart)->pack(-side => "top", -anchor => "nw", -fill=>'x'); my $time_stop_entry=$add_dialog->LabEntry(-label => "Time Stop ", -bg=>'white', -labelFont => 'monospaced8', -labelPack => [-side => "left", -anchor => "w"], -width => $ewidth, -textvariable => \$thisstop)->pack(-side => "top", -anchor => "nw", -fill=>'x'); $task_entry->focus; #set focus depending on type of command (add,edit) and erros (alias,user or password invalid) my $clicked_button = $add_dialog->Show; if ($clicked_button eq 'Save') { my $thistime="$thisstart\-$thisstop"; push(@{$tasks->{$thistaskname}->{$thisdate}},$thistime); } } sub fill_tasklist { my $tasklistwidget=shift; my $tasksref=shift; my $tasks=$$tasksref; $tasklistwidget->delete(0,'end'); foreach my $thistaskname (sort keys %{$tasks}) { foreach my $thisdate (sort keys %{$tasks->{$thistaskname}}) { foreach my $thistime (@{$tasks->{$thistaskname}->{$thisdate}}) { my @row; push(@row,$thistaskname); push(@row,$thisdate); push(@row,$thistime); $tasklistwidget->insert('end', [@row]); $tasklistwidget->see('end'); $tasklistwidget->update; } } } print Dumper($tasks); } sub load_data { my $tasks; my $pos= tell(DATA); while (<DATA>) { chomp $_; my @line=split(/,/,$_); my $thistaskname=$line[0]; my $thisdate=$line[1]; my $thisstart=$line[2]; my $thisstop=$line[3]; my $thistime="$thisstart\-$thisstop"; push(@{$tasks->{$thistaskname}->{$thisdate}},$thistime); } seek DATA, $pos, 0; return $tasks; } __DATA__ Task1,20110329,08:00,12:00 Task2,20110329,13:00,18:00 Task3,20110330,09:00,17:00