Heth: /* Eksempel 3 */

2010-02-07T17:08:31Z

‎Eksempel 3

Heth: /* Eksempel 2 */

2009-11-13T08:02:31Z

‎Eksempel 2

Show changes

Heth at 06:52, 13 November 2009

2009-11-13T06:52:35Z

Heth at 06:18, 13 November 2009

2009-11-13T06:18:34Z

Heth: New page: #!/usr/bin/perl -w use strict; use warnings; use Tk; use Net::Ping; # Main window oprettes my $i=0; our $BstartTimer; my $s2; my @hosts = ("4.2.2.2", "www.jp.dk"); my...

2009-11-13T06:17:52Z

New page: <source lang=perl> #!/usr/bin/perl -w use strict; use warnings; use Tk; use Net::Ping; # Main window oprettes my $i=0; our $BstartTimer; my $s2; my @hosts = ("4.2.2.2", "www.jp.dk"); my...

New page

<source lang=perl>
#!/usr/bin/perl -w

use strict;
use warnings;

use Tk;
use Net::Ping;

# Main window oprettes
my $i=0;
our $BstartTimer;
my $s2;
my @hosts = ("4.2.2.2", "www.jp.dk");
my $pingCount=0;
my $tv = "Running..";
my $mw = new MainWindow();

$mw->title("TK Perl menu eksempel 1");

#Knapper
my $Lstart = $mw->Label(-text => 'Pingtest ');
my $Bstart = $mw -> Button(-text => "Start", -command =>\&Bstart,
-overrelief => 'sunken', -relief => 'raised',-padx => 20);
my $Bstop = $mw -> Button(-text => "Stop ", -command =>\&Bstop,
-overrelief => 'sunken', -relief => 'raised',
-padx => 20,-state => 'disabled');
#Status felt
my $status = $mw -> Label (
-relief => 'flat' ,
-borderwidth => 2 ,
-height => 1 ,
-width => 40 ,
-justify => 'right' ,
-anchor => 'w',
-textvariable => \$tv );
my $c = " --:--:--";
my $c2=0;
my $clk = $mw -> Label (
-relief => 'ridge' ,
-borderwidth => 1 ,
-height => 1 ,
-width =>10 ,
-justify => 'left' ,
-textvariable => \$c );

$clk->repeat(500,\&mintid);

# Når er trykkes på F2 køres subrutinen menuclicked()
$mw->bind ( "<F2>" , \&menuClicked ) ;

# Når er trykkes på F3 køres subrutinen saveclicked()
$mw->bind ( "<F3>" , \&saveClicked ) ;

#MOpret et scrool-bart tekstområde i $mv (Hoved vindue)
my $txt = $mw->Scrolled('Text',-height => 20,-width => 50,
-scrollbars=>'osoe', -wrap => 'none');

#Opret en menubar i objktet
my $mbar = $mw->Menu();
$mw->configure(-menu => $mbar);

#Hovedenmer i menuen
my $file = $mbar->cascade(-label=>"File", -underline=>0, -tearoff => 0);
my $edit = $mbar->cascade(-label=>"Edit", -underline=>0, -tearoff => 0);
my $devices = $mbar->cascade(-label =>"Enheder", -underline=>0, -tearoff => 0);
my $help = $mbar->cascade(-label =>"Help", -underline=>0, -tearoff => 0);

## File Menu ##
$file -> command(-label => "New", -underline=>0,
-command=>sub { $txt -> delete('1.0','end');} );
$file -> checkbutton(-label =>"Open", -underline => 0,
-command => [\&menuClicked, "Open"],
-accelerator => "F2");
$file -> command(-label =>"Status", -underline => 0,
-command => [\&saveClicked, "Status"],
-accelerator => "F3");
$file -> separator();
$file -> command(-label =>"Exit", -underline => 1,
-command => sub { exit } );

## Enheder Menu ##
my $cisco = $devices -> cascade(-label =>"Cisco udstyr",
-underline => 0, -tearoff => 0);
$cisco -> command(-label =>"Opret enhed",
-command => sub { $txt->insert('end',
"Der oprettes en ny Cisco Router :-)\n");});
$cisco -> command(-label =>"Rediger enhed", -command=>sub {
$txt->insert('end',"Cisco enhed redigeres\n");});

$cisco -> command(-label =>"Slet enhed",
-command=> sub {$txt->insert('end',"Er du nu helt sikker?\n");});
$devices -> command(-label =>"Ping enhed", -underline => 7,
-command => sub { $txt->insert('end',"Ja her burde der pinges\n");});

## Help ##
$help -> command(-label =>"About", -command => sub {
$txt->delete('1.0','end');
$txt->insert('end',"EUC MIDT - Tk Perl eksempel 1 /HeTh\n")});

{
### Pack windows
$Lstart->grid(-row=>0,-column=>0,-sticky=>'e',-in => $mw);
$Bstart->grid(-row=>0,-column=>1,-sticky=>'e',-in => $mw);
$Bstop->grid(-row=>0,-column=>2,-sticky=>'e',-in => $mw);
$status->grid(-row=>2,-column=>0,-sticky=>"w",-in => $mw);
$clk->grid(-row=>2,-column=>2,-sticky=>"e",-in => $mw);
$txt->grid(-row=>1,-column=>0,-in => $mw,-columnspan => 3,-sticky=>'ewns');
}
### resize behaviour
$mw->gridRowconfigure (0,-weight => 0);
$mw->gridRowconfigure (1,-weight => 1);
$mw->gridRowconfigure (2,-weight => 0);

$mw->gridColumnconfigure (0,-weight => 1);
$mw->gridColumnconfigure (1,-weight => 0);

MainLoop;

sub Bstart {
$tv="Pingtest starter..";
$Bstop->configure(-state=>'normal');
$Bstart->configure(-state=>'disabled');
$txt->insert('end',"............Starter pingtest.\n");
$BstartTimer = $txt->repeat(500,\&MyPing);

}

sub Bstop {
$tv="Pingtest afsluttet. Der er ialt kørt $pingCount forløb.";
$Bstart->configure(-state=>'normal');
$Bstop->configure(-state=>'disabled');
$txt->insert('end',"............Stopper pingtest.\n");
$BstartTimer->cancel();
}

sub menuClicked {
my ($opt) = @_;
$mw->messageBox(-message => "Det er en vigtig besked",
-title => "Advarsel");
}
sub saveClicked {
my ($opt) = @_;

$i++;
$tv = "Nu er der klikket $i gange";

}
sub mintid {
my @mon_abbr =
qw( Jan Feb Mar Apr Maj Jun Jul Aug Sep Okt Nov Dec );

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
if ($c2 == 0) {
$c = sprintf(" %02i:%02i:%02i ", $hour, $min, $sec );
$c2 = 1;
} else {
$c = sprintf(" %02i %02i %02i ", $hour, $min, $sec );
$c2 = 0;
}
}

sub MyPing {
my $protocol = 'icmp';
my $p;
my $host;

$pingCount++;
$tv="Ping test kører $pingCount forløb.";
$txt->insert('end', "$pingCount: ");
foreach $host (@hosts) {
$p = Net::Ping->new($protocol,1);

if ( $p->ping($host) ) {
$txt->insert('end', "$host $$protocol$ er oppe ");
} else {
$txt->insert('end', "$host $$protocol$ er nede ");
}
$p->close();
}
$txt->insert('end',"\n");
$txt->see('end');
}
</source>
[[category:Perl]]

@@ Line 469: / Line 469: @@
                  ($x1b,$y1b) =  $cv->coords($xunits[$i]);
                  if ( $x1b < 50 ) {
-                         $cv->itemconfigure($xunits[$i], -text => '');
+                         $cv->itemconfigure($xunits[$i], -text => "");
                  } if ( $x1b <= -50 ) {
                     $x1b = $cvW-50;

← Older revision		Revision as of 06:52, 13 November 2009
Line 1:		Line 1:
		+	= Eksempel 1 =
		+	<source lang=perl>
		+	#!/usr/local/bin/perl
		+	use Tk;
		+	# Main Window
		+	$mw = new MainWindow;
		+
		+	my $lab = $mw -> Label(-text=>"This is the root window.",
		+	-font=>"ansi 12 bold") -> pack;
		+	my $but = $mw -> Button(-text=>"Click to Create Toplevel",
		+	-command=>\&makeTop) -> pack;
		+
		+	MainLoop;
		+
		+	#A function to make a toplevel window
		+	sub makeTop {
		+	my $top = $mw -> Toplevel(); #Make the window
		+	#Put things in it
		+	my $top_lab = $top -> Label(-text=>"This is the Toplevel window.",
		+	-font=>"ansi 12 bold") -> pack;
		+	my $txt = $top -> Text() -> pack;
		+	$txt -> insert('end', "Widgets can be packed in this window.");
		+
		+	#An option to close the window.
		+	my $but_close = $top -> Button(-text=>"Close",
		+	-command => sub { destroy $top; } ) -> pack;
		+	}
		+	</source>
		+	= Eksempel 2 =
		+
	<source lang=perl>		<source lang=perl>
	#!/usr/bin/perl -w		#!/usr/bin/perl -w

@@ Line 102: / Line 102: @@
 $help -> command(-label =>"About", -command => sub {
 	$txt->delete('1.0','end');
-	$txt->insert('end',"EUC MIDT - Tk Perl eksempel 1 /HeTh\n")});
+	$txt->insert('end',"Mercantec - Tk Perl eksempel 1 /HeTh\n")});
+{

Perl TK eksempel - Revision history

Heth: /* Eksempel 3 */

Heth: /* Eksempel 2 */

Heth at 06:52, 13 November 2009

Heth at 06:18, 13 November 2009

Heth: New page: #!/usr/bin/perl -w use strict; use warnings; use Tk; use Net::Ping; # Main window oprettes my $i=0; our $BstartTimer; my $s2; my @hosts = ("4.2.2.2", "www.jp.dk"); my...