Tcl Tk入門/Canvas/座標の取得
をテンプレートにして作成
[
トップ
] [
新規
|
一覧
|
単語検索
|
最終更新
|
ヘルプ
|
ログイン
]
開始行:
''[[FrontPage]]''
* Canvas上の座標を取得する [#m69a7397]
マウスの移動イベント<Motion>を取得してリアルタイムに表示...
サンプルコード上のコメントをもって解説に替える。~
** 制約事項 [#f54adf9b]
まだよく分かんない。~
とりあえずOSはWindows、Active_Tcl 8.5.5.0でぼちぼちとやっ...
~
~
ファイル名:Region_Sense.tcl
# HEAD *************************************************...
package require Tk ...
#/HEAD *************************************************...
# Piano Roll *******************************************...
proc pianoRoll { x y } { ...
.c create rectangle 0 10 20 82 -fill gray -width 0 ...
.c create rectangle 501 11 520 81 -fill gray -width 0 ...
...
.c create line 20 10 20 82 -fill black -width 1 ...
.c create line 49 10 49 82 -fill black -width 1 ...
.c create line 0 10 520 10 -fill black -width 1 ...
.c create line 0 81 520 81 -fill black -width 1 ...
.c create line 500 10 500 81 -fill black -width 1 ...
...
.c create line $x $y [expr { $x + 29 }] $y -fill black -...
.c create line [expr { $x + 30 }] $y 500 $y -fill #66666...
...
.c create line [expr { $x + 17 }] [expr { $y + 8 }] \
[expr { $x + 29 }] [expr { $y + 8 }] -fil...
...
.c create line [expr { $x + 17 }] [expr { $y + 18 }] \
[expr { $x + 29 }] [expr { $y + 18 }] -fi...
...
.c create line [expr { $x + 17 }] [expr { $y + 28 }] \
[expr { $x + 29 }] [expr { $y + 28 }] -fi...
...
.c create line $x [expr { $y + 35 }] \
[expr { $x + 29 }] [expr { $y + 35 }] -fi...
.c create line [expr { $x + 30 }] [expr { $y + 35 }] \
500 [expr { $y + 35 }] -fill #666666 -wid...
...
.c create line [expr { $x + 17 }] [expr { $y + 43 }] \
[expr { $x + 29 }] [expr { $y + 43 }] -fi...
...
.c create line [expr { $x + 17 }] [expr { $y + 53 }] \
[expr { $x + 29 }] [expr { $y + 53 }] -fi...
...
.c create line $x [expr { $y + 60 }] \
[expr { $x + 29 }] [expr { $y + 60 }] -fi...
.c create line [expr { $x + 30 }] [expr { $y + 60 }] \
500 [expr { $y + 60 }] -fill #666666 -wid...
...
.c create line [expr { $x + 17 }] [expr { $y + 68 }] \
[expr { $x + 29 }] [expr { $y + 68 }] -fi...
...
.c create rectangle $x [expr { $y + 6 }] \
[expr { $x + 17 }] [expr { $y + 10 }...
.c create rectangle [expr { $x + 30 }] [expr { $y + 6 }] \
500 [expr { $y + 10 }] -fill #AAAAAA...
...
...
.c create rectangle $x [expr { $y + 16 }] \
[expr { $x + 17 }] [expr { $y + 20 }...
.c create rectangle [expr { $x + 30 }] [expr { $y + 16 }...
500 [expr { $y + 20 }] -fill #AAAAAA...
...
.c create rectangle $x [expr { $y + 26 }] \
[expr { $x + 17 }] [expr { $y + 30 }...
.c create rectangle [expr { $x + 30 }] [expr { $y + 26 }...
500 [expr { $y + 30 }] -fill #AAAAAA...
...
.c create rectangle $x [expr { $y + 41 }] \
[expr { $x + 17 }] [expr { $y + 45 }...
.c create rectangle [expr { $x + 30 }] [expr { $y + 41 }...
500 [expr { $y + 45 }] -fill #AAAAAA...
...
.c create rectangle $x [expr { $y + 51 }] \
[expr { $x + 17 }] [expr { $y + 55 }...
.c create rectangle [expr { $x + 30 }] [expr { $y + 51 }...
500 [expr { $y + 55 }] -fill #AAAAAA...
...
.c create rectangle $x [expr { $y + 66 }] [expr { $x + 1...
[expr { $y + 68 }] -fill black ...
.c create rectangle [expr { $x + 30 }] [expr { $y + 66 }...
500 [expr { $y + 68 }] -fill #AAAAAA...
...
for {set cnt 1} {$cnt < 8} {incr cnt} { ...
set x [expr {$cnt * 60}] ...
.c create line $x 8 $x 81 -width 1 ...
.c create line [expr { $x + 15}] 8 [expr { $x + 15}]...
.c create line [expr { $x + 30}] 8 [expr { $x + 30}]...
.c create line [expr { $x + 45}] 8 [expr { $x + 45}]...
} ...
.c create line 480 8 480 81 -width 1 ...
.c create line 495 8 495 81 -fill #AAAAAA -width 1 ...
} ...
#/Piano Roll *******************************************...
# Region Sense *****************************************...
wm title . "Region Sense" ...
wm geometry . 520x160+250+200 ...
set font {Times 10} ...
...
button .exit -width 4 -text "Exit" -command exit ...
place .exit -x 1 -y 1 -anchor nw ...
...
frame .bBarL -borderwidth 1 -relief groove ...
place .bBarL -x 41 -y 1 -anchor nw ...
label .bBarL.msg -font $font -wraplength 200 -justify r...
pack .bBarL.msg -side right ...
...
frame .bBarR -borderwidth 1 -relief groove ...
place .bBarR -x 519 -y 1 -anchor ne ...
label .bBarR.msg -font $font -wraplength 200 -justify r...
pack .bBarR.msg -side right ...
...
frame .sBar -borderwidth 1 -relief sunken ...
pack .sBar -side bottom -fill x ...
...
label .sBar.coordinate -font $font -wraplength 5i -justi...
pack .sBar.coordinate -side right ...
...
canvas .c -background white -width 510 -height 100 ...
#pack .c -side bottom -fill x ...
place .c -x 0 -y 25 -anchor nw ...
...
pianoRoll 20 13 ...
...
bind .c <Motion> { motionSense %x %y } ...
...
...
#/Region Sense *****************************************...
# Motion Sense *****************************************...
proc motionSense { x y } { ...
# set size [winfo fpixels .c 1i] ...
# set x [expr $x/$size] ...
# set y [expr $y/$size] ...
.sBar.coordinate configure \
-text [format "x: %6i y: %6i" $x $y ] ...
# -text [format "x: %6.2fi y: %6.2fi" $x $y ] ...
} ...
#/Motion Sense *****************************************...
*** 修正履歴 [#l4c236aa]
~
*** 課題 [#w3580ede]
管理人自身、この言語がいまいち理解できていない。~
+マニュアルが英語版しかなくて辛い。 → 頑張って読め。~
+コマンドにオプションが多く、把握しきれていない。 → よく...
+おいおいマジかよ。 → クロスプラットフォームなGUIを目指そ...
~
はぁ・・・・。~
-備考~
~
*** 参考ページ [#ob0b0e9b]
[Active_State: http://www.activestate.com/Products/active...
終了行:
''[[FrontPage]]''
* Canvas上の座標を取得する [#m69a7397]
マウスの移動イベント<Motion>を取得してリアルタイムに表示...
サンプルコード上のコメントをもって解説に替える。~
** 制約事項 [#f54adf9b]
まだよく分かんない。~
とりあえずOSはWindows、Active_Tcl 8.5.5.0でぼちぼちとやっ...
~
~
ファイル名:Region_Sense.tcl
# HEAD *************************************************...
package require Tk ...
#/HEAD *************************************************...
# Piano Roll *******************************************...
proc pianoRoll { x y } { ...
.c create rectangle 0 10 20 82 -fill gray -width 0 ...
.c create rectangle 501 11 520 81 -fill gray -width 0 ...
...
.c create line 20 10 20 82 -fill black -width 1 ...
.c create line 49 10 49 82 -fill black -width 1 ...
.c create line 0 10 520 10 -fill black -width 1 ...
.c create line 0 81 520 81 -fill black -width 1 ...
.c create line 500 10 500 81 -fill black -width 1 ...
...
.c create line $x $y [expr { $x + 29 }] $y -fill black -...
.c create line [expr { $x + 30 }] $y 500 $y -fill #66666...
...
.c create line [expr { $x + 17 }] [expr { $y + 8 }] \
[expr { $x + 29 }] [expr { $y + 8 }] -fil...
...
.c create line [expr { $x + 17 }] [expr { $y + 18 }] \
[expr { $x + 29 }] [expr { $y + 18 }] -fi...
...
.c create line [expr { $x + 17 }] [expr { $y + 28 }] \
[expr { $x + 29 }] [expr { $y + 28 }] -fi...
...
.c create line $x [expr { $y + 35 }] \
[expr { $x + 29 }] [expr { $y + 35 }] -fi...
.c create line [expr { $x + 30 }] [expr { $y + 35 }] \
500 [expr { $y + 35 }] -fill #666666 -wid...
...
.c create line [expr { $x + 17 }] [expr { $y + 43 }] \
[expr { $x + 29 }] [expr { $y + 43 }] -fi...
...
.c create line [expr { $x + 17 }] [expr { $y + 53 }] \
[expr { $x + 29 }] [expr { $y + 53 }] -fi...
...
.c create line $x [expr { $y + 60 }] \
[expr { $x + 29 }] [expr { $y + 60 }] -fi...
.c create line [expr { $x + 30 }] [expr { $y + 60 }] \
500 [expr { $y + 60 }] -fill #666666 -wid...
...
.c create line [expr { $x + 17 }] [expr { $y + 68 }] \
[expr { $x + 29 }] [expr { $y + 68 }] -fi...
...
.c create rectangle $x [expr { $y + 6 }] \
[expr { $x + 17 }] [expr { $y + 10 }...
.c create rectangle [expr { $x + 30 }] [expr { $y + 6 }] \
500 [expr { $y + 10 }] -fill #AAAAAA...
...
...
.c create rectangle $x [expr { $y + 16 }] \
[expr { $x + 17 }] [expr { $y + 20 }...
.c create rectangle [expr { $x + 30 }] [expr { $y + 16 }...
500 [expr { $y + 20 }] -fill #AAAAAA...
...
.c create rectangle $x [expr { $y + 26 }] \
[expr { $x + 17 }] [expr { $y + 30 }...
.c create rectangle [expr { $x + 30 }] [expr { $y + 26 }...
500 [expr { $y + 30 }] -fill #AAAAAA...
...
.c create rectangle $x [expr { $y + 41 }] \
[expr { $x + 17 }] [expr { $y + 45 }...
.c create rectangle [expr { $x + 30 }] [expr { $y + 41 }...
500 [expr { $y + 45 }] -fill #AAAAAA...
...
.c create rectangle $x [expr { $y + 51 }] \
[expr { $x + 17 }] [expr { $y + 55 }...
.c create rectangle [expr { $x + 30 }] [expr { $y + 51 }...
500 [expr { $y + 55 }] -fill #AAAAAA...
...
.c create rectangle $x [expr { $y + 66 }] [expr { $x + 1...
[expr { $y + 68 }] -fill black ...
.c create rectangle [expr { $x + 30 }] [expr { $y + 66 }...
500 [expr { $y + 68 }] -fill #AAAAAA...
...
for {set cnt 1} {$cnt < 8} {incr cnt} { ...
set x [expr {$cnt * 60}] ...
.c create line $x 8 $x 81 -width 1 ...
.c create line [expr { $x + 15}] 8 [expr { $x + 15}]...
.c create line [expr { $x + 30}] 8 [expr { $x + 30}]...
.c create line [expr { $x + 45}] 8 [expr { $x + 45}]...
} ...
.c create line 480 8 480 81 -width 1 ...
.c create line 495 8 495 81 -fill #AAAAAA -width 1 ...
} ...
#/Piano Roll *******************************************...
# Region Sense *****************************************...
wm title . "Region Sense" ...
wm geometry . 520x160+250+200 ...
set font {Times 10} ...
...
button .exit -width 4 -text "Exit" -command exit ...
place .exit -x 1 -y 1 -anchor nw ...
...
frame .bBarL -borderwidth 1 -relief groove ...
place .bBarL -x 41 -y 1 -anchor nw ...
label .bBarL.msg -font $font -wraplength 200 -justify r...
pack .bBarL.msg -side right ...
...
frame .bBarR -borderwidth 1 -relief groove ...
place .bBarR -x 519 -y 1 -anchor ne ...
label .bBarR.msg -font $font -wraplength 200 -justify r...
pack .bBarR.msg -side right ...
...
frame .sBar -borderwidth 1 -relief sunken ...
pack .sBar -side bottom -fill x ...
...
label .sBar.coordinate -font $font -wraplength 5i -justi...
pack .sBar.coordinate -side right ...
...
canvas .c -background white -width 510 -height 100 ...
#pack .c -side bottom -fill x ...
place .c -x 0 -y 25 -anchor nw ...
...
pianoRoll 20 13 ...
...
bind .c <Motion> { motionSense %x %y } ...
...
...
#/Region Sense *****************************************...
# Motion Sense *****************************************...
proc motionSense { x y } { ...
# set size [winfo fpixels .c 1i] ...
# set x [expr $x/$size] ...
# set y [expr $y/$size] ...
.sBar.coordinate configure \
-text [format "x: %6i y: %6i" $x $y ] ...
# -text [format "x: %6.2fi y: %6.2fi" $x $y ] ...
} ...
#/Motion Sense *****************************************...
*** 修正履歴 [#l4c236aa]
~
*** 課題 [#w3580ede]
管理人自身、この言語がいまいち理解できていない。~
+マニュアルが英語版しかなくて辛い。 → 頑張って読め。~
+コマンドにオプションが多く、把握しきれていない。 → よく...
+おいおいマジかよ。 → クロスプラットフォームなGUIを目指そ...
~
はぁ・・・・。~
-備考~
~
*** 参考ページ [#ob0b0e9b]
[Active_State: http://www.activestate.com/Products/active...
ページ名: