| 1 | |
| 2 | |
| 3 | sub mkCheck { |
| 4 | |
| 5 | # Create a top-level window that displays a bunch of check buttons. |
| 6 | |
| 7 | $mkCheck->destroy if Exists($mkCheck); |
| 8 | $mkCheck = $top->Toplevel(); |
| 9 | my $w = $mkCheck; |
| 10 | dpos $w; |
| 11 | $w->title('Checkbutton demonstration'); |
| 12 | $w->iconname('Checkbuttons'); |
| 13 | my $w_msg = $w->Message(-font => '-Adobe-times-medium-r-normal--*-180-*-*-*-*-*-*', -aspect => '300', -text => 'Three ' . |
| 14 | 'checkbuttons are displayed below. If you click on a button, it will toggle the button\'s ' . |
| 15 | 'selection state and set a Perl variable to a value indicating the state of the checkbutton. ' . |
| 16 | 'Click the "See Variables" button to see the current values of the variables. Click the "OK" ' . |
| 17 | 'button when you\'ve seen enough.'); |
| 18 | my $w_frame = $w->Frame(-borderwidth => '10'); |
| 19 | my $w_frame2 = $w->Frame(); |
| 20 | |
| 21 | my(@pl) = (-side => 'top', -fill => 'both'); |
| 22 | $w_msg->pack(@pl); |
| 23 | $w_frame->pack(@pl, -expand => 'yes'); |
| 24 | $w_frame2->pack(@pl); |
| 25 | |
| 26 | $wipers = 0 if not defined $wipers; |
| 27 | $brakes = 0 if not defined $brakes; |
| 28 | $sober = 0 if not defined $sober; |
| 29 | my $w_frame_b1 = $w_frame->Checkbutton(-text => 'Wipers OK', -variable => \$wipers, -relief => 'flat'); |
| 30 | my $w_frame_b2 = $w_frame->Checkbutton(-text => 'Brakes OK', -variable => \$brakes, -relief => 'flat'); |
| 31 | my $w_frame_b3 = $w_frame->Checkbutton(-text => 'Driver Sober', -variable => \$sober, -relief => 'flat'); |
| 32 | @pl = (-side => 'top', -pady => '2', -expand => 'yes', -anchor => 'w'); |
| 33 | $w_frame_b1->pack(@pl); |
| 34 | $w_frame_b2->pack(@pl); |
| 35 | $w_frame_b3->pack(@pl); |
| 36 | |
| 37 | my $w_frame2_ok = $w_frame2->Button(-text => 'OK', -width => 12, -command => ['destroy', $w]); |
| 38 | my $w_frame2_vars = $w_frame2->Button(-text => 'See Variables', -width => 12, |
| 39 | -command => [\&showVars, $w, 'wipers', 'brakes', 'sober']); |
| 40 | @pl = (-side => 'left', -expand => 'yes'); |
| 41 | $w_frame2_ok->pack(@pl); |
| 42 | $w_frame2_vars->pack(@pl); |
| 43 | |
| 44 | } # end mkcheck |
| 45 | |
| 46 | |
| 47 | 1; |