2015-06-02 2 views
4

Я делаю простое приложение с использованием Perl Tkx и позволяю пользователю выбирать каталог. Вместо того, чтобы использовать перенос текста или растягивание окна до смешной длины, чтобы показать полное имя каталога, если имя слишком длинное, я бы хотел усечь его и добавить «...» до конца.Как получить «ширину» строки, которая будет использоваться в метке Tkx

Проблема в том, что ширина метки определяется как произвольное значение (например, 40). Если это значение было измерением количества символов, которое может поместить ярлык, я мог бы просто обрезать строку до 37 и добавить «...», но это, похоже, не так.

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


РЕДАКТИРОВАТЬ:

Я нашел этот ответ в tcl manual: Класс

База данных: Ширина определяет требуемую ширину для метки. Если на этикетке отображается изображение или растровое изображение , то это значение находится в блоках экрана (то есть в любой форме, приемлемой для Tk_GetPixels); для текст в символах.

Если эта опция не указана, желаемая ширина метки вычисляется по размеру изображения или растровому изображению или тексту, отображаемым в нем.

Это должно означать, что для ширины 40 для усечения текста мне нужно просто усечь строку до 37 символов и добавить «...».

Я проверил это, заполнив ярлык всеми «М». Я использовал букву «М», потому что она обычно является самым широким символом (see here). Я написал код, чтобы усечь на 37 "М" и добавить «...» до конца, но «М», кажется, переполняется мимо конца метки примерно через 24 М.

Это означает, что небезопасно предполагать, что он просто растягивает ярлык до 40 самых широких символов ... таким образом, мой вопрос по-прежнему остается без ответа.

Как определить «ширину» моей строки, чтобы я мог усечь ее соответствующим образом?


EDIT2:

Я нашел обходной путь, но это еще не решение, которое я искал. Если вы измените текст на ярлыке на шрифт с фиксированной шириной, он будет работать правильно. Это не выглядит так приятно, хотя мне бы очень понравилось решение, которое работает с шрифтами нефиксированной ширины.

ответ

5

Когда документы говорят, что -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; 
} 
+1

Вау, это блестящее решение! Я тестировал его, и он работает как шарм и очень быстро! Очень впечатляюще. Слишком плохо, что не слишком много людей смотрят на вопросы Perl Tkx, и это не привлечет большого внимания ... Я бы многократно повышал, если мог. – tjwrona1992

+0

Кстати, он по-прежнему работает без 'Tkx :: package_require ('tile');'. – tjwrona1992

+0

'Tkx :: package_require ('tile')' есть, потому что я использовал версию виджета метки Ttk. Независимо от того, требуется ли это, зависит от того, какую версию Tk вы используете; материал плитки встроен с Tk 8.5. Это версия ActiveState в комплекте с ActivePerl как tkkit, поскольку они ввели Tkx в Perl 5.10, поэтому, если вы не привязываетесь к своей собственной установке старой версии интерпретатора Tcl, вам это не нужно. Вероятно, я должен привыкнуть к этому. :) –

Смежные вопросы