Ltk:メニューから他ウィンドウを表示する - lisp-cookbook-ja/common-lisp GitHub Wiki
- メニューからほかウィンドウの表示
以下、３本のコードをファイル化し、REPLでkpr-main.lispをloadしてください。
> (load "kpr-main.lisp")
kpr-main.lisp
;;; LTKのメニューから別のウィンドウを起動する
(ql:quickload :ltk)
;; 他画面ロード
(load "calc.lisp")
(load "rgb.lisp")
;; パッケージの作成
(defpackage :kpr-main
(:use :common-lisp
:ltk
:kpr-calc
:kpr-rgb)
(:export :main))
(in-package :kpr-main)
(defun main ()
(with-ltk ()
(wm-title *tk* "メニュー")
(minsize *tk* 200 100)
(let* (
;; メニューバー作成
(mb (make-menubar))
;;メニュー"種類"
(mshurui (make-menu mb "アプリ" ))
(mf-command (make-menubutton mshurui "電卓"
(lambda () ;(error "asdf")
(format t "電卓メニュー pressed~&")
(calc-main) ; 電卓アプリを開く
(finish-output))
:underline 1))
(sep2 (add-separator mshurui))
(mf-export (make-menu mshurui "選択メニュー"))
(mfe-jpg (make-menubutton mf-export "電卓" (lambda ()
(format t "電卓 pressed~&")
(calc-main) ; 電卓アプリを開く
(finish-output))))
(mfe-gif (make-menubutton mf-export "RGBテスト" (lambda ()
(format t "RGBテスト pressed~&")
(rgb-main) ; RGBテストアプリを開く
(finish-output))))
(sep3 (add-separator mshurui))
(mf-close (make-menubutton mshurui "終了"
(lambda () ;(error "asdf")
(format t "終了 pressed~&")
(setf *exit-mainloop* t)
(finish-output))
:underline 1))
(msg (make-instance 'message
:text "メニューから別画面を開くアプリです。"
:width 1000
:background "#FFFFFF"))
(b1 (make-instance
'button
:text "Close"
:command (lambda ()
(format t "終了")
(setf *exit-mainloop* t)))))
(pack msg
:side :top
:fill :x) ; fillを指定すると、Wiindowのハシをドラッグして伸ばしてもボタンが大きくなる。
(pack b1
:side :bottom
:fill :x) ; fillを指定すると、Wiindowのハシをドラッグして伸ばしてもボタンが大きくなる。
;; (configure msg
;; :anchor :w
;; )
)))
(main)
calc.lisp
;;; LTKでボタンを表示する
(ql:quickload :ltk)
;; パッケージの作成
(defpackage :kpr-calc
(:use :common-lisp
:ltk)
(:export :calc-main))
(in-package :kpr-calc)
(defun calc-main ()
(with-ltk ()
(wm-title *tk* "電卓アプリ")
(let* (
;; ベース用フレーム１(演算用ボタン配置用 √、÷、×、−)
(f-base1 (make-instance
'frame))
;; ベース用フレーム２(数字ボタン用配置用 ０〜９、ドット、プラスマイナス、＋、＝)
(f-base2 (make-instance
'frame))
;; 電卓数字部用フレーム
(f-first1 (make-instance
'frame
:master f-base2))
;; 電卓＋ボタンと＝ボタン用フレーム
(f-first2 (make-instance
'frame
:master f-base2))
;; 電卓「０」「．」「±」用フレーム
(f-second1 (make-instance
'frame
:master f-first1))
;; 電卓「１」「２」「３」用フレーム
(f-second2 (make-instance
'frame
:master f-first1))
;; 電卓「４」「５」「６」用フレーム
(f-second3 (make-instance
'frame
:master f-first1))
;; 電卓「７」「８」「９」用フレーム
(f-second4 (make-instance
'frame
:master f-first1))
(b51 (make-instance
'button
:master f-base1
:text "√"
:command (lambda ()
(format t "ボタン√を押しました~%"))))
(b52 (make-instance
'button
:master f-base1
:text "÷"
:command (lambda ()
(format t "ボタン÷を押しました~%"))))
(b53 (make-instance
'button
:master f-base1
:text "×"
:command (lambda ()
(format t "ボタン×を押しました~%"))))
(b54 (make-instance
'button
:master f-base1
:text "ー"
:command (lambda ()
(format t "ボタンーを押しました~%"))))
(b11 (make-instance
'button
:master f-second1
:text "0"
:command (lambda ()
(format t "ボタン0を押しました~%"))))
(b12 (make-instance
'button
:master f-second1
:text "."
:command (lambda ()
(format t "ボタン.を押しました~%"))))
(b13 (make-instance
'button
:master f-second1
:text "+/-"
:command (lambda ()
(format t "ボタン+/-を押しました~%"))))
(b21 (make-instance
'button
:master f-second2
:text "1"
:command (lambda ()
(format t "ボタン1を押しました~%"))))
(b22 (make-instance
'button
:master f-second2
:text "2"
:command (lambda ()
(format t "ボタン2を押しました~%"))))
(b23 (make-instance
'button
:master f-second2
:text "3"
:command (lambda ()
(format t "ボタン3を押しました~%"))))
(b31 (make-instance
'button
:master f-second3
:text "4"
:command (lambda ()
(format t "ボタン4を押しました~%"))))
(b32 (make-instance
'button
:master f-second3
:text "5"
:command (lambda ()
(format t "ボタン5を押しました~%"))))
(b33 (make-instance
'button
:master f-second3
:text "6"
:command (lambda ()
(format t "ボタン6を押しました~%"))))
(b41 (make-instance
'button
:master f-second4
:text "7"
:command (lambda ()
(format t "ボタン7を押しました~%"))))
(b42 (make-instance
'button
:master f-second4
:text "8"
:command (lambda ()
(format t "ボタン8を押しました~%"))))
(b43 (make-instance
'button
:master f-second4
:text "9"
:command (lambda ()
(format t "ボタン9を押しました~%"))))
(b44 (make-instance
'button
:master f-first2
:text "+"
:command (lambda ()
(format t "ボタン+を押しました~%"))))
(b24 (make-instance
'button
:master f-first2
:text "="
:command (lambda ()
(format t "ボタン=を押しました~%"))))
(b3 (make-instance
'button
:text "終了"
:command (lambda ()
(format t "終了")
(setf *exit-mainloop* t))))
)
;(pack (list b1 b2 b3) :side :top) ; 通常の並び、順番に並ぶ。これがデフォルト
;(pack (list b1 b2 b3) :side :left) ; 指定されたオブジェクトを左から順番に並べる
;(pack (list b1 b2 b3) :side :right) ; 指定されたオブジェクトを右から順番に並べる
;(pack (list b1 b2 b3) :side :bottom) ; 指定されたオブジェクトを下から順番に並べる
;(pack (list b1 b2 b3) :side :top :fill :x) ; fillを指定すると、Wiindowのハシをドラッグして伸ばしてもボタンが大きくなる。
;; フレームの配置
(pack (list f-base1 f-base2) :side :top :fill :both :expand :yes)
(pack (list f-first1 f-first2) :side :left :fill :both :expand :yes)
(pack (list f-second1 f-second2 f-second3 f-second4) :side :bottom :fill :both :expand :yes)
;; 計算機能ボタン配置（√、÷、×、ー）
(pack (list b51 b52 b53 b54) :side :left :fill :both :expand :yes)
;; 数字ボタン配置
(pack (list b11 b12 b13) :side :left :fill :both :expand :yes)
(pack (list b21 b22 b23) :side :left :fill :both :expand :yes)
(pack (list b31 b32 b33) :side :left :fill :both :expand :yes)
(pack (list b41 b42 b43) :side :left :fill :both :expand :yes)
;; 計算機能ボタン配置（＋、＝）
(pack (list b44 b24) :side :top :fill :both :expand :yes)
(pack b3 :side :top :fill :both :expand :yes) ; fill,both,expand,yesを指定すると、Wiindowのハシをドラッグして伸ばしても、ボタンが上下左右に大きくなる。
)))
;(main)
rgb.lisp
;;; pack後のオブジェクトに対するパラメータ設定(configure)
(ql:quickload :ltk)
;; パッケージの作成
(defpackage :kpr-rgb
(:use :common-lisp
:ltk)
(:export :rgb-main))
(in-package :kpr-rgb)
(defun rgb-main ()
(with-ltk ()
(wm-title *tk* "ConfigureによるRGB設定テスト")
(let* (
;; ベース用フレーム(赤色)
(f-red (make-instance
'frame))
;; ベース用フレーム(青色)
(f-blue (make-instance
'frame))
;; ベース用フレーム(緑色)
(f-green (make-instance
'frame))
;; ベース用フレーム(ボタン)
(f-btn (make-instance
'frame))
;; RGB値目視用ラベル
(lbl-rgb (make-instance
'label
:master f-btn
:text "RGB Color"))
;; 赤色ラベル
(lbl-red (make-instance
'label
:text " RED:"
:master f-red))
;; 青色ラベル
(lbl-blue (make-instance
'label
:text " BLUE:"
:master f-blue))
;; 緑色ラベル
(lbl-green (make-instance
'label
:text "GREEN:"
:master f-green))
;; 赤色スケール値
(lbl-scale-red (make-instance 'label
:master f-red
:foreground :red
:text "00"))
;; 青色スケール値
(lbl-scale-blue (make-instance 'label
:master f-blue
:foreground :blue
:text "00"))
;; 緑色スケール値
(lbl-scale-green (make-instance 'label
:master f-green
:foreground :green
:text "00"))
;; 赤色スケール
(sc-red (make-instance 'scale
:master f-red
:from 0
:to 255
:length 300
:command (lambda (value)
(setf (text lbl-scale-red) (format nil "~2,'0x" (floor value))) ;１６進数でラベルに表示(必ず２桁表示)
(configure lbl-rgb :background (concatenate 'string "#" (text lbl-scale-red) (text lbl-scale-green) (text lbl-scale-blue)))
)))
;; 青色スケール
(sc-blue (make-instance 'scale
:master f-blue
:from 0
:to 255
:length 300
:command (lambda (value)
(setf (text lbl-scale-blue) (format nil "~2,'0x" (floor value))) ;１６進数でラベルに表示(必ず２桁表示)
(configure lbl-rgb :background (concatenate 'string "#" (text lbl-scale-red) (text lbl-scale-green) (text lbl-scale-blue)))
)))
;; 緑色スケール
(sc-green (make-instance 'scale
:master f-green
:from 0
:to 255
:length 300
:command (lambda (value)
(setf (text lbl-scale-green) (format nil "~2,'0x" (floor value))) ;１６進数でラベルに表示(必ず２桁表示)
(configure lbl-rgb :background (concatenate 'string "#" (text lbl-scale-red) (text lbl-scale-green) (text lbl-scale-blue)))
)))
;; RGB値取得
(btn-get-scale (make-instance
'button
:master f-btn
:text "Get RGB!!"
:command (lambda ()
(format t "ボタンを押しました~%"))))
;; 終了
(btn-close (make-instance
'button
:text "終了"
:command (lambda ()
(format t "終了")
(setf *exit-mainloop* t))))
)
;; ベースフレームの配置
(pack (list f-red f-blue f-green f-btn) :side :top :fill :both :expand :yes)
;; 赤色設定フレーム内の配置
(pack lbl-red :side :left :fill :both :expand :yes)
(pack (list lbl-scale-red sc-red) :side :top :fill :both :expand :yes)
;; 青色設定フレーム内の配置
(pack lbl-blue :side :left :fill :both :expand :yes)
(pack (list lbl-scale-blue sc-blue) :side :top :fill :both :expand :yes)
;; 緑色設定フレーム内の配置
(pack lbl-green :side :left :fill :both :expand :yes)
(pack (list lbl-scale-green sc-green) :side :top :fill :both :expand :yes)
;; ボタンフレーム内の配置
(pack (list lbl-rgb btn-get-scale btn-close) :side :top :fill :both :expand :yes)
;; ボタンクリックでボタンの前景色を変更する
(configure lbl-red :background :red)
(configure lbl-blue :background :blue)
(configure lbl-green :background :green)
; (configure lbl-rgb :background "#FF00FF")
(configure lbl-rgb :background (concatenate 'string "#" (text lbl-scale-red) (text lbl-scale-blue) (text lbl-scale-green)))
)))
;;(main)