Как да получите ширината на низ, който да се използва в Tkx етикет

Правя просто приложение с помощта на Perl Tkx и позволявам на потребителя да избере директория. Вместо да използвам обвиване на текст или разтягане на полето до нелепа дължина, за да покажа цялото име на директорията, ако името е твърде дълго, бих искал да го съкратя и да добавя "..." към края.

Проблемът е, че ширината на етикета е определена като произволна стойност (като 40). Ако тази стойност беше мярка за това колко знака може да побере етикетът, можех просто да съкратя низа до 37 и да добавя "...", но това не изглежда да е така.

Някой знае ли какво всъщност е измерването на -width на етикет, използващ Perl Tkx? Как мога да намеря количеството -width единици, които моят низ ще заеме, за да мога да разбера къде е подходящата точка за съкращаването му?

РЕДАКТИРАНЕ:

Намерих този отговор в tcl ръководство:

Клас на базата данни: Ширина Указва желана ширина за етикета. Ако изображение или растерно изображение се показва в етикета, тогава стойността е в екранни единици (т.е. всяка от формите, приемливи за Tk_GetPixels); за текст е в знаци.

Ако тази опция не е зададена, желаната ширина на етикета се изчислява от размера на изображението, растерното изображение или текста, които се показват в него.

Това трябва да означава, че за ширина от 40, за да съкратя текста, трябва просто да съкратя низа до 37 знака и да добавя "...".

Тествах това, като попълних етикета с всички "M". Използвах буквата „M“, защото обикновено е най-широкият знак (вижте тук). Написах код за съкращаване на 37 "M" и добавяне на "..." към края, но "M" изглежда преливат след края на етикета след около 24 "M".

Това означава, че не е безопасно да се предположи, че той просто разтяга етикета, за да пасне на 40 от най-широкия знак... следователно въпросът ми все още е без отговор.

Как мога да определя „ширината“ на моя низ, за ​​да мога да го съкратя по подходящ начин?

РЕДАКТИРАНЕ 2:

Намерих решение, но все още не е решението, което търсех. Ако промените текста на етикета на шрифт с фиксирана ширина, той ще работи правилно. Въпреки това не изглежда толкова добре, така че наистина бих искал решение, което работи за шрифтове без фиксирана ширина.


user-interface string truncate perl tkx
person tjwrona1992    schedule 02.06.2015    source източник

Отговори (1)


arrow_upward
5
arrow_downward

Когато в документите се казва, че -width за етикети се интерпретира като брой знаци, вероятно се използва средната ширина на знак, а не максималната ширина. Както открихте, когато използвате шрифтове с фиксирана ширина, можете да работите със знаци и всичко ще излезе добре. Когато използвате шрифтове с променлива ширина, нещата стават трудни бързо, защото няма фиксирана връзка между знаци и пиксели.

Трябва да работите в последователни единици (т.е. пиксели) и да съкращавате текста, докато се побере – за предпочитане с добро първоначално предположение, за да запазите кода си бърз. Можете да получите ширината на етикета в пиксели чрез winfo reqwidth и ширината на текста в пиксели (за определен шрифт) с font measure.

use strict;
use warnings;
use Tkx;
Tkx::package_require('tile');

my $text;
my $mw    = Tkx::widget->new('.');
my $label = $mw->new_ttk__label(-width => 10, -textvariable => \$text);

Tkx::pack($label, -side => 'left');

$text = limit_text($label, 'abcdefghijklmnopqrstuvwxyz');

Tkx::MainLoop;

sub limit_text {
    my $label       = shift;
    my $text        = shift;
    my $font        = $label->cget('-font') || 'TkDefaultFont';
    my $label_width = $label->g_winfo_reqwidth;
    my $text_width  = Tkx::font_measure($font, $text);
    my $i           = int length($text) * ($label_width / $text_width);

    while ($text_width > $label_width) {
        $text       = substr($text, 0, --$i) . '...';
        $text_width = Tkx::font_measure($font, $text);
    }
    return $text;
}
person Michael Carman    schedule 03.06.2015
comment
Уау, това е брилянтно решение! Тествах го и работи като чар и е много бърз! Много впечатляващо. Жалко, че не много хора разглеждат въпросите за Perl Tkx и това няма да привлече много внимание... Бих гласувал многократно, ако можех. - person tjwrona1992; 03.06.2015
comment
Между другото, изглежда, че все още работи без Tkx::package_require('tile');. - person tjwrona1992; 03.06.2015
comment
Tkx::package_require('tile') е там, защото използвах Ttk версията на приспособлението за етикети. Дали е необходимо или не зависи от това коя версия на Tk използвате; плочките са вградени от Tk 8.5. Това е версията, която ActiveState включва с ActivePerl като tkkit, откакто представиха Tkx в Perl 5.10, така че освен ако не се обвързвате към вашата собствена инсталация на стара версия на Tcl интерпретатора, нямате нужда от нея. Вероятно трябва да се откажа от навика да го включвам. :) - person Michael Carman; 03.06.2015
comment
Уау умът ти е като Perl/Tk речник! Благодаря за помощта :) - person tjwrona1992; 03.06.2015