仅当鼠标悬停时滚动

Question

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

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

我在下面提供了一个示例，它在鼠标悬停在 ListBox 上时有效，但如果它刚好在 ListBox 之外但它仍在 Scrolled 上则不起作用].

值得注意的是，对于鼠标滚轮的支持，这是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;

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

Answer 1

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

#!/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;

仅当鼠标悬停时滚动

Scroll only when mouse over

windows

perl

tk

perltk