お気楽 Perl/Tkx 超入門

●Ttk Widget の基本

Ttk (Themed Tk) は Tk 8.5 から導入されたテーマ付きウィジェットのこと
Ttk ウィジェットを使うと、テーマの変更で GUI の見た目を切り替えることができる
Ttk には 18 個のウィジェットがあり、そのうちの 12 個は tk にもある

button, checkbutton, entry, frame, label, labelframe
menubutton, panedwindow, radiobutton, scale, scrollbar, spinbox

Ttk にしかないウィジェット
- combobox, notebook, progressbar, separator, sizegrip, treeview
Tk にしかないウィジェット
- canvas, listbox, menu, message
Ttk を使う場合、ウィジェットの名前の前に ttk__ を付ける

Tcl/Tk では名前空間 ttk を使って Ttk を定義している
Tcl/Tk では名前空間のアクセスに :: を使う
たとえば、ボタンを生成するコマンドは ttk::button になる
Tkx では、Tcl/Tk の名前空間 :: を __ に変換する
ボタンを生成するコンストラクタは new_ttk__button になる

基本的なオプションは Tk と同じ
ただし、Tk と Ttk では見た目 (スタイル) を調整するオプション (方法) が異なる
簡単に置き換えることはできないので注意すること

参考 URL

Tk Commands, (Tcl/Tk 8.7 Manual)
TclTk8.5のTtk Widget, (もっとTcl/Tk, 今井智さん)

簡単な使用例 (1)

リスト : Ttk Widget の簡単な使用例

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
Tkx::ttk__style_configure('.', -font => ['', 12]);  # Ttk Widget のフォントの大きさを 12 に変更

my $theme;
if (@ARGV) {
  $theme = shift;
  Tkx::ttk__style_theme_use($theme);
} else {
  $theme = Tkx::ttk__style_theme_use();
}

# ラジオボタン用
my $v = 0;

# チェックボタン用
my @opts = (0, 1, 0, 1);

# テーマ表示用ラベル
my $la = $top->new_ttk__label(-text => $theme);
$la->g_pack;

# ボタン類の配置
my $f0 = $top->new_ttk__labelframe(-text => 'Buttons');
my $f1 = $top->new_ttk__labelframe(-text => 'CheckButtons');
my $f2 = $top->new_ttk__labelframe(-text => 'RadioButtons');
foreach my $x (0 .. 3) {
  $f0->new_ttk__button(-text => "button $x")->g_pack();
  $f1->new_ttk__radiobutton(-text => "radiobutton $x", -value => $x, -variable => \$v)->g_pack;
  $f2->new_ttk__checkbutton(-text => "checkbutton $x", -variable => \$opts[$x])->g_pack;
}

$f0->g_pack(-padx => 5, -pady => 5, -side => 'left');
$f1->g_pack(-padx => 5, -pady => 5, -side => 'left');
$f2->g_pack(-padx => 5, -pady => 5, -side => 'left');

Tkx::MainLoop();

Ttk のテーマやスタイルの設定は Tcl/Tk の ttk::style コマンドを使う
Tkx では名前が ttk__style_サブコマンド名の関数になる
ttk__style_theme_names(), 使用可能なテーマ名を配列に格納して返す
ttk__style_theme_use(name), 引数 name のテーマに切り替える, 引数なしの場合は使用しているテーマを返す

Windows の場合、テーマは標準で 7 つある

winnative, Windows スタイル
clam, Gnome スタイル
alt, GTK+ のデフォルトスタイル
default, X11 スタイル
classic, Motifスタイル
vista, Windows Vista スタイル (デフォルト値)
xpnative, Windows XP スタイル

ttk__style_configure(style, -option => value, ...), style の option を value に設定する
通常 style には Ttk Widget のクラス名を指定する
$widget のクラス名は $widget->g_winfo_class() で取得可能

たとえば、button のクラス名は TButton で、ラベルは TLabel
そのクラスの -option が value になる
Tkx の option_add() と同じ動作

ピリオド '.' はルートを表す (すべての Widget が対象になる)

簡単な使用例 (2)

リスト : Ttk Widget の簡単な使用例

use strict;
use warnings;
use utf8;
use Tkx;

my $top = Tkx::widget->new('.');
Tkx::ttk__style_theme_use('winnative');

Tkx::ttk__style_configure('test1.TLabel', -font => ['遊ゴシック', 12]);
Tkx::ttk__style_configure('test2.TLabel', -font => ['遊ゴシック', 14], -foreground => 'blue');
Tkx::ttk__style_configure('test3.TLabel', -font => ['遊ゴシック', 16, 'italic'], -foreground => 'green');

my $str = 'Hello, world, こんにちは世界';
$top->new_ttk__label(-text => $str, -style => 'test1.TLabel')->g_pack;
$top->new_ttk__label(-text => $str, -style => 'test2.TLabel')->g_pack;
$top->new_ttk__label(-text => $str, -style => 'test3.TLabel')->g_pack;

Tkx::MainLoop();

ttk__syle_configure(style, ...) の style には独自の名前を付けることもできる

名前の付け方は name.class_name (たとえば、Test.TButton など)
Ttk Widget を生成するとき、オプション -style でその名前を指定する
生成した widget のオブジェクトの -option が value になる

なお、Ttk Widget のコンストラクタでも -font や -foreground などのオプションを指定できるようだ

●コンボボックス

コンボボックス (Combo Box) はエントリーとリストボックスを組み合わせたウィジェット
実際には、エントリーの右横に矢印があり、それをクリックするとリストボックスが表示される

これをドロップダウンリストという
なお、コンボボックスをドロップダウンリストと呼ぶこともあるようだ

リストボックスから項目を選択できるほか、キーボードで独自の値を入力できる
コンボボックスは new_ttk__combobox で生成する

$widget->new_ttk__combobox(-option => value, ...);

コンボボックスはエントリーのメソッドやオプションを使用できる

コンボボックスに特有なオプションを下表に示す

表 : コンボボックスのオプション
-height	リストボックスの行数
-width	エントリーの文字数
-state	'normal' : エントリーとリストボックスの両方から入力できる 'readonly' : リストボックスのみ有効 'disabled' : どちらも無効
-values	リストボックスに表示するデータを格納した文字列 (または配列)

主なメソッド
current(index)
values[index] をコンボボックスの値とする。
引数なしの場合はコンボボックスの値を values から検索して位置を返す。values にない場合は -1 を返す。
get(), コンボボックスの値を取得する
set(item), コンボボックスの値を item にする

簡単な使用例

リスト : コンボボックスの使用例

use strict;
use warnings;
use utf8;
use Time::Local ('timelocal');
use Tkx;

my $top = Tkx::widget->new('.');
Tkx::ttk__style_configure('.', -font => ['', 14]);

my $label_buff = '';
my $year_buff = '1970';
my $month_buff = '1';
my $day_buff = '1';

my $la = $top->new_ttk__label(-textvariable => \$label_buff);
$la->g_pack;

$top->new_ttk__label(-text => " 年: ")->g_pack(-side => 'left');
my $year_cb = $top->new_ttk__combobox(-textvariable => \$year_buff, -width => 8, -values => [(1970 .. 2031)]);
$year_cb->g_pack(-side => 'left');

$top->new_ttk__label(-text => " 月: ")->g_pack(-side => 'left');
my $month_cb = $top->new_ttk__combobox(-textvariable => \$month_buff, -width => 8, -height => 12, -values => [(1 .. 12)]);
$month_cb->g_pack(-side => 'left');

$top->new_ttk__label(-text => " 日: ")->g_pack(-side => 'left');
my $day_cb = $top->new_ttk__combobox(-textvariable => \$day_buff, -width => 8, -values => [(1 .. 31)]);
$day_cb->g_pack(-side => 'left');

# 入力データの表示
sub get_item {
  my $y = $year_cb->get();
  my $m = $month_cb->get();
  my $d = $day_cb->get();
  eval {
    timelocal(0, 0, 0, $d, $m - 1, $y - 1900);
  };
  if ($@) {
    $label_buff = "Input Error";
  } else {
    $label_buff = "$y 年 $m 月 $d 日";
  }
}

$year_cb->g_bind('<<ComboboxSelected>>', \&get_item);
$year_cb->g_bind('<Return>', \&get_item);
$month_cb->g_bind('<<ComboboxSelected>>', \&get_item);
$month_cb->g_bind('<Return>', \&get_item);
$day_cb->g_bind('<<ComboboxSelected>>', \&get_item);
$day_cb->g_bind('<Return>', \&get_item);

get_item();

Tkx::MainLoop();

リストボックスから項目を選択したとき、仮想イベント <ComboboxSelected> が生成される
このイベントに関数 get_item をバインドする
エントリーでデータ入力してリターンキーを押しても ComboboxSelected は生成されない
そこで、エントリーではイベント <Return> に get_item をバインドしている
get_item は Time::Local の関数 timelocal で日付が正しいかチェックしている
timelocal は引数を日付型データに変換できない場合は例外を送出する
eval で例外を捕捉したらラベルに Input Error を表示する

初期状態

日付の入力

エラー

●ノートブック

ノートブック (Notebook) は複数のウィジェットを格納し、表示するウィジェットをタブで切り替える
タブブラウザ (Tabbed Browser) と同様の動作
ノートブックは new_ttk__notebook で生成する
ノートブックにウィジェットを配置するにはメソッド add($widget, -option => value, ...) を使う
追加した $widget はタブ識別子として使用できる

整数 (0 - タブ数-1) でもよい
現在選択されているタブは 'current' で指定できる

タブの名前はオプション -text で指定する
この他にも -state, -sticky, -padding などいくつかオプションがある
タブを選択したとき仮想イベント <NotebookTabChanged> が生成される

簡単な使用例 (1)

リスト : ノートブックの使用例 (1)

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');

Tkx::ttk__style_configure("TButton", -font => ['', 16]);
Tkx::ttk__style_configure("TRadiobutton", -font => ['', 16]);
Tkx::ttk__style_configure("TCheckbutton", -font => ['', 16]);

my $v = 0;
my @opts = (1, 1, 1, 1);

# ノートブック
my $nb = $top->new_ttk__notebook;
$nb->g_pack;

# ボタン類の配置
my $f0 = $top->new_ttk__frame;
my $f1 = $top->new_ttk__frame;
my $f2 = $top->new_ttk__frame;
foreach my $x (0 .. 3) {
  $f0->new_ttk__button(-text => "button $x")->g_pack;
  $f1->new_ttk__radiobutton(-text => "radiobutton $x", -value => $x, -variable => \$v)->g_pack;
  $f2->new_ttk__checkbutton(-text => "checkbutton $x", -variable => \$opts[$x])->g_pack;
}

$nb->add($f0, -text => 'Button', -padding => 20);
$nb->add($f1, -text => 'Radio', -padding => 20);
$nb->add($f2, -text => 'Check', -padding => 20);

Tkx::MainLoop();

初期状態 (Button が選択されている)

Radio を選択

Check を選択

簡単な使用例 (2)

リスト : ノートブックの使用例 (2)

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
Tkx::option_add('*Text.font', ['', 14]);

# 生成したテキストウィジェットの個数
my $text_count = 0;

# ノートブック
my $nb = $top->new_ttk__notebook;

# テキストウィジェットを追加
sub new_text {
  my $tw = $top->new_text(-width => 40, -height => 10);
  $text_count += 1;
  $nb->add($tw, -text => "Memo$text_count");
  $nb->select($tw);
}

# テキストウィジェットを削除
sub del_text {
  $nb->forget('current');
}

# ボタン
my $fr = $top->new_ttk__frame;
$fr->new_ttk__button(-text => 'New', -command => \&new_text)->g_pack(-side => 'left');
$fr->new_ttk__button(-text => 'Del', -command => \&del_text)->g_pack(-side => 'left');

# 配置
$fr->g_pack(-anchor => 'w');
$nb->g_pack;

Tkx::MainLoop();

ボタン New を押すとノートブックにテキストウィジェットを挿入する
ボタン Del を押すとカレントタブのテキストウィジェットを削除する
テキストの挿入は関数 add_text で行う
add で挿入しても、カレントタブは変化しない
テキスト $tw を add で挿入したあと、メソッド select($tw) でカレントタブを変更する
ウィジェットの削除はメソッド forget で行う
ウィジェットを隠すメソッド hide もある (add() で復活する)
この他にもタブを操作するメソッドがいろいろ用意されている

初期状態

Memo1 を生成

Memo2 を生成

Memo3 を生成して Memo2 を削除

●プログレスバー

プログレスバー (progressbar) は時間がかかる処理で進捗状況を表示するためのウィジェット
水平方向のバーで進捗率を表すものが一般的
プログレスバーは new_ttk__progressbar で生成する
主なオプション

-orient, バーの方向 ('horizontal' が水平 [デフォルト], 'vertical' が垂直)
-length, バーの長さ
-mode, 動作モード

'determinate', 進捗状況を確定的に表す (バーが一方向に伸びていく) [デフォルト]
'indeterminate', 処理が進行中であることを表す (ブロックが左右 (上下) に繰り返し移動する)

-maximum, 最大値 [デフォルトは 100]
-value, プログレスバーの値
-variable, 値を格納するオブジェクトを指定

値を書き換えるとプログレスバーに反映される

メソッド

start(msec), 自動増加モードを開始 (msec [デフォルトは 50 msec] ごとに step() を呼び出す
step(amount), 値を amount だけ増やす (引数なしは 1.0 だけ増える)
stop(), 自動増加モードを停止する

自動増加モードは indeterminate モードで使うとよい

簡単な使用例

リスト : プログレスバーの使用例

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
my $var = 0;
my $pb1_id = '';

sub exec_pb1 {
  $var++;
  if ($var < 100) {
    $pb1_id = Tkx::after(40, \&exec_pb1);
  }
}

sub start_pb1 {
  $var = 0;
  exec_pb1();
}

sub stop_pb1 {
  if ($pb1_id) {
    Tkx::after_cancel($pb1_id);
    $pb1_id = '';
  }
}

my $pb1 = $top->new_ttk__progressbar(-length => 200, -variable =>\$var);
my $pb2 = $top->new_ttk__progressbar(-length => 200, -mode => 'indeterminate');
$pb1->g_pack;

my $f1 = $top->new_ttk__frame;
$f1->new_ttk__button(-text => 'Start', -command => \&start_pb1)->g_pack(-side => 'left');
$f1->new_ttk__button(-text => 'Stop', -command => \&stop_pb1)->g_pack(-side => 'left');
$f1->g_pack;

$pb2->g_pack;
my $f2 = $top->new_ttk__frame;
$f2->new_ttk__button(-text => 'Start', -command => [$pb2, 'start', 10])->g_pack(-side => 'left');
$f2->new_ttk__button(-text => 'Stop',  -command => [$pb2, 'stop'])->g_pack(-side => 'left');
$f2->g_pack;

Tkx::MainLoop();

$pb1 は determinate, $pb2 は indeterminate で動作する
どちらも下のボタン Start で動作開始、Stop で動作停止する
$pb2 は自動増加モードを使っている
$pb1 は関数 exec_pb1 で 40 msec ごとにプログレスバーの値を 1 増やしている
exec_pb1 を while ループで実装すると $pb1 と $pb2 は平行に動作しなくなるので注意すること

初期状態

途中経過

pb1 が終了し、pb2 を停止した状態

●ツリービュー

ツリービュー (Tree view) は階層的なデータ構造 (木構造、Tree structure) を表示するためのウィジェット
ツリービューの見た目は N 行 M 列の表 (table)
一番左側の列 (ツリーカラム) が木を表していて、残りの列はデータを表示するためのもの

簡単にいうと、ツリーカラムは節 (Node) を表示し、残りのカラムは葉 (Leaf) に格納されているデータを表示する

実際には、節にもデータを持たせることができる
その場合は、そのデータが残りのカラムに表示される

節を表す項目には左側に記号 (Windows の場合は +) が付いている
それをクリックすると、記号が変化 (Windows の場合は -) して、その下に節が保持している子を表示する
記号を再度クリックすると表示は元に戻る

ツリービューは new_ttk__treeview で生成する
オプション -columns でツリーカラムを除いたカラムの名前を指定する

これがカラム識別子 (column id) になる
カラム識別子は整数 0 - n や文字列 '#0' - '#n' でもよい
0 や '#0' はツリーカラムを表す

カラムの設定や問い合わせはメソッド column(column_id, option_name, -option => value, ...) で行う
第 2 引数 option_name を指定すると、そのカラムのオプション値が返される
主なオプション

-id, カラム名を返す
-anchor, テキストの配置 (Tk と同じ)
-minwidth, カラムの最小幅
-stretch, ウィンドウをリサイズしたときカラムを引き延ばすか (真偽値)
-width, カラムの幅
-xscrollcommand, -yscrollcommand, スクロールバーの設定

カラムのヘッダの設定や問い合わせはメソッド heading(column_id, option_name, -option => value, ...) で行う
第 2 引数 option_name を指定すると、そのヘッダのオプション値が返される
主なオプション

-text, 見出し
-anchor, 見出しの配置 (Tk と同じ)
-command, 見出しをクリックしたときに呼び出されるコールバック関数

メソッド insert(parent, index, iid, -option => value, ...) は新しい子 (要素) を生成する
insert は要素の識別子を返す
生成した要素は親節 parent の index 番目に挿入される

末尾に追加する場合は 'end' を指定する

ルートは空文字列 '' で表す
引数 iid は生成した要素に付ける識別子を指定する
主なオプション

-text, 要素の名前
-values, 要素の値を格納したタプル (or リスト)
-open, 要素の子を表示するか否か
-tags, タグ

簡単な使用例 (1)

リスト : ツリービューの簡単な使用例 (1)

use strict;
use warnings;
use utf8;
use Tkx;

my $top = Tkx::widget->new('.');
Tkx::ttk__style_configure('.', -font => ['', 12]);

my $tview = $top->new_ttk__treeview(-columns => ['Name', 'Height']);
$tview->column('#0', -width => 50);
$tview->column('Name', -anchor => 'w', -width => 100);
$tview->column('Height', -anchor => 'e', -width => 50);
$tview->heading('#0', -text => "クラス");
$tview->heading('Name', -text => "名前");
$tview->heading('Height', -text => "身長");

my $id = $tview->insert('', 'end', -text => 'A');
$tview->insert($id, 'end', -values => ['Ada', 148.7]);
$tview->insert($id, 'end', -values => ['Hanna', 154.2]);
$tview->insert($id, 'end', -values => ['Miranda', 148.2]);

$id = $tview->insert('', 'end', -text => 'B');
$tview->insert($id, 'end', -values => ['Alice', 149.5]);
$tview->insert($id, 'end', -values => ['Janet', 147.8]);
$tview->insert($id, 'end', -values => ['Sara', 153.1]);

$id = $tview->insert('', 'end', -text => 'C');
$tview->insert($id, 'end', -values => ['Carey', 133.7]);
$tview->insert($id, 'end', -values => ['Linda', 154.6]);
$tview->insert($id, 'end', -values => ['Tracy', 138.2]);

$id = $tview->insert('', 'end', -text => 'D');
$tview->insert($id, 'end', -values => ['Ellen', 157.9]);
$tview->insert($id, 'end', -values => ['Maria', 159.1]);
$tview->insert($id, 'end', -values => ['Violet', 138.7]);

my $sb = $top->new_ttk__scrollbar(-orient => 'v', -command => [$tview, 'yview']);
$tview->configure(-yscrollcommand => [$sb, 'set']);

$tview->g_pack(-side => 'left');
$sb->g_pack(-side => 'left', -fill => 'y');

Tkx::MainLoop();

クラスごとに女生徒の名前と身長を表示する
new_ttk__treeview のオプション -columns には ['Name', 'Height'] を指定する
メソッド column と heading でカラムと見出しの設定を行う
クラスは A, B, C, D の 4 つ
クラスを表す要素はルートに追加する
そして、これらの要素に女生徒のデータを格納した要素を追加する

初期状態

クラス A を表示

クラス A と C を表示

全クラスを表示

ツリービューはマウスの左クリックで要素を選択できる

Ctrl Key + 左クリックで複数の要素を選択
要素を選択したあと、Shift Key + 左クリックでその範囲の要素をすべて選択

要素を選択したとき仮想イベント <TreeviewSelect> が生成される

実際には、左クリックするたびにイベントが発生する

選択した要素はメソッド selection で取得できる

返り値は要素の識別子を格納したリスト (文字列)

要素のオプション値はメソッド item で取得や変更ができる
要素のカラム値はメソッド set でアクセスする

set(item, column, value);

引数 column, value を省略するとカラム識別子と値を格納したリスト (文字列) を返す
column だけを指定すると、そのカラム値
column と value を指定すると、column の値を value に更新する

簡単な使用例 (2)

リスト : 身長の更新機能を追加

use strict;
use warnings;
use utf8;
use Tkx;

my $top = Tkx::widget->new('.');
Tkx::ttk__style_configure('.', -font => ['', 12]);

my $buff1 = '        ';
my $buff2 = '';
my $select_item = '';

my $fr = $top->new_ttk__frame;
$fr->new_ttk__label(-textvariable => \$buff1)->g_pack(-side => 'left');
my $e = $fr->new_ttk__entry(-width => 8, -textvariable => \$buff2);
$e->g_pack(-side => 'left');
$fr->g_pack(-anchor => 'w');

my $tview = $top->new_ttk__treeview(-columns => ['Name', 'Height']);
$tview->column('#0', -width => 50);
$tview->column('Name', -anchor => 'w', -width => 100);
$tview->column('Height', -anchor => 'e', -width => 50);
$tview->heading('#0', -text => "クラス");
$tview->heading('Name', -text => "名前");
$tview->heading('Height', -text => "身長");

my $id = $tview->insert('', 'end', -text => 'A');
$tview->insert($id, 'end', -values => ['Ada', 148.7]);
$tview->insert($id, 'end', -values => ['Hanna', 154.2]);
$tview->insert($id, 'end', -values => ['Miranda', 148.2]);

$id = $tview->insert('', 'end', -text => 'B');
$tview->insert($id, 'end', -values => ['Alice', 149.5]);
$tview->insert($id, 'end', -values => ['Janet', 147.8]);
$tview->insert($id, 'end', -values => ['Sara', 153.1]);

$id = $tview->insert('', 'end', -text => 'C');
$tview->insert($id, 'end', -values => ['Carey', 133.7]);
$tview->insert($id, 'end', -values => ['Linda', 154.6]);
$tview->insert($id, 'end', -values => ['Tracy', 138.2]);

$id = $tview->insert('', 'end', -text => 'D');
$tview->insert($id, 'end', -values => ['Ellen', 157.9]);
$tview->insert($id, 'end', -values => ['Maria', 159.1]);
$tview->insert($id, 'end', -values => ['Violet', 138.7]);

my $sb = $top->new_ttk__scrollbar(-orient => 'v', -command => [$tview, 'yview']);
$tview->configure(-yscrollcommand => [$sb, 'set']);

$tview->g_pack(-side => 'left');
$sb->g_pack(-side => 'left', -fill => 'y');

# 生徒の選択
sub select_student {
  my @x = Tkx::SplitList($tview->selection());
  my %d = Tkx::SplitList($tview->set($x[0]));   # 配列を辞書に変換する
  if (%d) {
    $buff1 = sprintf("%8s", $d{'Name'});
    $buff2 = $d{'Height'};
    $select_item = $x[0];
  } else {
    $buff1 = '        ';
    $buff2 = '';
    $select_item = '';
  }
}

# 身長の更新
sub update_height {
  if ($select_item) {
    $tview->set($select_item, 'Height', $buff2);
  }
}

# バインディング
$e->g_bind('<Return>', \&update_height);
$tview->g_bind('<<TreeviewSelect>>', \&select_student);

Tkx::MainLoop();

身長を更新する機能を追加する
生徒を選択すると、ラベルに名前を、エントリーに身長を表示する
エントリーで身長を書き換えてリターンキーを押すと、ツリービューの値が更新される

Alice を選択

エントリーで身長を入力

リターンキーで更新

Perl/Tk memo

お気楽 Perl/Tkx 超入門

●Ttk Widget の基本

●コンボボックス

●ノートブック

●プログレスバー

●ツリービュー