練習問題 15.2 銀行プログラムの改造(2) リストボックス
解答
#directory "+labltk";;
#load "labltk.cma";;
open Tk;;
let balance = ref 0;;
let add_balance x = balance := !balance + x;;
let top = openTk();;
let tv_balance = Textvariable.create ();;
let label1 = Label.create top ~textvariable:tv_balance ~relief: `Raised;;
let print_balance tv =
if !balance < 0
then
let s = Printf.sprintf "残高は%8d 円です" !balance in
Textvariable.set tv s;
Label.configure label1 ~foreground: `Red
else
let s = Printf.sprintf "残高は%8d 円です" !balance in
Textvariable.set tv s;
Label.configure label1 ~foreground: `Black;;
let bot_frame = Frame.create top;;
let entry = Entry.create bot_frame
and label2 = Label.create bot_frame ~text:"円"
and rb_frame = Frame.create bot_frame;;
let tv_button = Textvariable.create ();;
let radiobuttons =
List.map
(fun (t, a) ->
Radiobutton.create rb_frame ~text:t ~value:a ~variable:tv_button)
[("を預金する", "Deposit");
("を引き出す", "Withdraw")];;
let list_frame = Frame.create top;; (* リストボックス用の枠をつくる *)
let l_text = ref "" (* リストに表示する文字列用参照 *)
and listbox = Listbox.create list_frame;; (* リストボックスを作成 *)
let add_list yen = (* リストに表示する文字列作成 *)
if yen < 0 (* yenの正負で文字列を変える *)
then
l_text := Printf.sprintf "引出: %8d 円" yen
else
l_text := Printf.sprintf "預入: %8d 円" yen;
Listbox.insert ~index:`End ~texts:[!l_text] listbox (* リストに文字列を入れる *)
let action entry tv_but tv_bal () =
let y = int_of_string (Entry.get entry) in
match Textvariable.get tv_but with
"Deposit" -> add_balance y; print_balance tv_bal; add_list y
| "Withdraw" -> add_balance (-y); print_balance tv_bal; add_list (-y)
| _ -> failwith "Cannot happen";;
let button_ok = Button.create bot_frame
~text:"実行"
~command:(action entry tv_button tv_balance);;
let end_frame = Frame.create top;;
let end_action () =
(fun () -> closeTk(); exit 0);;
let button_end = Button.create end_frame
~text:"終了"
~command:(end_action ());;
let sb = Scrollbar.create list_frame;; (* スクロールバーを作成する *)
Listbox.configure ~yscrollcommand:(Scrollbar.set sb) listbox;; (* スクロールバーをセット *)
Scrollbar.configure ~command:(Listbox.yview listbox) sb;; (* スクロールバー表示 *)
pack radiobuttons ~side:`Top;;
pack [coe entry; coe label2; coe rb_frame; coe button_ok] ~side:`Left;;
pack [coe button_end] ~side:`Right;;
pack [coe listbox; coe sb] ~side:`Left ~fill:`Y;;
pack [coe label1; coe bot_frame; coe list_frame; coe end_frame] ~side:`Top;;
print_balance tv_balance;;
バッチコンパイラ用ファイル
練習問題5.1 と 5.2 でできたプログラムをバッチコンパイラ用にまとめたものを以下に残しておく。
コンパイルでは、labltkライブラリの指定とlabltk.cmaを指定しなくてはならない。
$ ocamlc -o bankaccount -I +labltk labltk.cma bankaccount.ml
bankaccount.ml
open Tk
open Printf
let balance = ref 0 (* 残高 *)
let add_balance x = balance := !balance + x (* 残高を更新する *)
(* ウィジェットを作る *)
let top = openTk() (* アプリ全体のウィンドウ *)
let tv_balance = Textvariable.create () (* ラベルに表示する文字 *)
let label1 = Label.create top ~textvariable:tv_balance ~relief: `Raised
let print_balance tv =
if !balance < 0
then
let s = Printf.sprintf "残高は%8d 円です" !balance in
Textvariable.set tv s;
Label.configure label1 ~foreground: `Red
else
let s = sprintf "残高は%8d 円です" !balance in
Textvariable.set tv s;
Label.configure label1 ~foreground: `Black
let bot_frame = Frame.create top
let entry = Entry.create bot_frame
and label2 = Label.create bot_frame ~text:"円"
and rb_frame = Frame.create bot_frame
let tv_button = Textvariable.create ()
let radiobuttons =
List.map
(fun (t, a) ->
Radiobutton.create rb_frame ~text:t ~value:a ~variable:tv_button)
[("を預金する", "Deposit");
("を引き出す", "Withdraw")]
let list_frame = Frame.create top;;
let l_text = ref ""
and listbox = Listbox.create list_frame;;
let add_list yen =
if yen < 0
then
l_text := Printf.sprintf "引出: %8d 円" yen
else
l_text := Printf.sprintf "預入: %8d 円" yen;
Listbox.insert ~index:`End ~texts:[!l_text] listbox
let action entry tv_but tv_bal () =
let y = int_of_string (Entry.get entry) in
match Textvariable.get tv_but with
"Deposit" -> add_balance y; print_balance tv_bal; add_list y
| "Withdraw" -> add_balance (-y); print_balance tv_bal; add_list (-y)
| _ -> failwith "Cannot happen"
let button_ok = Button.create bot_frame
~text:"実行"
~command:(action entry tv_button tv_balance)
let end_frame = Frame.create top
let end_action () =
(fun () -> closeTk(); exit 0)
let button_end = Button.create end_frame
~text:"終了"
~command:(end_action ())
let sb = Scrollbar.create list_frame;;
Listbox.configure ~yscrollcommand:(Scrollbar.set sb) listbox;;
Scrollbar.configure ~command:(Listbox.yview listbox) sb;;
(* ウィジェット配置と初期化 *)
let () = pack radiobuttons ~side:`Top;
pack [coe entry; coe label2; coe rb_frame; coe button_ok] ~side:`Left;
pack [coe button_end] ~side:`Right;
pack [coe listbox; coe sb] ~side:`Left ~fill:`Y;
pack [coe label1; coe bot_frame; coe list_frame; coe end_frame] ~side:`Top;
print_balance tv_balance;
mainLoop()