Ｐｅｒｌ／Ｔｋｘで固定フォントを指定する方法

投稿：2018-11-12

背景

リストボックスの中で列を揃えたい。

元ネタのコード

こちらのプログラムにリストボックスを追加したら列が揃わず、固定フォントの指定を試行錯誤しました。
クレジットの決済結果をエクセルに反映

こんな表示

決済結果のＣＳＶファイルを読み込むと表示されます

ムフフなコンテンツの決済が見えてなくて良かった（ほっ）。

改良したコード

#!/usr/bin/env perl -w

use utf8;
use strict;
use warnings;
use open IO => ":utf8";

use Data::Dumper;
use DateTime;
use DateTime::Format::Strptime;
use Encode::Argv;
use Encode::Locale;
use File::Basename;
use FindBin;
use Tkx;
use Tkx::Scrolled;
use Win32::OLE;
use Win32::OLE::Const;
use Win32::OLE "CP_UTF8";
use YAML::XS qw / DumpFile LoadFile /;

use constant ROW_START => 5;
use constant ROW_END => 104;
use constant COLUMN_DATE => 3;
use constant COLUMN_SHOP => 4;
use constant COLUMN_MONEY => 5;
use constant YAML_FILE => "credit2account.yaml";
use constant FONT_NAME => "ＭＳ ゴシック";

binmode STDIN, ":encoding(console_in)";
binmode STDOUT, ":encoding(console_out)";

$| = 1;
$Win32::OLE::CP = CP_UTF8;

my $findbin_bin = Encode::decode locale => $FindBin::Bin . "/";
my $yaml_file = $findbin_bin . YAML_FILE;
my $yaml = LoadFile Encode::encode locale => $yaml_file if -e Encode::encode locale => $yaml_file;

# リストボックス内の文字を等幅にするため一律でフォントを指定
my $font_size = 11;
my $item_font = [FONT_NAME, $font_size, 'normal', ];
Tkx::option_add("*Listbox.font", $item_font);

my $userprofile = $ENV{USERPROFILE} =~ s#\\#/#gr;
my $desktop_dir = "$userprofile/Desktop";

my $csv_dir = $desktop_dir;
$csv_dir = $yaml->[0]->{csv_dir} if defined $yaml && defined $yaml->[0]->{csv_dir};
my $csv_file = $csv_dir . "/ " . DateTime->now(time_zone => "local")->subtract(days => 25)->strftime("lifecard_meisai_%Y%m.csv");

my $excel_file = "$desktop_dir/家計簿.xlsx";
$excel_file = $yaml->[0]->{excel_file} if defined $yaml && defined $yaml->[0]->{excel_file};

my $mw = Tkx::widget->new(".");
menu_build($mw, [
	[ "ファイル", "F", [
		[ "決済データを読み込む", "O", \&file_open, ],
		[ "家計簿に保存", "S", \&file_save, ],
		[ "終了", "X", \&wm_delete_window, ],
	], ],
]);

$mw->g_wm_title("クレジット決済アップデータ");
$mw->g_wm_minsize(0, 0);
$mw->g_wm_protocol(WM_DELETE_WINDOW => \&wm_delete_window);
$mw->g_wm_resizable(0, 0);
$mw->new_label(
	-text => "日付　　　　支払先　　　　　　　　　　　　　　金額",
	-font => $item_font,
)->g_pack(-anchor => "w");
my $meisai_lbx = $mw->new_tkx_Scrolled(
	"listbox",
	-selectmode => "extended",
	-scrollbars => "e",
	-width => 10 + 1 + 32 + 1 + 7 + 2,
	-height => 10,
	-activestyle => "none",
);
$meisai_lbx->g_pack(-anchor => "w");

my @meisai;

Tkx::MainLoop();

exit;

sub my_msg($$) {
	my ($msg, $parent) = @_;
	$parent = $parent // $mw;

	Tkx::tk___messageBox(
		-parent => $parent,
		-title => "メッセージ",
		-type => "ok",
		-icon => "info",
		-message => "$msg",
	);
}

sub file_open {
	my $dialog_dir = dirname $csv_file;
	my $dialog_file = basename $csv_file;
	my $temp_csv = Tkx::tk___getOpenFile(
		-defaultextension => "*.csv",
		-filetypes => [
			["ＣＳＶファイル", [".csv",]],
			["すべてのファイル", [".*",]],
		],
		-initialdir => $dialog_dir,
		-initialfile => $dialog_file,
		-title => "クレジット決済ＣＳＶファイルを選択してください",
	);
	if ($temp_csv) {
		$csv_file = $temp_csv;
		load_csv($csv_file);
		update_lbx();
	}
}

sub update_lbx {
	my $cursor = $meisai_lbx->index("active");
	$meisai_lbx->delete(0, "end");

	$meisai_lbx->insert("end", line_format($_->{date_dt}, $_->{shop}, $_->{money})) for @meisai;

	my $total = 0;
	$total += $_->{money} for @meisai;
	$meisai_lbx->insert("end", line_format(undef, "合計", $total));

	$meisai_lbx->activate($cursor) if "" ne $cursor;
}

sub line_format {
	my ($date_dt, $shop, $money) = @_;

	my $date = " " x 10;
	$date = $date_dt->ymd if defined $date_dt;
	$shop = substr $shop . "　" x 16, 0, 16;
	1 while $money =~ s/^(\d+)(\d\d\d)/$1,$2/;

	return sprintf "%s %-16s %7s", $date, $shop, $money;
}

sub load_csv {
	my ($csv_file) = @_;
	if (open my $csv_fh, "<:encoding(cp932)", $csv_file) {
		my $meisai_in = 0;
		my @line;
		my @header;
		while (<$csv_fh>) {
			chomp;
			if (!$meisai_in && /^明細No\.,/) {
				$meisai_in = 1;
				@header = split /,/;
			} elsif ($meisai_in && /^$/) {
				undef $meisai_in;
				last;
			} elsif ($meisai_in) {
				push @line, $_;
			}
		}
		close $csv_fh;

		my %field_idx = (
			date => "利用日",
			shop => "利用先",
			money => "利用金額",
		);
		for (my $column = 0; $column < @header; $column++) {
			for (keys %field_idx) {
				if ($header[$column] eq $field_idx{$_}) {
					$field_idx{$_} = $column;
				}
			}
		}

		my $strp_ymd = DateTime::Format::Strptime->new(
			pattern => "%Y/%m/%d",
			time_zone => "local",
		);
		undef @meisai;
		for (@line) {
			my @field = split /,/;
			my $date_dt = $strp_ymd->parse_datetime($field[$field_idx{date}]);
			push @meisai, {
				date => $field[$field_idx{date}],
				shop => $field[$field_idx{shop}],
				money => $field[$field_idx{money}],
				date_dt => $date_dt,
			};
		}

		@meisai = sort {$a->{date_dt}->datetime cmp $b->{date_dt}->datetime} @meisai;
	}
}

sub file_save {
	my $dialog_dir = dirname $excel_file;
	my $dialog_file = basename $excel_file;
	my $temp_excel = Tkx::tk___getOpenFile(
		-defaultextension => "*.xlsx",
		-filetypes => [
			["エクセルファイル", [".xlsx",]],
			["すべてのファイル", [".*",]],
		],
		-initialdir => $dialog_dir,
		-initialfile => $dialog_file,
		-title => "家計簿を選択してください",
	);

	if ($temp_excel) {
		$excel_file = $temp_excel;
		append_excel($excel_file);
		my_msg "家計簿に追加しました", $mw;
	}
}

sub append_excel {
	my ($excel_file) = @_;

	my $excel = Win32::OLE->new("Excel.Application", "Quit");
	my $wb = $excel->Workbooks->Open(Encode::encode locale => "$excel_file");

	my @month_name = qw(１ ２ ３ ４ ５ ６ ７ ８ ９ １０ １１ １２);
	for (@meisai) {
		$_->{date} =~ m#/(\d\d)/#;
		my $ws = $wb->Worksheets($month_name[$_->{date_dt}->month - 1] . "月");

		my $row;
		for ($row = ROW_START; $row <= ROW_END; $row++) {
			my $v = $ws->Cells($row, COLUMN_DATE)->{Value};
			last if !defined $v;
		}

		if ($row <= ROW_END) {
			$ws->Cells($row, COLUMN_DATE)->{Value} = $_->{date_dt}->ymd;
			$ws->Cells($row, COLUMN_SHOP)->{Value} = $_->{shop};
			$ws->Cells($row, COLUMN_MONEY)->{Value} = $_->{money};
		}
	}

	$wb->Save();
	$wb->Close();
	$excel->Quit();
}

sub wm_delete_window {
	$yaml->[0]->{csv_dir} = dirname $csv_file;
	$yaml->[0]->{excel_file} = $excel_file;
	DumpFile Encode::encode(locale => $yaml_file), $yaml;

	$mw->g_destroy;
}

sub menu_build {
	my ($mainwindow, $tree) = @_;
	my $top = $mainwindow->new_menu;

	for (@$tree) {
		my $second = $top->new_menu( -tearoff => 0, );
		$top->add_cascade(
			-label => "${$_}[0](${$_}[1])",
			-underline => 1 + length ${$_}[0],
			-menu => $second,
		);
		for (@{${$_}[2]}) {
			my $label = ${$_}[0];
			my $label_after = "";
			my $underline = 1 + length ${$_}[0];
			if ($label =~ /\.\.\.$/) {
				$label =~ s/\.\.\.$//;
				$label_after = "...";
				$underline -= 3;
			}
			$label .= "(${$_}[1])$label_after";
			if ("CODE" eq ref ${$_}[2]) {
				$second->add_command(
					-label => $label,
					-underline => $underline,
					-command => ${$_}[2],
 				);
			} elsif ("SCALAR" eq ref ${$_}[2]) {
				$second->add_checkbutton(
					-label => $label,
					-underline => $underline,
					-variable => ${$_}[2],
					-offvalue => 0,
					-onvalue => 1,
 				);
			}
		}
	}

	$mainwindow->configure(-menu => $top);
}

フォント指定の肝

# フォントの指定はリテラル（ｕｔｆ８）のままでＯＫ
# フォント名はワードパッドのフォント変更のコンボボックスからコピペ
use constant FONT_NAME => "ＭＳ ゴシック";

# 名前／サイズ／書体の順に入れたリストのリファレンスを指定
my $font_size = 11;
my $item_font = [FONT_NAME, $font_size, 'normal', ];
Tkx::option_add("*Listbox.font", $item_font);

# 同じフォントで表示させたいウィジェットに同じリファレンスを指定
$mw->new_label(
	-text => "日付　　　　支払先　　　　　　　　　　　　　　金額",
	-font => $item_font,
)->g_pack(-anchor => "w");