带有嵌入式小部件的 Perl Tk 列表框？答案

【问题标题】：Perl Tk listbox with embeded widgets?带有嵌入式小部件的 Perl Tk 列表框？
【发布时间】：2011-09-19 15:32:10
【问题描述】：

有谁知道 Perl Tk 中是否有一种列表框允许您在列表中拥有一个小部件？例如，我需要一个多列列表框，其中一列包含用户可以选中或取消选中的 Checkbutton 小部件。

【问题讨论】：

标签： perl tk

【解决方案1】：

据我所知，标准列表框小部件仅支持一行字符串作为内容。不要沮丧，因为我们可以轻松构建一个更强大的列表框，其中可以包含小部件！

这是我为程序编写的一些代码。结果如下图（我画的，所以直接从相关文档中取）

提示：
- 我编写的代码是使用 Tcl::Tk 模块在 Perl 中编写的，因此您可以轻松地将其更改为 Perl/Tk
- 如图所示，6个小部件组成一个数组@item，6个@item数组组成一个数组@cur_items，您可以从@cur_items开始在此列表中查找任何小部件（因为您已经知道序列）
- 我使用额外的框架使这些小部件整齐，如果你只想组织两个小部件，可以忽略它们。（但我建议使用框架）
- 请忽略小部件的名称，如 subsubwidget 或 subsubdate，编码人员在繁重的编程压力下很难给出好听的名称 :)

# init - create six items
# each of them contains 5 widgets
for (1..6) {
    my @items = ();

    # create a frame for each item
    # 0 --- LabelFrame --- file name
    # 1 --- label --- icon
    # 2 --- text --- path dir
    # 3 --- label --- date
    # 4 --- label --- size
    # 5 --- button --- preview info
    my $item = $toplevel->Frame(
        -bg => 'white',
    )->pack(
        -in => $toplevel,
        -anchor => 'nw',
        -pady => 10,
    );
    my $widget = $item->LabelFrame(
        -bg => 'white',
        -fg => 'blue',
    )->pack(
        -in => $item,
        -side => 'left',
        -anchor => 'nw',
    );
    push (@items, $widget);
    # file/dire type icon
    my $subicon = $widget->Label(
        -bg => 'white',
    );
    $subicon->pack(
        -in => $widget,
        -side => 'left',
        -anchor => 'center'
    );
    push (@items, $subicon);
    my $subwidget = $widget->Frame(
        -bg => 'white',
    )->pack(
        -in => $widget,
        -side => 'left',
    );
    # file path
    my $subtext = $subwidget->Text(
        -height => 2,
        -width => 39,
        -bg => 'white',
        -borderwidth => 0,
        -wrap => 'char',
    )->pack(
        -in => $subwidget,
        -anchor => 'nw',
    );
    push (@items, $subtext);
    $subtext->configure(-state => 'disabled');
    # date and size
    my $subsubwidget = $subwidget->Frame(
        -bg => 'white',
    )->pack(
        -in => $subwidget,
        -anchor => 'nw',
    );
    my $subsubdate = $subsubwidget->Label(
        -bg => 'white',
        -text => '',
    )->pack(
        -in => $subsubwidget,
        -anchor => 'nw',
        -side => 'left',
    );
    push (@items, $subsubdate);
    my $subsubsize = $subsubwidget->Label(
        -width => 12,
        -bg => 'white',
    )->pack(
        -in => $subsubwidget,
        -anchor => 'nw',
        -side => 'left',
    );
    push (@items, $subsubsize);
    # more info
    my $infobtn = $item->Button(
        -text => '>',
        -width => 0,
        -height => 4,
        -padx => 0,
        -pady => 0,
        -relief => 'flat',
        -bg => 'white',
    )->pack(
        -in => $item,
        -side => 'left',
        -anchor => 's',
    );
    push (@items, $infobtn);

    # record created widget
    push (@cur_items, \@items);
}
# end of init

【讨论】：

【解决方案2】：

Tk::HList 可能是您正在寻找的。见：

http://www.perltk.org/index.php?option=com_content&task=view&id=23&Itemid=28

【讨论】：

它不支持来自what I can see的嵌入式小部件。