組み込みウィジェット

Perl/Tkには様々な汎用のウィジェットが用意されています．

■ ファイル名の取得(getOpenFile, getSaveFile)

ファイルを開いたり保存したりするためには，そのファイルの名前を取得する必要があります．getOpenFileとgetSaveFileはブラウザを表示し，マウスで選択するＧＵＩを提供します．

書式：　$openfilename = $widget->getOpenFile(?options?)
　　　　　　　$savefilename = $widget->getSaveFile(?options?)

主なオプション

オプション 説明 オプション値の例
-filetypes => filetypelist ファイルの型の一覧リストの指定 [["Text file", '.txt'], ["GIF image", '.gif"], ["All files", '*']]
-defaultextension => filetype デフォルト拡張子 '.txt', '.gif'
-initialdir => directory 初めのディレクトリを指定 "$ENV{"HOME"}"
-title => title ウィンドウのタイトル "File Open"

■ 定型ダイアログボックス(messageBox)

ＧＵＩアプリのほとんどで，操作や終了の確認を求めたりするときに出る，「はい」「いいえ」「キャンセル」などのボタンを選択させるダイアログボックスを出します．

書式：　$response = $widget->messageBox(?options?)

主なオプション

オプション 説明 オプション値の例
-default => name デフォルトでフォーカスされるボタン 'Cancel', 'Ok'
-icon => iconImage Tk組み込みのビットマップ名 'info', 'warning', 'question', 'questhead'
-message => string 表示するメッセージ "本当に終了しますか？"
-title => title ウィンドウのタイトル "Warning "
-type => predefinedtype 定義済みのボタンタイプを選ぶ 'AbortRetryIgnore', 'Ok', 'OkCancel', 'RetryCancel', 'YesNo', 'YesNoCancel' から一つ

補足：

さらにカスタマイズしたダイアログボックスを作るには，

を用いるか，TopLevelウィジェットで新しいウィンドウを開き，自前でダイアログボックスを作る方法がある．詳しくは，QuickReferenceを参照のこと．

サンプル：　画像ビューワ

#!/usr/bin/perl -w

use Tk;

$mw = MainWindow->new;
$mw->protocol('WM_DELETE_WINDOW', \&Exit);

$top = $mw->Frame()
  ->pack(-fill=>'x');

$bottom = $mw->Frame()
  ->pack(-fill=>'x');

$top->Label(-text=>"画像ファイル:")
  ->pack(-side=>'left');

$ent = $top->Entry(-background=>'white',
            -width=>35)
  ->pack(-side=>'left', -fill=>'both');

$but = $top->Button(-text=>"参照",
             -command=>\&Open_file )
  ->pack(-side=>'left');

$bottom->Button(-text=>"終了", -width=>10,
                -command=> \&Exit)
  ->pack(-side=>'right', -anchor=>'e', -fill=>'x');

$bottom->Button(-text=>"プレビュ", -width=>10,
                -command=> \&Exec_preview)
  ->pack(-side=>'right', -anchor=>'e', -fill=>'x');

MainLoop;

sub Open_file {
  my $types = [ 
                   ["GIF Image" ,    '.gif'          ],
                   ["JPEG Image",   ['.jpg', 'jpeg']],
                   ["All Files" ,    '*'             ]
                  ];
  my $filename = $mw->getOpenFile(-filetypes=>$types);

  if ($filename ne "") {
    $ent->delete(0, 'end');
  }
}

sub Kill_proc {
  my $proc = $_[0];
  my $pid = `/sbin/pidof $proc`;

  if ($pid !~ /^\s*$/)
    {
      system "/bin/kill $pid";
    }

}

sub Exec_preview {
  my $file = $ent->get;

  if (-e $file) {
    Kill_proc("ee");
    system("ee $file &");
  }
  else {
    $but->flash;
    $ent->bell;
  }
}

sub Exit {
  
  $mw->bell;
  my $answer = $mw->messageBox(-title => "Warning",
                               -icon => 'warning',
                               -type => 'OkCancel',
                               -default => 'Cancel',
                               -message => "終了しますか？");

  if ($answer eq 'Ok') {
    Kill_proc("ee");
    exit;
  } else {
    return;
  }

}