TK 例子《1》

use Tk; 
use DBI; 
# Main Window
#
#my $mw = new MainWindow;
my $mw = MainWindow->new(-title => "system monitor");
#

#'Widget' 可以试任何的部件支持滚动条 比如 Text,Listbox,etc
#
#
my $frm_menu = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');
#my $txt = $frm_menu -> Scrolled('Text',-width => 50,-scrollbars=>'e') -> pack ();




#Declare that there is a menu
my $mbar = $frm_menu -> Menu();
$mw -> configure(-menu => $mbar);


#The Main Buttons
my $file = $mbar -> cascade(-label=>"File", -underline=>0, -tearoff => 0);
my $others = $mbar -> cascade(-label =>"others", -underline=>0, -tearoff => 0);

my $tools = $mbar -> cascade(-label =>"tools", -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('10','end');} );

$file -> checkbutton(-label =>"Open", -underline => 0,
-command => [&menuClicked, "Open"]);

$file -> command(-label =>"Save", -underline => 0,
-command => [&menuClicked, "Save"]);
$file -> separator();

$file -> command(-label =>"Exit", -underline => 1,
-command => sub { exit } );



## Others Menu ##
my $insert = $others -> cascade(-label =>"Insert", -underline => 0, -tearoff => 0);
$insert -> command(-label =>"Name",
-command => sub { $txt->insert('end',"Name : Binny V A
");});
$insert -> command(-label =>"Website", -command=>sub {
$txt->insert('end',"Website : http://wwwgeocitiescom/binnyva/
");});
$insert -> command(-label =>"Email",
-command=> sub {$txt->insert('end',"E-Mail : binnyva@hotmailcom
");});
$others -> command(-label =>"Insert All", -underline => 7,
-command => sub { $txt->insert('end',"Name : Binny V A
Website : http://wwwgeocitiescom/binnyva/
E-Mail : binnyva@hotmailcom");
});
## Help ##
$help -> command(-label =>"About", -command => sub {
$txt->delete('10','end');
$txt->insert('end',
"About
----------
This script was created to make a menu for a
Perl/Tk tutorial
Made by Binny V A
Website : http://wwwgeocitiescom/binnyva/code
E-Mail : binnyva@hotmailcom"); });

sub menuClicked {
my ($opt) = @_;
$mw->messageBox(-message=>"You have clicked $opt
This function is not implanted yet");
}



my $frm1 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');
my $but1 =$frm1  -> Button(-text => "view cpu",-width=>22,-height=>3,-background=>'green',
-command =>&push_button1);
$but1 -> pack(-side=>"left",-fill => 'x',-expand => 1 );


my $but2 = $frm1 -> Button(-text => "view memory",-width=>22,-height=>3,-background=>'green',-command =>&push_button2);

$but2 -> pack(-side=>"left",-fill => 'x',-expand => 1 );

my $but3 = $frm1 -> Button(-text => "view disk",-width=>22,-height=>3,-background=>'green',-command =>&push_button3);

$but3 -> pack(-side=>"left",-fill => 'x',-expand => 1);

my $but4 = $frm1 -> Button(-text => "view Event",-width=>22,-height=>3,-background=>'green');

$but4 -> pack(-side=>"left",-fill => 'x',-expand => 1);



my $frm2 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');

my $lab1 = $frm2 -> Label(-text=>"Start date:")->pack;

my $frm3 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');

my $but5 =$frm3  -> Button(-text => "Oracle",-width=>22,-height=>3,-height=>3,-background=>'green',
-command =>&push_button);
$but5 -> pack(-side=>"left",-expand => 1,-fill => 'x');


my $but6 = $frm3 -> Button(-text => "Mysql",-width=>22,-height=>3,-height=>3,-background=>'green');

$but6 -> pack(-side=>"left",-expand => 1,-fill => 'x');

my $but7 = $frm3 -> Button(-text => "db2",-width=>22,-height=>3,-height=>3,-background=>'green');

$but7 -> pack(-side=>"left",-expand => 1,-fill => 'x');

my $but8 = $frm3 -> Button(-text => "Sqlserver",-width=>22,-height=>3,-background=>'green');

$but8 -> pack(-side=>"left",-expand => 1,-fill => 'x');

my $frm4 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');


my $lab2 = $frm4 -> Label(-text=>"Stop date:")->pack;

my $frm5 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');


my $but7 = $frm5 -> Button(-text => "register",-width=>22,-height=>3,-background=>'green');

$but7 -> pack(-side=>"left",-expand => 1,-fill => 'x');

my $but8 = $frm5 -> Button(-text => "view",-width=>22,-height=>3,-background=>'green');

$but8 -> pack(-side=>"left",-expand => 1,-fill => 'x');



my $frm6 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');

my $lab3 = $frm6 -> Label(-text=>"")->pack;

my $but8 = $frm6 -> Button(-text => "register",-width=>22,-height=>3,-background=>'green');

$but8 -> pack(-side=>"left",-expand => 1,-fill => 'x');

my $but9 = $frm6 -> Button(-text => "view",-width=>22,-height=>3,-background=>'green');

$but9 -> pack(-side=>"left",-expand => 1,-fill => 'x');




my $frm7 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');

my $lab4 = $frm7 -> Label(-text=>"")->pack;

my $but10 = $frm7 -> Button(-text => "register",-width=>22,-height=>3,-background=>'green');

$but10 -> pack(-side=>"left",-expand => 1,-fill => 'x');

my $but11 = $frm7 -> Button(-text => "view",-width=>22,-height=>3,-background=>'green');

$but11 -> pack(-side=>"left",-expand => 1,-fill => 'x');


my $frm8 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');

my $lab5 = $frm8 -> Label(-text=>"")->pack;

my $but12 = $frm8 -> Button(-text => "register",-width=>22,-height=>3,-background=>'green',-command =>&push_button12);

$but12 -> pack(-side=>"left",-expand => 1,-fill => 'x');

my $but13 = $frm8 -> Button(-text => "view",-width=>22,-height=>3,-background=>'green',-command =>&push_button13);

$but13 -> pack(-side=>"left",-expand => 1,-fill => 'x');


my $cns = $mw -> Canvas(-background=>"orange");
#$cns -> create('polygon',5,100,50,5,150,5,200,100,5,100,
#-joinstyle=>"bevel", -fill=>"red", -outline=>"white", -width=>5);
$cns -> pack(-side=>"left",-expand => 1,-fill => 'both');;

MainLoop;

#This is executed when the button is pressed
#
#
#
#
#
#
#定义push_button3 函数
sub push_button3 {
my $mw = new MainWindow; # Main Window
my $frm_name1 = $mw -> Frame()->pack(-side=>"top",-fill => 'x');

my $lab1 = $frm_name1 -> Label(-text=>"Host Ip",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);

my $ent1 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);

my $lab2 = $frm_name1 -> Label(-text=>"Start date",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);

my $ent2 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);

my $lab3= $frm_name1 -> Label(-text=>"Stop date",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);

my $ent3 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);

my $but1 = $frm_name1 -> Button(-text => "ok",-command =>&sub_fun3)-> pack(-side=>"left",-ipadx=>20,-padx=>30);

my $but1 = $frm_name1 -> Button(-text => "clear table",-command =>&sub_clear1)-> pack(-side=>"left",-ipadx=>20,-padx=>30);

###############定义表格开始
$mw->geometry("475x122");

#禁止窗口缩放
#$mw->resizable(0,0);

my $table_frame = $mw->Frame()->pack(-expand => 1,-fill => 'both');
my $table = $table_frame->Table(-columns => 10,
                                -rows => 26,
                                -fixedrows => 1,
                                -scrollbars => 'oe',
                                -relief => 'raised');


#@arr1 = qw/HOST FILESYSTEM TYPE SIZE# USED AVAIL USE MOUNTED SYSDATE/;
##使用hash数组
			my 	%hash=("1","HOST",  
        "2","FILESYSTEM",  
        "3","TYPE",
        "4","SIZE#",
        "5","USED",
        "6","AVAIL",
        "7","USE",
        "8","MOUNTED",
        "9","SYSDATE"); 

foreach  $key (sort keys %hash)

{    my $var = $hash{$key};
	print "$var is  $var
";
    	
	 my $tmp_label = $table->Label(-text =>  $var, -width => 22, -relief =>'raised');

	 ##放到第0行 第N列
  $table->put(0, $key, $tmp_label);
}

##创建100行
my $tmp_label="";
foreach my $row (1 .. 100)
{
  foreach my $col (1 .. 10)
  {
    my $tmp_label = $table->Label(-text => "",
                                  -padx => 0,
                                  -anchor => 'w',
                                  -background => 'white',
                                  -relief => "groove");
    $table->put($row, $col, $tmp_label);
  }
}
$table->pack(-expand => 1,-fill => 'both');



##borderwidth 边框属性
my $button_frame = $mw->Frame( -borderwidth => 4 )->pack();
$button_frame->Button(-text => "Exit", -command => sub {exit})->pack();

#my $frm4 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');

#Text Area
#my $txt = $frm4 -> Text(-width=>108,-height=>40) -> pack(-fill => 'both');
#
#定义表格结束
sub sub_clear1{
	my $tmp_label="";

	foreach my $row (1 .. 90)
{
  foreach my $col (1 .. 10)
  {
     my $tmp_label = $table->Label(-text => "",
                                  -padx => 0,
                                  -anchor => 'w',
                                  -background => 'white',
                                  -relief => "groove");
    $table->put($row, $col, $tmp_label);
  }
}
$table->pack(-expand => 1,-fill => 'both');
}

sub sub_fun3{
my $dbName = 'dwh5';  
my $dbUser = 'test';  
my $dbUserPass = 'test';
my $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
my $name3 = $ent3 -> get();

my $dbh = DBI->connect("dbi:Oracle:$dbName", $dbUser, $dbUserPass) or die "can't connect to database " ;
my $hostSql = qq{select trim(HOST),trim(FILESYSTEM),trim(TYPE),trim(SIZE#),trim(USED),trim(AVAIL),trim(USE),trim(MOUNTED),to_char(SYSDATE\,'yyyy-mm-dd:Hh24:Mm:Ss') from cpu_info where host='$name1'};    
@arr2="";  

$var2="";

$tmp_label="";

$var3="";

$i=0;

my ($a1, $a2, $a3,$a4,$a5,$a6,$a7,$a8,$a9);  
my $selStmt = $dbh->prepare($hostSql);  
$selStmt->bind_columns(undef, $a1, $a2, $a3,$a4,$a5,$a6,$a7,$a8,$a9);  
$selStmt->execute();  
while( $selStmt->fetch() ){  
	 push (@arr2, "$a1	$a2	$a3	$a4	$a5	$a6	$a7	$a8	$a9
" );
	 #循环取数组元素个数
	  $var2=@arr2 -1 ;
	 $i=0;
	  foreach $var3 ("$a1","$a2","$a3","$a4","$a5","$a6","$a7","$a8","$a9"){
		  $i++;
		  print "$i is $i
";
		  print "$var3 is $var3
";
 my $tmp_label = $table->Label(-text => "$var3",
                                  -padx => 0,
                                  -anchor => 'w',
                                  -background => 'white',
                                  -relief => "groove");
       $table->put($var2, $i, $tmp_label);

} 
}
        print "$var2 is $var2
";
	print "1---@arr2 is @arr2
";
 print "$arr2[1] is $arr2[1]
";
 print "$arr2[2] is $arr2[2]
";
$selStmt->finish;  
$dbh->disconnect; 
}
}



#定义push_button12 函数，这里利用grid布局
#
sub push_button12{
	my $mw = new MainWindow; # Main Window
my $frm_name = $mw -> Frame();
my $lab1 = $frm_name -> Label(-text=>"Id Number:",-width=>10);
my $lab2 = $frm_name -> Label(-text=>"Room Number:");
my $lab3 = $frm_name -> Label(-text=>"Money:");
my $ent1 = $frm_name -> Entry();  ###输入文本框
my $ent2 = $frm_name -> Entry();  ###输入文本框
my $ent3 = $frm_name -> Entry();  ###输入文本框
my $but = $mw -> Button(-text=>"ok",-width=>10, -command =>&sub_fun12);
my $textarea = $mw -> Frame(); #Creating Another Frame
my $txt = $textarea -> Text(-width=>40, -height=>10);
my $srl_y = $textarea -> Scrollbar(-orient=>'v',-command=>[yview => $txt]);
my $srl_x = $textarea -> Scrollbar(-orient=>'h',-command=>[xview => $txt]);
$txt -> configure(-yscrollcommand=>['set', $srl_y],
-xscrollcommand=>['set',$srl_x]);
$lab1 -> grid(-row=>1,-column=>1);
$lab2 -> grid(-row=>2,-column=>1);
$lab3 -> grid(-row=>3,-column=>1);
$ent1 -> grid(-row=>1,-column=>2);
$ent2 -> grid(-row=>2,-column=>2);
$ent3 -> grid(-row=>3,-column=>2);
$frm_name -> grid(-row=>1,-column=>1,-columnspan=>2);
$but -> grid(-row=>4,-column=>1,-columnspan=>2);
$txt -> grid(-row=>1,-column=>1,-ipadx=>160,-ipady=>100);
$srl_y -> grid(-row=>1,-column=>2,-sticky=>"ns");
$srl_x -> grid(-row=>2,-column=>1,-sticky=>"ew");
$textarea -> grid(-row=>5,-column=>1,-columnspan=>20);

sub sub_fun12 {
my $dbName = 'dwh5';  
my $dbUser = 'test';  
my $dbUserPass = 'test';  
my $dbh = DBI->connect("dbi:Oracle:$dbName", $dbUser, $dbUserPass) or die "can't connect to database "; 
my $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
my $name3 = $ent3 -> get();

$txt -> insert('end',"$name1 $name2 $name3");
$dbh->do("insert into register_info values ('$name1','$name2','$name3')") or die($DBI::errstr);
$dbh->disconnect();
}
}




sub push_button13{
my $mw = new MainWindow; # Main Window
my $frm_name1 = $mw -> Frame()->pack(-side=>"top",-fill => 'x');

my $lab1 = $frm_name1 -> Label(-text=>"Id",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);

my $ent1 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);

my $lab2 = $frm_name1 -> Label(-text=>"Room",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);

my $ent2 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);

my $lab3= $frm_name1 -> Label(-text=>"Money",-width=>10) -> pack(-side=>"left",-ipadx=>20,-ipady=>20);

my $ent3 = $frm_name1 -> Entry() -> pack(-side=>"left",-ipadx=>20);

my $but1 = $frm_name1 -> Button(-text => "ok",-command =>&sub_fun13)-> pack(-side=>"left",-ipadx=>20,-padx=>30);

my $but1 = $frm_name1 -> Button(-text => "clear table",-command =>&sub_clear2)-> pack(-side=>"left",-ipadx=>20,-padx=>30);

###############定义表格开始
$mw->geometry("475x122");

#禁止窗口缩放
#$mw->resizable(0,0);

my $table_frame = $mw->Frame()->pack(-expand => 1,-fill => 'both');
my $table = $table_frame->Table(-columns => 10,
                                -rows => 26,
                                -fixedrows => 1,
                                -scrollbars => 'oe',
                                -relief => 'raised');


#@arr1 = qw/HOST FILESYSTEM TYPE SIZE# USED AVAIL USE MOUNTED SYSDATE/;
##使用hash数组
my 	%hash=("1","ID",  
        "2","ROOM",  
        "3","MONEY"
       ); 
foreach  $key (sort keys %hash)

{    my $var = $hash{$key};
	print "$var is  $var
";
    	
	 my $tmp_label = $table->Label(-text =>  $var, -width => 65, -relief =>'raised');

	 ##放到第0行 第N列
  $table->put(0, $key, $tmp_label);
}

##创建100行
my $tmp_label="";
foreach my $row (1 .. 100)
{
  foreach my $col (1 .. 10)
  {
    my $tmp_label = $table->Label(-text => "",
                                  -padx => 0,
                                  -anchor => 'w',
                                  -background => 'white',
                                  -relief => "groove");
    $table->put($row, $col, $tmp_label);
  }
}
$table->pack(-expand => 1,-fill => 'both');



##borderwidth 边框属性
my $button_frame = $mw->Frame( -borderwidth => 4 )->pack();
$button_frame->Button(-text => "Exit", -command => sub {exit})->pack();

#my $frm4 = $mw -> Frame() ->pack(-side=>"top",-fill => 'x');

#Text Area
#my $txt = $frm4 -> Text(-width=>108,-height=>40) -> pack(-fill => 'both');
#
#定义表格结束
sub sub_clear2{
	my $tmp_labe="";

	foreach my $row (1 .. 100)
{
  foreach my $col (1 .. 10)
  {
     my $tmp_label = $table->Label(-text => "",
                                  -padx => 0,
                                  -anchor => 'w',
                                  -background => 'white',
                                  -relief => "groove");
    $table->put($row, $col, $tmp_label);
  }
}
$table->pack(-expand => 1,-fill => 'both');
}

sub sub_fun13{
my $dbName = 'dwh5';  
my $dbUser = 'test';  
my $dbUserPass = 'test';
my $name1 = $ent1 -> get();
my $name2 = $ent2 -> get();
my $name3 = $ent3 -> get();

my $dbh = DBI->connect("dbi:Oracle:$dbName", $dbUser, $dbUserPass) or die "can't connect to database " ;
my $hostSql = qq{select trim(ID),trim(ROOM),trim(MONEY) from register_info where id='$name1'};  
@arr2="";  

$var2="";

$tmp_label="";

$var3="";

$i=0;

my ($a1, $a2, $a3,$a4,$a5,$a6,$a7,$a8,$a9);  
my $selStmt = $dbh->prepare($hostSql);  
$selStmt->bind_columns(undef, $a1, $a2, $a3,$a4,$a5,$a6,$a7,$a8,$a9);  
$selStmt->execute();  
while( $selStmt->fetch() ){  
	 push (@arr2, "$a1	$a2	$a3	$a4	$a5	$a6	$a7	$a8	$a9
" );
	 #循环取数组元素个数
	  $var2=@arr2 -1 ;
	 $i=0;
	  foreach $var3 ("$a1","$a2","$a3","$a4","$a5","$a6","$a7","$a8","$a9"){
		  $i++;
		  print "$i is $i
";
		  print "$var3 is $var3
";
 my $tmp_label = $table->Label(-text => "$var3",
                                  -padx => 0,
                                  -anchor => 'w',
                                  -background => 'white',
                                  -relief => "groove");
       $table->put($var2, $i, $tmp_label);

} 
}
        print "$var2 is $var2
";
	print "1---@arr2 is @arr2
";
 print "$arr2[1] is $arr2[1]
";
 print "$arr2[2] is $arr2[2]
";
$selStmt->finish;  
$dbh->disconnect; 
}
}