Perl/Tk memo

●メッセージボックス

• ダイアログ (dialog) は重要なメッセージを表示するために開かれるウィンドウ
• ユーザーがダイアログに応答しない限り、そのアプリケーションでは他の操作を行うことはできない
• Tcl/Tk はコマンド tk_messagebox を使って簡単にダイアログを表示することができる
• このコマンドにはウィジェット名 (パス) を指定する必要はない
• メッセージを表示してボタンが押されるのを待つだけ
• Tkx では関数 tk___messagebox を使う
• tk___messagebox に用意されているオプションを下表に示す

• tk___messageBox は押されたボタンの種類を文字列で返す
• たとえば、種別に yesno を指定した場合、「はい」のボタンを押せば yes という文字列を返す
• 簡単な使用例

リスト : tk___messagebox のサンプル

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

my $icon = 'info';
my $type = 'ok';

# 画面の設定
my $top = Tkx::widget->new('.');
Tkx::option_add('*font', ['', 14]);
Tkx::option_add('*tearOff', 0);

# ウィンドウの生成
sub message_window {
  Tkx::tk___messageBox(-type => $type, -icon => $icon, -title => 'About',
                       -message => 'tk___messageBox のサンプルプログラムです');
}

# メニューの設定
my $m = $top->new_menu(-type => 'menubar');
$top->configure(-menu => $m);
$m->add_command(-label => 'About', -under => 0, -command => \&message_window);
my $m1 = $m->new_menu;
$m->add_cascade(-menu => $m1, -label => 'Type', -under => 0);
my $m2 = $m->new_menu;
$m->add_cascade(-menu => $m2, -label => 'Icon', -under => 0);

# メッセージボックスのボタンを指定するメニュー
$m1->add_radiobutton(-label => 'ok', 
                     -variable => \$type, -value => 'ok');
$m1->add_radiobutton(-label => 'ok, cancel', 
                     -variable => \$type, -value => 'okcancel');
$m1->add_radiobutton(-label => 'yes, no', 
                     -variable => \$type, -value => 'yesno');
$m1->add_radiobutton(-label => 'yes, no, cancel', 
                     -variable => \$type, -value => 'yesnocancel');
$m1->add_radiobutton(-label => 'retry, cancel', 
                     -variable => \$type, -value => 'retrycancel');
$m1->add_radiobutton(-label => 'abort, retry, ignore', 
                    -variable => \$type, -value => 'abortretryignore');

# メッセージボックスのアイコンを指定するメニュー
$m2->add_radiobutton(-label => 'info', -variable => \$icon, -value => 'info');
$m2->add_radiobutton(-label => 'error', -variable => \$icon, -value => 'error');
$m2->add_radiobutton(-label => 'question', -variable => \$icon, -value => 'question');
$m2->add_radiobutton(-label => 'warning', -variable => \$icon, -value => 'warning');

$top->new_label(-text => 'メニュー About を選んでね')->g_pack;

Tkx::MainLoop();

• -messaage の文字列はそのまま表示される
• 文字列中に改行文字を含めれば、複数行に渡って表示することができる
• -type と -icon はメニューで選ぶようにプログラムしたので、いろいろ試してみてほしい

メインウィンドウの画像

メッセージボックス (info, ok) の画像

メッセージボックス (warning, yes/no) の画像

●キャンバス

• キャンバス (canvas) ウィジェットは、矩形、直線、楕円などの図形のほかに、イメージ、文字列、任意のウィジェットを表示できる
• キャンバスウィジェットは new_canvas で生成する
• 次のプログラムを実行すると、空のウィンドウが表示される

リスト : キャンバスウィジェット

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
my $c0 = $top->new_canvas(-width => 150, -height => 150);
$c0->g_pack;

Tkx::MainLoop();

• これで図形を表示するキャンバスをウィンドウに配置したことになる
• また、キャンバスとスクロールバーを組み合わせて、表示範囲を変更することもできる

空のキャンバス

• 図形を描画するメソッドを下表に示す

• 図形を描画するメソッドは、図形を表す番号 (ID) を返す
• これを使って図形を操作する
• ウィジェットの cget や configure に対応するメソッドが itemcget() と itemconfigure()

• 楕円

リスト : 楕円の描画

use strict;
use warnings;
use Tkx;

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

my $c0 = $top->new_canvas(-width => 150, -height => 150);
my $id = $c0->create_oval(10, 10, 140, 140);

# $c0->itemconfigure($id, -fill => 'red');

$c0->g_pack;

Tkx::MainLoop();

• 楕円の場合、指定した矩形に内接するように描画される
• $c0->itemconfigure($id, -fill => 'red') を追加すると楕円の中を赤色に塗りつぶす
• よく使われるオプションには次のものがある
• -fill => 内部を塗りつぶす色
• -stipple => ビットマップ (内部を塗りつぶすときの模様になるビットマップ)
• -outline => 枠の色
• -width => 枠の幅 (デフォルトは 1.0)

楕円の描画

楕円の描画 (塗りつぶし)

• 矩形

リスト : 矩形の描画

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
my $c0 = $top->new_canvas(-width => 150, -height => 150);
$c0->create_rectangle(10, 10, 140, 140, -fill => 'green');

$c0->g_pack;

Tkx::MainLoop();

• 矩形も楕円と同じ指定方法
• stipple には、Tk に標準で組み込まれているビットマップを指定するのが一般的
• よく使うビットマップが灰色の模様を表す gray12, gray25, gray50, gray75 など

矩形の描画 (stipple なし)

矩形の描画 (-stipple => 'gray25' を追加)

• 直線

リスト : 直線の描画

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
my $c0 = $top->new_canvas(-width => 150, -height => 150);
my $id = $c0->create_line(10, 10, 140, 10, 10, 140, 140, 140);

$c0->g_pack;

Tkx::MainLoop();

• 2 点間だけではなく複数の点を指定すると、その間を直線で結ぶ
• 直線の場合、線の色は -outline ではなくて -fill で指定する
• 太さは -width で指定する
• オプション -smooth を真 (1) に指定すると、滑らかな曲線を描画することができる
• このほかにも、矢印の設定や折り返しのときの形など、いろいろなオプションが用意されてる

直線の描画

直線の色と太さを変更

直線の描画(-smooth => 1)

• 多角形

リスト : 多角形の描画

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
my $c0 = $top->new_canvas(-width => 150, -height => 150);
my $id = $c0->create_polygon(75, 10, 140, 70, 110, 140, 40, 140, 10, 70, -smooth => 1);

$c0->g_pack;

Tkx::MainLoop();

• 多角形 (polygon) は各頂点の座標を指定し、最初の点と最後の点が結ばれて閉じた図形になる
• デフォルトで -fill オプションが黒、outline は描画されない
• -smooth を真 (1) に指定すると、多角形の角を丸める

多角形の描画

多角形の描画 (-smooth => 1)

• 円弧

リスト : 円弧の描画

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
my $c0 = $top->new_canvas(-width => 400, -height => 200);

my $r = 0;
foreach my $c ('red', 'blue', 'green', 'pink', 'cyan', 'yellow', 
               'magenta', 'brown', 'orange', 'white', 'gray', 'black') {
    $c0->create_arc(10, 10, 390, 190, -start => $r, -extent => 30, -fill => $c);
    $r += 30;
}

$c0->g_pack;

Tkx::MainLoop();

• create_arc は楕円の円周の一部分を表示する
• 座標の指定は create_oval と同じ
• オプションで表示する範囲を指定する
• -start => 角度, 開始位置を角度で指定
• -extent => 角度, 終了位置を開始位置からの角度で指定
• -style => 種別
  arc : 円周のみ描画
  chord : 円周と始点終点を結ぶ線分
  pieslice : 円周と中心から始点、終点を結ぶ線分
• 角度は度数でプラスが反時計回り、マイナスが時計回り
• create_oval と同じオプションが使えるが、-style が arc のとき -fill は無効

円弧の描画

• イメージ

リスト : イメージの表示

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
my $c0 = $top->new_canvas(-width => 400, -height => 300);

my $image = Tkx::image_create_photo(-file => 'earth.gif');
$c0->create_image(200, 150, -image => $image);

$c0->g_pack;

Tkx::MainLoop();

• キャンバスはイメージとビットマップも表示することができる

$c0->create_image(x, y, オプション, ... )
$c0->create_bitmap(x, y, オプション, ... )

• x, y は表示する座標を表す
• イメージのどの位置に対応させるかは、オプション -anchor で指定する (g_pack と同じ)
• データとの対応は image と bitmap で指定する

イメージの描画

• 文字列の表示

リスト : テキストの表示

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
my $c0 = $top->new_canvas(-width => 150, -height => 150);
my $id = $c0->create_text(75, 75, -text => 'hello, world!', -font => ['', 14]);

$c0->g_pack;

Tkx::MainLoop();

• create_text でキャンバスに文字を描くことができる

$c0->create_text(x, y, オプション, ...);

• x, y は座標
• オプションには次のものが使える
• -anchor => 位置 (座標とテキストの位置関係)
• -font => フォント
• -fill => 色
• -justify => mode (center:中揃え, left:左揃え, right:右揃え)
• -text => 文字列
• -width => 長さ

テキストの描画

• ウィジェット

リスト : ラベルウィジェットの表示

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
my $c0 = $top->new_canvas(-width => 150, -height => 150);
my $label = $top->new_label(-text => 'hello, world!', -bg => 'green', -font => ['', 14]);
$c0->create_window(75, 75, -window => $label);

$c0->g_pack;

Tkx::MainLoop();

• キャンバスの中にほかのウィジェットを表示させる場合はメソッド create_window を使う

$c0->create_window(x, y, オプション, ...)

• x, y は座標
• オプションには次のものが使える
• -anchor => 位置 (座標とウィジェットの位置関係)
• -window => 表示するウィジェット
• -width => ウィジェットの幅
• -height => ウィジェットの高さ

ラベルの描画

• 図形を操作するときによく使うメソッドを下表に示す

●タグとバインド

• 図形にバインディングを設定するには bind を使う

リスト : バインディングの設定 (1)

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
my $c0 = $top->new_canvas(-width => 200, -height => 150);
my $id = $c0->create_rectangle(10, 10, 20, 20, -fill => 'brown');

# 移動
sub move_rect {
    my ($x, $y) = @_;
    $c0->coords($id, $x - 5, $y - 5, $x + 5, $y + 5);
}

# バインディング
$c0->bind($id, "<B1-Motion>" => [\&move_rect, Tkx::Ev('%x', '%y')]);

$c0->g_pack;

Tkx::MainLoop();

• 一辺の長さが 10 の矩形を作り、その矩形に対してバインディングを設定する
• イベント <B1-Motion> はドラッグに対応する
• 関数 move_rect では、新しい座標を計算してから、図形の位置を coords で変更する

初期状態

矩形をドラッグで移動する

• 図形には複数のタグ (tag) を設定することができる
• タグには荷札という意味があり、図形に識別子をつける働きをする
• 図形を操作するコマンドは、操作対象となる図形の指定を、番号のほかにもタグを使って行うことができる
• タグの設定は、図形を生成するときにオプション -tags で行う
• 簡単な使用例

リスト : バインディングの設定 (2)

use strict;
use warnings;
use Tkx;

my $top = Tkx::widget->new('.');
my $c0 = $top->new_canvas(-width => 200, -height => 150);

$c0->create_rectangle(10, 10, 20, 20, -fill => 'brown', -tags => 'brown');
$c0->create_rectangle(20, 10, 30, 20, -fill => 'brown', -tags => 'brown');
$c0->create_rectangle(30, 10, 40, 20, -fill => 'brown', -tags => 'brown');

# 移動
sub move_rect {
    my ($x, $y) = @_;
    $c0->coords('current', $x - 5, $y - 5, $x + 5, $y + 5);
}

# バインディング
$c0->bind('brown', "<B1-Motion>" => [\&move_rect, Tkx::Ev('%x', '%y')]);

$c0->g_pack;

Tkx::MainLoop();

• 3 つの矩形に共通のタグを設定し、それを使って操作する
• タグは文字列で指定する (今回は brown)
• バインディングを設定する場合、図形の番号ではなくタグ brown を指定する
• ただし、このままでは関数 move_rect() で操作対象となる矩形がわからない
• この場合、特別なタグ current を使う
• current は Perl/Tkx が設定するタグ
• マウスカーソルがある図形上にくると、その図形にタグ current を設定する
• その図形からマウスカーソルから出るとタグ current を削除する
• つまり、マウスカーソルが指している図形はタグ current で指定することができる
• これで、複数の矩形をひとつの関数で操作することができる
• タグを使うと図形をまとめて操作することができる
• 矩形の色をまとめて変更する場合

$c0->itemconfigure('brown', -fill => 'green');

• 削除する場合

$c0->delete('brown');

• これでタグ brown の図形をすべて削除することができる

初期状態

矩形をドラッグで移動する

●トップレベルウィンドウとメッセージ

• メインウィンドウ ($top) と連動したウィンドウを生成するにはメソッド new_toplevel を使う

$sub_win = $top->new_toplevel();

• メインウィンドウが閉じられると $sub_win も閉じられる
• メインウィンドウで設定したオプションは $sub_win でも有効
• あとはいままでのように、ウィンドウ $sub_win にウィジェットを配置する

• 簡単な使用例

リスト : ウィンドウの生成

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

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

# メッセージの表示
sub message_window {
    my $sub_win = $top->new_toplevel();
    $sub_win->new_message(-text => 'message のサンプルプログラムです')->g_pack;
}

my $m = $top->new_menu(-type => 'menubar');
$top->configure(-menu => $m);
$m->add_command(-label => 'About', -under => 0, -command => \&message_window);

$top->new_label(-text => 'メニュー About を選んでね')->g_pack;

Tkx::MainLoop();

• 最初に new_toplevel で新しいウィンドウ $sub_win を生成する
• 次に、メソッド new_message でメッセージウィジェットを作りテキストを表示する
• メッセージウィジェットは複数行の文字列を表示することができる
• デフォルトでは、縦と横の比率が 150 % になるように、文字列を表示する領域を調整する
• この比率を指定するオプションが -aspect
• -aspect, 文字列を表示する領域の縦横比、100 より大きいと横長で、デフォルトは 150
• -justify, 文字列の揃えを指定 (center : 中央寄せ、right : 右寄せ、left : 左寄せ)
• -aspect は -width よりも優先順位が低いので、-width の値が優先される
• メッセージウィジェットの場合、-width の値は文字数ではなくドット数になるので注意
• なお、サブウィンドウを表示したまま、もう一度 About をクリックすると、もうひとつ同じウィンドウが表示される
• これはあとで改良する

メインウィンドウ

About をクリックしてサブウィンドウを表示

●ウィンドウの設定

• ウィンドウ (ウィジェット) の状態を調べる場合、Tcl/Tk ではコマンド winfo を使う
• Tkx では次の形式で呼び出す
1. Tkx::winfo_subcommand($widget);
2. $widget->g_winfo_subcommand;
• ウィジェットの状態を調べる関数の一部を下表に示す

• winfo_geometry でウィジェットを指定した場合、そのウィジェットが配置されたウィンドウを基準にした座標になる
• winfo_x, winfo_y でメインウィンドウを指定すると、ディスプレイ上での座標を返す

• Tcl/Tk の場合、ウィンドウの設定はコマンド wm (Window Manager) で行う
• Tkx では次の形式で呼び出す
1. Tkx::wm_subcommand($window, 引数, ...);
2. $window->g_wm_subcommand(引数, ...);
• ウィンドウを設定する関数の一部を下表に示す

• 簡単な使用例

リスト : ウィンドウの生成 (改良版)

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

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

# メッセージの表示
my $sub_win;

sub message_window {
    unless (Tkx::winfo_exists($sub_win)) {
        $sub_win = $top->new_toplevel();
        $sub_win->g_wm_title('About');
        $sub_win->new_message(-text => 'message のサンプルプログラムです')->g_pack;
    }
}

my $m = $top->new_menu(-type => 'menubar');
$top->configure(-menu => $m);
$m->add_command(-label => 'About', -under => 0, -command => \&message_window);

$top->new_label(-text => 'メニュー About を選んでね')->g_pack;

Tkx::MainLoop();

• 関数 winfo_exists でウィンドウ $sub_win が開いているかチェックする
• まだ開いていないのであれば、new_toplevel でウィンドウを生成する
• それから、メソッド g_wm_title でウィンドウにタイトルを設定している
• サブウィンドウが開いた状態でメインウィンドウのメニュー about をクリックしても、新しいサブウィンドウは開かない

メインウィンドウ (改良版)

サブウィンドウ (改良版, 横に引き延ばしてある)

●state オプション

• ボタンやメニューに割り当てた機能が無効な場合、そのことをユーザーに知らせた方が使いやすいアプリケーションになる
• この場合、ウィジェットの状態を制御する -state オプションを使うと便利

• ボタンなどのウィジェットでは、その上にマウスカーソルがくるとアクティブな状態になる
• Tk では、ウィジェットがアクティブな状態になったときに、そのウィジェットを強調表示することができる
• state に disabled を設定すると、そのウィジェットは無効な状態になる
• ボタンウィジェットであれば、ラベルの色が変わりマウスでボタンをクリックしても押すことができなくなる
• テキストの色はオプションで指定することができる

• 無効時の背景色は通常の背景色と同じになる

• 簡単な使用例 (1)

リスト : ボタンの状態を変更する

use strict;
use warnings;
use Tkx;

my $var = 'normal';

# メインウィドウ
my $top = Tkx::widget->new('.');
Tkx::option_add('*font', ['', 14]);

# ボタンの設定
my $button = $top->new_button(-text => 'button',
                              -activeforeground => 'green',
                              -disabledforeground => 'red');
$button->g_pack(-fill => 'x');

# ボタンの状態を変更
sub change_state {
    $button->configure(-state => $var);
}

# ラジオボタンの設定
foreach my $i ('normal', 'active', 'disabled') {
    $top->new_radiobutton(-text => $i, -value => $i, -variable => \$var,
                          -command => \&change_state)->g_pack(-anchor => 'w');
}

Tkx::MainLoop();

• ラジオボタンで選択した値はグローバル変数 $var に格納し、関数 change_state でボタンの状態を変更する
• 変数 $var は、あらかじめ normal に初期化しておく
• change_state では、configure を使って -state に変数 $var の値をセットするだけ

ボタンの状態を変更

• メニューの状態を変更
• メニューには複数の項目が登録されるが、それらの項目に対していろいろなオプションを設定することができる
• 項目を操作するために複数のメソッドが用意されているが、オプションを設定するメソッドが entryconfigure

$menu->entryconfigure(項目, option, value)

• 項目の指定には次の方法がある

• 簡単な使用例 (2)

リスト : メニューの状態を変更する

use strict;
use warnings;
use Tkx;

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

# ダミー
sub dummy { }

# メニューの設定
my $m = $top->new_menu(-type => 'menubar');
$top->configure(-menu => $m);

my $m1 = $m->new_menu;
$m->add_cascade(-label => "Menu", -under => 0, -menu => $m1);
$m1->add_command(-label => "Menu1", -command => \&dummy);
$m1->add_command(-label => "Menu2", -command => \&dummy);
$m1->add_command(-label => "Menu3", -command => \&dummy);

# 初期化
my $var = "normal";

# メニューの状態を変更する
sub change_state {
    $m1->entryconfigure('Menu1', -state => $var);
}

# ラジオボタンの設定
$top->new_radiobutton(-text => "normal", -value => 'normal', -variable => \$var, -command => \&change_state)->g_pack;
$top->new_radiobutton(-text => "active", -value => 'active', -variable => \$var, -command => \&change_state)->g_pack;
$top->new_radiobutton(-text => "disable", -value => 'disable', -variable => \$var, -command => \&change_state)->g_pack;

Tkx::MainLoop();

• Menu1 の状態をラジオボタンで設定する
• ラジオボタンが選択されたら、change_state でメニューの状態を変更する
• 項目の指定にはパターンを使用した
• メニューの状態を disabled に設定すると、Menu1 が灰色に表示され選択することができなくなる

通常のメニュー

disabled に設定 (Menu1 が灰色)