在 Mac 上使用 Perl 和 Ttk 闪烁 GUI 按钮

如何解决在 Mac 上使用 Perl 和 Ttk 闪烁 GUI 按钮

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

我想要的一项附加功能是视觉反馈当键盘按下（闪烁）的图形按钮使用替代激活。我发现了一个看起来像 Tcl 的东西使用 event generate 命令的解决方案，以及使用 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...

解决方法

这是一个示例（在 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...";