view release on metacpan or  search on metacpan

Tk/Application.pm  view on Meta::CPAN

  $self->{TW}->messageBox(
			  -message => shift,
			  -icon => shift || 'error', 
			  -type => shift || 'OK',
			  -title => shift || $self->{TITLE},
			 );   
}

###########################################################
sub ErrorMsgBox {
  my $self = shift;
  $self->MsgBox(shift,'error','OK');
}

###########################################################
sub InfoMsgBox {
  my $self = shift;
  $self->MsgBox(shift,'info','OK');
}

###########################################################
sub attach_balloon {
  my $self = shift;
  my $obj  = shift || return;
  $self->{BALLOON}->attach($obj,
			   -msg => shift,
			   -statusmsg => shift,  
			   );
}

###########################################################
sub SimpleDialog {
  my $self = shift;
  my %opts = @_;

  require Tk::DialogBox;

  my $DLG = $self->{TW}->DialogBox(
				   -title          => $opts{-title} || $self->{TITLE},
				   -buttons        => $opts{-buttons} || ['Ok', 'Cancel'],
				  );
  
  my $root = $DLG->Frame()->pack(-fill=>'both',-expand=>1 );
  
  require Tk::Label;
  
  my($label_1) = $root->Label (
			       -text => $opts{-labeltext} || 'Enter:',
			      );
  
 
  my $Callback = $opts{-draw}; 
  my($entry_1) = (ref($Callback) eq 'CODE') ? &$Callback($root) : $root->Entry;
  
  # Geometry management
  
  $label_1->grid(
		 -in => $root,
		 -column => '1',
		 -row => '1',
		 -columnspan => '3'
		);
  
  $entry_1->grid(
		 -in => $root,
		 -column => '1',
		 -row => '2',
		 -columnspan => '3'
		);
  
  $root->gridRowconfigure(1, -weight  => 0, -minsize  => 30);
  $root->gridRowconfigure(2, -weight  => 0, -minsize  => 30);
  
  $root->gridColumnconfigure(1, -weight => 0, -minsize => 38);
  $root->gridColumnconfigure(2, -weight => 0, -minsize => 43);
  $root->gridColumnconfigure(3, -weight => 1, -minsize => 30);
  
  my $rc = $DLG->Show;
  return 0 unless($rc=~/ok/i);
  
  
  1;
}

#######################################################
#
sub MakePopUpMenu {
  my $self   = shift;
  my $l_Menu = $self->{TW}->Menu (-tearoff => 0);
  
  my ($L_Label);

  foreach my $l_Label (@_) {
    if ($l_Label->[0] eq '-') {
      $l_Menu->add('separator');
    } else {
      if (ref($l_Label->[1]) eq 'ARRAY') {
	my $sMenu = $l_Menu->Menu (-tearoff => 0);
	foreach $L_Label (@{$l_Label->[1]}) {
	  $sMenu->add(
		      'command',
		      '-label' => $L_Label->[0],
		      '-command' => $L_Label->[1],
		     );
	}
	$l_Menu->add(
		     'cascade',
		     '-label' => $l_Label->[0],
		     '-menu' => $sMenu,
		    );
      } else {
	$l_Menu->add(
		     'command',
		     '-label' => $l_Label->[0],
		     '-command' => $l_Label->[1],
		    );
      }
    }
  }
  
  return $l_Menu;
}

###########################################################
1;