3

我正在尝试在使用 Perl TK 开发的 GUI 上提供滚动行为。

我想要实现的是，当鼠标悬停在诸如Scrolled包含 a的小部件上时ListBox，用户应该能够使用鼠标滚轮向上和向下滚动。如果鼠标位于小部件本身或小部件两侧的滚动条上，则鼠标计为在小部件上方。换句话说，如果鼠标在.Scrolled而不仅仅是ListBox.

我在下面包含了一个示例，该示例在鼠标悬停ListBox在.ListBoxScrolled

值得注意的是，对于鼠标滚轮的支持，这是我的示例中特定于 Windows 的。

示例脚本

#!/usr/bin/perl

use strict;
use warnings;
use Tk;

my $mainWindow = new MainWindow;

my $lb = $mainWindow->Scrolled("Listbox", -scrollbars => "osoe")->pack;

$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);

my $lbCanScroll = 0;
$mainWindow->bind('<MouseWheel>' => [sub{ if($lbCanScroll) { $lb->yview('scroll', -($_[1] / 120) * 3, 'units'); } }, Ev('D')]);
$lb->bind('<Leave>' => sub{$lbCanScroll = 0});
$lb->bind('<Enter>' => sub{$lbCanScroll = 1});

MainLoop;

虽然我已经发布了我称之为临时解决方案的内容，但很高兴知道是否有更可重用的方法来实现这一点。

4

1 回答 1

1

作为一个临时解决方案，我可以将它放在一个只存储一个组件的包装器对象中。这允许我绑定到该对象上的EnterandLeave事件。有点像

#!/usr/bin/perl

use strict;
use warnings;
use Tk;

my $mainWindow = new MainWindow;

my $lbHolder = $mainWindow->Pane()->pack;

my $lb = $lbHolder->Scrolled("Listbox", -scrollbars => "osoe")->pack;

$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);
$lb->insert('end', qw/red blue yellow green orange/);

my $lbCanScroll = 0;
$mainWindow->bind('<MouseWheel>' => [sub{ if($lbCanScroll) { $lb->yview('scroll', -($_[1] / 120) * 3, 'units'); } }, Ev('D')]);
$lbHolder->bind('<Leave>' => sub{$lbCanScroll = 0});
$lbHolder->bind('<Enter>' => sub{$lbCanScroll = 1});

MainLoop;
于 2018-09-27T13:49:00.903 回答