|
|
楼主 |
发表于 2025-8-26 16:08:04
|
显示全部楼层
本帖最后由 zzz19760225 于 2025-10-25 15:22 编辑
12345678903
三个按钮(开始游戏,介绍游戏,结束游戏)
- use utf8;
- use open ':std',':encoding(gbk)';
- binmode STDOUT,":encoding(UTF-8)";
- use Tk;
- my $a0 = MainWindow->new;
- my $b1 = $a0->Button(
- -text => "开始游戏",
- )->pack();
- my $b2=$a0->Button(
- -text => "介绍游戏",
- )->pack();
- my $b3=$a0->Button(
- -text => "结束游戏",
- -command =>sub{$a0->destroy;},
- )->pack();
- MainLoop;
复制代码 正确的代码结构顺序,Perl 脚本应遵循:
use ...
主窗口创建
变量定义
子程序(函数)定义
GUI 元素创建与事件绑定
初始状态设置
MainLoop
- #!/usr/bin/perl
- use strict;
- use warnings;
- use Tk;
- my $mw = MainWindow->new;
- my $img = $mw->Photo(-width => 200,-height => 150,-palette => 'truecolor');
- $mw->Label(-image => $img)->pack();
- $img->put("#000000", -to => (10, 20, 5, 11)); # 整个图像区域
- $img->put("#FF0000", -to => (50,60)); # 设置某个像素的颜色 (x=50, y=60) 为红色
- MainLoop;
复制代码 重复输出
- use strict;
- use warnings;
- use Tk;
- use utf8; # 估计召唤
- use Encode qw(decode encode); # 估计召唤
- binmode STDOUT, ':utf8'; # 估计召唤
- binmode STDERR, ':utf8'; # 估计召唤
- my $mw = MainWindow->new;
- my $id = $mw->repeat(500, \&a123);# 设置每 500 毫秒执行一次 a123 子程序
- sub a123 {print "456\n"; }
- MainLoop;
复制代码 停止 repeat
$mw->afterCancel($id)
- my $count = 0;
- my $id = $mw->repeat(500, sub {
- $count++;
- print "456 (times: $count)\n";
- if ($count >= 5) {
- $mw->afterCancel($id); # 停止重复
- }
- });
复制代码 鼠标左键点击图画,图画可以移动。
<Button-1>鼠标左键(一般通用)
<Button-2>鼠标中键(win与linux有区别)
<Button-3>鼠标右键
- use Tk;
- my $mw = MainWindow->new;
- my $canvas = $mw->Canvas(width => 500, height => 500)->pack();
- # 创建几个多边形,并给每个都加上相同的标签
- $canvas->createPolygon(10, 20, 50, 60,70,20, -tags => ['complex_shape1'], -fill => '#ff0000');
- $canvas->createPolygon(50, 60, 80, 90, 50, 70, -tags => ['complex_shape2'], -fill => '#ffff00');
- $canvas->createPolygon(150, 100, 100, 150, 150, 200, -tags => ['complex_shape3'], -fill => '#ff00ff');
- # 添加鼠标点击事件:点击后所有 complex_shape 向右下移动
- $canvas->bind('complex_shape1', '<Button-1>', sub {
- $canvas->move('complex_shape1', 10, 10);
- });
- $canvas->bind('complex_shape2', '<Button-1>', sub {
- $canvas->move('complex_shape2', 20, 10);
- });
- $canvas->bind('complex_shape3', '<Button-1>', sub {
- $canvas->move('complex_shape3', 30, 10);
- });
- MainLoop;
复制代码 Tk 的 canvas文本特定词为按钮(C语言的文字按钮那个头疼的事)
- #!/usr/bin/perl
- use strict;
- use warnings;
- use Tk;
- use utf8; # 估计召唤
- use Encode qw(decode encode); # 估计召唤
- binmode STDOUT, ':utf8'; # 估计召唤
- binmode STDERR, ':utf8'; # 估计召唤
- my $mw = MainWindow->new();
- $mw->title("Canvas 可点击词(支持下划线)");
- my $canvas = $mw->Canvas(
- -width => 600,
- -height => 300,
- -bg => 'white'
- )->pack(-expand => 1, -fill => 'both');
- my %clickable_words = (
- Perl => '#3498db',
- Tk => '#e74c3c',
- );
- my $x = 50;
- my $y = 50;
- my $line_height = 25;
- my $font = ['Helvetica', 12];
- my @lines = (
- "欢迎学习 Perl 和 Tk 编程!",
- "Perl 是一种强大的脚本语言。",
- "Tk 是 Perl 的图形界面工具包。",
- );
- foreach my $line_text (@lines) {
- my $current_x = $x;
- for my $word (split /\s+/, $line_text) {
- my $clean_word = $word;
- my $has_punct = '';
- $clean_word =~ s/([,\.!\?;]+)$// && ($has_punct = $1);
- my $is_clickable = exists $clickable_words{$clean_word};
- # 创建文本(不要用 -underline)
- my $text_id = $canvas->createText($current_x, $y,
- -text => $clean_word,
- -font => $font,
- -fill => $is_clickable ? $clickable_words{$clean_word} : 'black',
- -anchor => 'nw',
- );
- if ($is_clickable) {
- # 绑定事件
- $canvas->bind($text_id, '<Enter>', sub {
- $canvas->configure(-cursor => 'hand2');
- # 添加下划线
- $canvas->itemconfigure($text_id, -underline => 1);
- });
- $canvas->bind($text_id, '<Leave>', sub {
- $canvas->configure(-cursor => 'arrow');
- # 移除下划线
- $canvas->itemconfigure($text_id, -underline => 0);
- });
- $canvas->bind($text_id, '<Button-1>', sub {
- $mw->messageBox(
- -title => "点击",
- -message => "你点击了: '$clean_word'",
- -icon => 'info',
- -type => 'ok',
- );
- });
- }
- my $text_width = $canvas->fontMeasure($font, $clean_word);
- $current_x += $text_width + 2;
- if ($has_punct) {
- $canvas->createText($current_x, $y,
- -text => $has_punct,
- -font => $font,
- -fill => 'black',
- -anchor => 'nw'
- );
- $current_x += $canvas->fontMeasure($font, $has_punct) + 4;
- } else {
- $current_x += 4;
- }
- }
- $y += $line_height;
- }
- MainLoop;
复制代码
- # 定义特定文字链接样式,链接+蓝色+下划线
- $text->tagConfigure('link', -foreground => 'blue', -underline => 1);
- $text->tagBind('link', '<Enter>', sub { $text->configure(-cursor => 'arrow'); });
- $text->tagBind('link', '<Leave>', sub { $text->configure(-cursor => 'xterm'); });
复制代码 文字循环跳转
- #!/usr/bin/perl
- use utf8; # 源码为 UTF-8
- use strict;
- use warnings;
- use open ':std', ':encoding(UTF-8)'; # 默认输入输出为 UTF-8
- use Tk;
- # 主窗口
- my $mw = MainWindow->new;
- $mw->title("Tk 文本跳转示例");
- $mw->geometry("500x400");
- # 创建框架和滚动条
- my $frame = $mw->Frame->pack(-fill => 'both', -expand => 1);
- # 文本控件
- my $text = $frame->Text(
- -wrap => 'word',
- -font => '{Arial} 12',
- -width => 60,
- -height => 20,
- )->pack(-side => 'left', -fill => 'both', -expand => 1);
- # 垂直滚动条
- my $vscroll = $frame->Scrollbar(
- -orient => 'vertical',
- -command => sub { $text->yview(@_) }
- )->pack(-side => 'right', -fill => 'y');
- # 关联滚动条
- $text->configure(-yscrollcommand => sub { $vscroll->set(@_) });
- # 定义标签样式:可点击链接
- $text->tagConfigure('link',
- -foreground => 'blue',
- -underline => 1,
- -lmargin1 => '5m', # 左边距
- -lmargin2 => '5m', # 换行后左边距
- );
- $text->tagBind('link', '<Enter>', sub { $text->configure(-cursor => 'hand2'); });
- $text->tagBind('link', '<Leave>', sub { $text->configure(-cursor => 'xterm'); });
- $text->tagBind('link', '<Button-1>', \&on_link_click);
- # 启动时加载主页
- load_home();
- MainLoop;
- # ============ 子程序 ============
- # 加载主页
- sub load_home {
- $text->delete('1.0', 'end');
- $text->insert('end', "欢迎!这是一个示例,其中 ");
- insert_link("123");
- $text->insert('end', " 是可点击的。");
- }
- # 插入可点击链接
- sub insert_link {
- my $word = shift;
- my $start = $text->index('end -1c'); # 当前末尾位置
- $text->insert('end', $word);
- my $end = $text->index('end -1c');
- $text->tagAdd('link', $start, $end);
- # 存储链接对应的跳转目标(用哈希或直接闭包)
- $text->tag('bind', 'link', "<1>", sub { load_file($word); })
- unless $text->tagNames($start) =~ /\blink_attached\b/;
- $text->tagAdd('link_attached', $start, $end); # 防止重复绑定
- }
- # 点击链接时加载文件
- sub on_link_click {
- my $target = shift;
- # 从当前光标位置提取文本
- my $index = $text->index('current');
- my $char = $text->get($index);
- # 向前找最近的 link 标签
- for my $i (0..10) {
- my $pos = $text->index("$index - ${i}c");
- my @tags = $text->tagNames($pos);
- if (grep { $_ eq 'link' } @tags) {
- # 获取该位置的字符(假设是 3 位数字)
- my $word = $text->get($pos, "$pos + 3c");
- $word =~ s/\s+.*//; # 去空格
- $word =~ s/\D//g; # 只留数字
- if ($word =~ /^(123|456)$/) {
- load_file($word);
- return;
- }
- }
- }
- }
- # 加载指定文件内容
- sub load_file {
- my $filename = "$_[0].txt";
- $text->delete('1.0', 'end');
- if (! -e $filename) {
- $text->insert('end', "错误:文件 $filename 不存在!\n");
- $text->insert('end', "请确保文件与脚本在同一目录。\n");
- return;
- }
- open my $fh, '<:encoding(UTF-8)', $filename or do {
- $text->insert('end', "无法打开文件: $!\n");
- return;
- };
- local $/;
- my $content = <$fh>;
- close $fh;
- # 分割内容,插入文本和链接
- my @parts = split /(\b123\b|\b456\b)/, $content;
- for my $part (@parts) {
- if ($part =~ /^(123|456)$/) {
- insert_link($part);
- } else {
- $text->insert('end', $part);
- }
- }
- }
复制代码 |
|