1

在 macOS v10.13.6 上使用 Perl v5.28、Tkx.pm v1.10和 ActiveState Tcl/TTk v8.6.9（'aqua' 风格）。下面的演示按需要工作，使用鼠标按下 GUI 按钮或使用带有“普通”文本字符的键盘输入来调用给定的子例程。

我想要的一个附加功能是使用键盘替代激活时按下（闪烁）图形按钮的视觉反馈。我找到了使用event generate命令的 Tcl 解决方案，以及使用 Perl Tkx::event_generate() 虚拟事件方法调用的参考。我什至找到了等效的 Perl Tkx::after(100)函数调用来创建建议的延迟。但是我不知道如何将所有这些放在一起以达到预期的效果。任何帮助将不胜感激，但要了解，与其他一些 TTk 功能一样，这可能不适用于 Mac。

代码

#!/usr/bin/env perl
# -*- cperl -*-

use warnings;
use strict;
use Tkx; $Tkx::TRACE = 1;
my $mw = Tkx::widget->new(".");
$mw->g_wm_geometry('200x200+100+100');

my $l = $mw->new_ttk__label
  (
    -text => ("Button Test Ttk v" . Tkx::info("patchlevel"))
  );

sub greeting { print(STDERR "--> [ Hello, world ] pressed\n") }

my $b = $mw->new_ttk__button
  (
         -text => "Hello, world",
    -underline => 0,
      -command => sub { greeting() }
  );

$mw->g_bind('<h>', sub { $b->invoke() });
$mw->g_bind('<H>', sub { $b->invoke() });
$l->g_pack();
$b->g_pack();
Tkx::MainLoop();

print(STDERR "Program exit...\n");

运行日志

Tkx-1-0.0s-demo-12: wm geometry . 200x200+100+100
Tkx-2-0.0s-demo-14: info patchlevel
Tkx-3-0.0s-demo-14: winfo children .
Tkx-4-0.0s-demo-14: ttk::label .l -text {Button Test Ttk v8.6.9}
Tkx-5-0.0s-demo-26: winfo children .
Tkx-6-0.0s-demo-26: ttk::button .b -text {Hello, world} -underline 0 -command perl::callback
Tkx-7-0.0s-demo-28: bind . <h> perl::callback
Tkx-8-0.0s-demo-29: bind . <H> perl::callback
Tkx-9-0.0s-demo-30: pack .l
Tkx-10-0.0s-demo-31: pack .b
--> [ Hello, world ] pressed
Tkx-11-6.4s-demo-28: .b invoke
--> [ Hello, world ] pressed
Tkx-12-7.9s-demo-29: .b invoke
--> [ Hello, world ] pressed
Program exit...
4

1 回答 1

1

这是一个示例（在 Ubuntu 21.04 上测试）。通过调用g_event_generate("<ButtonPress-1>")按钮，invoke()会自动调用按钮：

use feature qw(say);
use strict;
use warnings;
use Tkx;
my $mw = Tkx::widget->new(".");
$mw->g_wm_geometry('200x200+100+100');

my $l = $mw->new_ttk__label(
    -text => ("Button Test Ttk v" . Tkx::info("patchlevel"))
);

sub greeting { say "--> [ Hello, world ] pressed"; }

my $b = $mw->new_ttk__button(
    -text      => "Hello, world",
    -underline => 0,
    -command   => sub { greeting() }
);
sub generate_button_click_event {
    $b->g_event_generate("<ButtonPress-1>");
    Tkx::after(
        200, sub {
            $b->g_event_generate("<ButtonRelease-1>");
        }
    );
}

$mw->g_bind('<h>', sub { generate_button_click_event() });
$mw->g_bind('<H>', sub { generate_button_click_event() });
$l->g_pack();
$b->g_pack();
Tkx::MainLoop();
say "Program exit...";
于 2021-05-31T10:52:40.163 回答