練習問題 15.1 銀行口座プログラムの改造(1)

銀行口座プログラムを改造して、残高がマイナスになった時に、（終了するのではなくて）残高表示の文字が赤になるようにしなさい。

ポイント

改造した点

• 残高がマイナスになると、残高表示が赤になり、プラスになると、黒になるようにする。
• 終了ボタンを新たに設置する。

調べるのに苦労したところは、文字を赤にするところである。

「Textvariable.set tv s」という箇所は、テキスト変数tv に、文字s をセットしているだけなので、ここで文字を赤にすることはできない。そういう関数は用意されていない。

となると、「残高は-1000円です」と表示される箇所＝ラベルの文字色の設定を変えなければならない。
そして、この箇所のラベル名は、「label1」である。
「label1」を生成しているのは、次の文である。

let label1 = Label.create top ~textvariable:tv_balance ~relief: `Raised;;

ここで「~foreground:`Red」と付け加えると文字色を赤にできるが、今回はあとから変更したい。

Labelモジュールには、「create」以外に、「configure」や「configure_get」という関数が用意されていて、「configure」関数は、

# Label.configure;;
- : ?anchor:anchor ->
    ?background:color ->
    ?bitmap:bitmap ->
    ?borderwidth:int ->
    ?cursor:cursor ->
    ?font:string ->
    ?foreground:color ->
    ?height:int ->
    ?highlightbackground:color ->
    ?highlightcolor:color ->
    ?highlightthickness:int ->
    ?image:[< image ] ->
    ?justify:justification ->
    ?padx:int ->
    ?pady:int ->
    ?relief:relief ->
    ?takefocus:bool ->
    ?text:string ->
    ?textvariable:Textvariable.textVariable ->
    ?textwidth:int ->
    ?underline:int ->
    ?width:int -> ?wraplength:int -> Widget.label Widget.widget -> unit
= <fun>

となっていて、ラベル・ウィジェットとオプションを引数にしていろいろと設定を変更できるのである。

つまり、

Label.configure label1 ~foreground:`Red;;

とすることで、文字色を赤にすることができたのである。

解答

#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 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
    | "Withdraw" -> add_balance (-y); print_balance tv_bal
    | _ -> 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 ());;

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 label1; coe bot_frame; coe end_frame] ~side:`Top;;  (* 終了の枠 *)

print_balance tv_balance;;

Tweet