TK 例子《1》
来源：互联网 发布：d3.js教程 编辑：程序博客网 时间：2024/06/06 00:07
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 menumy $mbar = $frm_menu -> Menu();$mw -> configure(-menu => $mbar);#The Main Buttonsmy $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\n");});$insert -> command(-label =>"Website", -command=>sub {$txt->insert('end',"Website : http://wwwgeocitiescom/binnyva/\n");});$insert -> command(-label =>"Email",-command=> sub {$txt->insert('end',"E-Mail : binnyva\@hotmailcom\n");});$others -> command(-label =>"Insert All", -underline => 7,-command => sub { $txt->insert('end',"Name : Binny V AWebsite : 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\nPerl/Tk tutorialMade by Binny V AWebsite : http://wwwgeocitiescom/binnyva/codeE-Mail : binnyva\@hotmailcom"); });sub menuClicked {my ($opt) = @_;$mw->messageBox(-message=>"You have clicked $optThis 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 Windowmy $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\n"; 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\t$a2\t$a3\t$a4\t$a5\t$a6\t$a7\t$a8\t$a9\n" ); #循环取数组元素个数 $var2=@arr2 -1 ; $i=0; foreach $var3 ("$a1","$a2","$a3","$a4","$a5","$a6","$a7","$a8","$a9"){ $i++; print "\$i is $i\n"; print "\$var3 is $var3\n"; 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\n";print "1---\@arr2 is @arr2\n"; print "\$arr2[1] is $arr2[1]\n"; print "\$arr2[2] is $arr2[2]\n";$selStmt->finish; $dbh->disconnect; }}#定义push_button12 函数，这里利用grid布局#sub push_button12{my $mw = new MainWindow; # Main Windowmy $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 Framemy $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 Windowmy $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\n"; 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\t$a2\t$a3\t$a4\t$a5\t$a6\t$a7\t$a8\t$a9\n" ); #循环取数组元素个数 $var2=@arr2 -1 ; $i=0; foreach $var3 ("$a1","$a2","$a3","$a4","$a5","$a6","$a7","$a8","$a9"){ $i++; print "\$i is $i\n"; print "\$var3 is $var3\n"; 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\n";print "1---\@arr2 is @arr2\n"; print "\$arr2[1] is $arr2[1]\n"; print "\$arr2[2] is $arr2[2]\n";$selStmt->finish; $dbh->disconnect; }} 0 0
- TK 例子《1》
- Tcl/Tk Notes (1)
- 《TCL/TK编程实践》第四版 第24章 TK例子 24.1 ExecLog
- 了解 Perl/Tk 模块，第 1 部分 Perl/Tk 基础知识
- Tk库的使用(1)
- tcl/tk笔记-创建一个Tcl dll的例子
- tcl/tk safe - 1 - interp基本命令
- OCP 1Z0_043 TK及相关材料
- tcl/tk学习笔记（1）
- Perl Tk grid布局管理器<1>
- TK WM参数学习(tkinter)1
- Eclipse3.1使用tk.eclipse.plugin.struts的问题
- 【PERL笔记1】perl Tk 简单部件的应用
- PERL TK
- Tk base
- graph.tk
- Tk send
- Tk::Table
- project Euler 13
- Find Peak Element
- 机器学习与智能优化 之 学习也民主
- Spring (一) :简单使用Spring
- NYOJ 题目290 动物统计加强版（字典树）
- TK 例子《1》
- 关于IPv6物联网技术的些许总结
- ARM子函数定义中的参数放入寄存器的规则
- 1079. Total Sales of Supply Chain (25)
- 代码是不是写得越 smart 越好
- C51回顾二
- 1.git安装和使用
- class_create(),device_create解析
- (385C)codeforce
