Question

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

我想要实现的是，当鼠标悬停在包含Scrolled的{{1}}之类的小部件上时，用户应该能够使用鼠标滚轮上下滚动。如果鼠标位于小部件本身或小部件侧面的滚动条上方，则鼠标将被视为位于小部件上方。换句话说，如果鼠标位于ListBox上方而不是Scrolled上方。

我在下面提供了一个示例，该示例在鼠标悬停在ListBox上时起作用，但是如果它位于ListBox之外但仍在ListBox上则不起作用。

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

示例脚本

Scrolled

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

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;

仅在鼠标悬停时滚动

1 个答案: