Ltk:pack後のオブジェクトのパラメータ設定をする - lisp-cookbook-ja/common-lisp GitHub Wiki

• pack後のオブジェクトに対するパラメータ設定(configure)

;;; pack後のオブジェクトに対するパラメータ設定(configure)

(ql:quickload :ltk)


;; パッケージの作成
(defpackage :ex4-10
  (:use :common-lisp
        :ltk)
  (:export :main))

(in-package :ex4-10)

(defun 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)