#!/usr/bin/wish kanji defaultInputCode EUC #------------------------------------------------------------------------ # # 「Tcl/Tkで始める簡単GUIプログラミング」 # サンプル・コード # 1999 11/26 # 宮脇大作 aaf18900@pop06.odn.ne.jp # #------------------------------------------------------------------------ # 場所の指定 set Crtdir [exec pwd] set ShowDotFile 0 set Clip_Exist 0 set select_Exist 0 set MoveIconList_Exist 0 # ウィンドウのタイトルに場所を表示 wm title . $Crtdir # イメージを作る image create photo File_Icon -file Icon/File.gif image create photo App_Icon -file Icon/App.gif image create photo Folder_Icon -file Icon/Folder.gif # 情報を取得 proc GetInfo { } { global Crtdir FilenameList IconNum Filename IconImage shurui ShowDotFile if {$ShowDotFile == 1} { set FilenameList [exec ls -a -F $Crtdir] } else { set FilenameList [exec ls -F $Crtdir] } set IconNum [llength $FilenameList] set ExtList {.gif .jpg .xpm .tif } for { set i 0 } { $i < $IconNum } {set i [expr $i+1]} { set Filename($i) [lindex $FilenameList $i] image create photo IconImage($i) if { [ string first "/" $Filename($i) ] > -1 } { IconImage($i) copy Folder_Icon set shurui($i) "ディレクトリ" set Filename($i) [ string trimright $Filename($i) / ] } else { if { [ string first "*" $Filename($i) ] > -1 } { IconImage($i) copy App_Icon set shurui($i) "実行ファイル" set Filename($i) [ string trimright $Filename($i) * ] } else { IconImage($i) copy File_Icon set shurui($i) "ファイル" } } foreach Ext $ExtList { if { [ string first $Ext $Filename($i) ] > -1 } { set shurui($i) "画像" } } } } # アイコンの座標を決める proc SetIconXY { } { global IconNum iconX iconY canvasY for { set i 0 } { $i < $IconNum } {set i [expr $i+1]} { set iconX($i) [expr (100+15)*($i%4)+60] set iconY($i) [expr 80*($i/4)+45] } catch { set canvasY [expr $iconY([expr $IconNum-1])+70] } { set canvasY 500 } } # GUI構築 proc BuildGUI { } { global Crtdir canvasY ShowDotFile frame .f1 menubutton .b0 -text "ファイル" -menu .b0.m0 menubutton .b1 -text "編集" -menu .b1.m0 menubutton .b2 -text "表示" -menu .b2.m0 menubutton .b3 -text "特別" -menu .b3.m0 menu .b0.m0 menu .b1.m0 menu .b2.m0 menu .b3.m0 .b0.m0 add command -label "開く" -command { } .b0.m0 add separator .b0.m0 add command -label "新規ディレクトリ" -command { MakeNewDir } .b0.m0 add command -label "コピー(複製)" -command { copyFile } .b0.m0 add command -label "〜 へ移動" -command { } .b0.m0 add command -label "情報を見る" -command { } .b0.m0 add separator .b0.m0 add command -label "閉じる(終了)" -command { exit } .b1.m0 add command -label "コピー(取り込む)" -command { copyFileName } .b1.m0 add command -label "ペースト(張り付ける)" -command { pasteFile } .b1.m0 add separator .b1.m0 add command -label "クリップボード" -command { showClip } .b2.m0 add cascade -label "ドットファイル" -menu .b2.m0.n0 menu .b2.m0.n0 .b2.m0.n0 add radiobutton -label "表示する" -command { set ShowDotFile 1 Refresh } .b2.m0.n0 add radiobutton -label "表示しない" -command { set ShowDotFile 0 Refresh } .b3.m0 add command -label "設定パネル" -command { } pack .b0 .b1 .b2 .b3 -in .f1 -side left #pack .f1 -side top -fill x canvas .c0 -width 500 -height 500 -yscrollcommand ".s1 set" -bg white -scrollregion " 0 0 500 $canvasY " scrollbar .s1 -orient vertical -command ".c0 yview" frame .f0 entry .e0 -textvariable Crtdir pack .e0 -in .f0 -fill x grid .f1 -row 0 -column 0 -columnspan 2 -sticky ew grid .f0 -row 1 -column 0 -columnspan 2 -sticky ew grid .c0 -row 2 -column 0 -sticky nsew grid .s1 -row 2 -column 1 -sticky ns } # 新規ディレクトリを作る proc MakeNewDir {} { global Crtdir toplevel .dialog label .dialog.l0 -text "新規ディレクトリ名を入力" entry .dialog.e0 -background white -textvariable NewDirName button .dialog.b0 -text "閉じる" -command { destroy .dialog } bind .dialog.e0{ exec mkdir [join "$Crtdir $NewDirName" {/}] & Refresh } pack .dialog.l0 pack .dialog.e0 -fill x pack .dialog.b0 } # ファイル・ディレクトリの複製 proc copyFile {} { global Crtdir Filename selected selectList select_Exist if { $select_Exist == 0 } { tk_messageBox -type ok -message "複製するアイコンが\n指定されていません。 " } else { foreach i $selectList { set orgName [join "$Crtdir $Filename($i)" "/"] set nName [join "$orgName のコピー" ""] exec cp -r $orgName $nName } } Refresh } # コピー(取り込む) proc copyFileName {} { global Crtdir Filename selectList select_Exist Clip_Exist Clip IconImage ClipIcon ClipList if { $select_Exist == 0 } { tk_messageBox -type ok -message "コピーするアイコンが\n指定されていません。" } else { foreach i $selectList { set Clip($i) [join "$Crtdir $Filename($i)" "/"] image create photo ClipIcon($i) ClipIcon($i) copy -subsample 3 IconImage($i) } # selectList は他の操作で破棄されてしまう一時的なものなので、 # データの保持のためにClipList にコピーしておく。 # クリップボード・ペーストではループにこちらを利用する。 set Clip_Exist 1 set ClipList $selectList } } # クリップボード proc showClip {} { global Clip ClipIcon Clip_Exist selectList ClipList toplevel .dialog -bg white wm title .dialog "クリップボード" if { $Clip_Exist == 0 } { label .dialog.msgl -text "クリップボードの中身は空です。" -bg white pack .dialog.msgl } else { foreach i $ClipList { frame .dialog.fr$i -bg white label .dialog.naLa$i -text $Clip($i) -bg white label .dialog.imla$i -image ClipIcon($i) pack .dialog.imla$i -in .dialog.fr$i -side left pack .dialog.naLa$i -in .dialog.fr$i -side left pack .dialog.fr$i -fill x } } button .dialog.b0 -text "閉じる" -command { destroy .dialog } pack .dialog.b0 -fill x } # ペースト(張り付ける) proc pasteFile {} { global Clip Crtdir selectList Clip_Exist ClipList select_Exist if { $Clip_Exist == 0 } { tk_messageBox -type ok -message "ペーストするものが\nありません" } else { foreach i $ClipList { exec mv $Clip($i) $Crtdir } Refresh # リストをクリア set selectList "" set ClipList "" # フラグを落し、クリップボード・選択範囲を初期化 set Clip_Exist 0 set select_Exist 0 } } #アイコンを描く proc DrawIcon { } { global IconNum Filename icon filelabel IconImage iconX iconY for { set i 0 } { $i < $IconNum } {set i [expr $i+1]} { set icon($i) [.c0 create image $iconX($i) $iconY($i) -image IconImage($i)] set filelabel($i) [.c0 create text $iconX($i) [expr $iconY($i)+35] -text $Filename($i)] } } # キャンバスをクリアし、アイコンを再描画 proc Refresh { } { global canvasY GetInfo SetIconXY .c0 delete all ; .c0 configure -scrollregion " 0 0 500 $canvasY" DrawIcon Event } # マウス・イベント proc Event {} { global selectList IconNum icon Filename Crtdir IconImage select_Exist x0 y0 MoveIconList MoveIconList_Exist for { set i 0 } { $i < $IconNum } {set i [expr $i+1]} { .c0 bind $icon($i) " set x0 %x set y0 %y selectCLR set selectList $i IconImage($i) configure -gamma 0.4 set select_Exist 1 " .c0 bind $icon($i) "DoubleClick" .c0 bind $icon($i) "MoveIcon %x %y" .c0 bind $icon($i) "DropIcon $i %x %y" bind .c0 { set MoveIconList "" set MoveIconList_Exist 0 selectCLR } } selectRange } # 中ボタンドラッグで範囲選択 proc selectRange { } { global selectList IconImage iconX iconY select_Exist MoveIconList MoveIconList_Exist bind .c0 { set rangeX [.c0 canvasx %x] set rangeY [.c0 canvasy %y] .c0 create rectangle $rangeX $rangeY $rangeX $rangeY -width 2 -outline brown -tag Range } bind .c0 { .c0 coords Range $rangeX $rangeY [.c0 canvasx %x] [.c0 canvasy %y] } bind .c0 { # 選択アイコンをクリア set selectList "" for { set i 0 } { $i < $IconNum } {set i [expr $i+1]} { IconImage($i) configure -gamma 1 } # 原点から近い点(nX,nY)、遠い点(dX,dY)を求める if { $rangeX < [.c0 canvasx %x] } { set nX $rangeX set dX [.c0 canvasx %x] } if { $rangeX > [.c0 canvasx %x] } { set nX [.c0 canvasx %x] set dX $rangeX } if { $rangeY < [.c0 canvasy %y] } { set nY $rangeY set dY [.c0 canvasy %y] } if { $rangeY > [.c0 canvasy %y] } { set nY [.c0 canvasy %y] set dY $rangeY } # アイコンをサーチし、選択範囲に含まれるかを判定 for { set i 0 } { $i < $IconNum } {set i [expr $i+1]} { if { $nX < $iconX($i) } { if { $iconX($i) < $dX } { if { $nY < $iconY($i) } { if { $iconY($i) < $dY } { lappend selectList $i IconImage($i) configure -gamma 0.4 } } } } } set select_Exist 1 set MoveIconList $selectList set MoveIconList_Exist 1 .c0 delete Range } } # 選択をクリア proc selectCLR {} { global IconNum IconImage selectList MoveIconList_Exist set selectList "" if { $MoveIconList_Exist == 0 } { for { set i 0 } { $i < $IconNum } {set i [expr $i+1]} { IconImage($i) configure -gamma 1.0 } } set select_Exist 0 } #ダブルクリック proc DoubleClick {} { global Crtdir Filename shurui selectList foreach i $selectList { set FullPath [join "$Crtdir $Filename($i)" {/}] if { $shurui($i) == "ディレクトリ" } { set Crtdir $FullPath Refresh } else { if { $shurui($i) == "実行ファイル" } { exec $FullPath & } if { $shurui($i) == "ファイル" } { exec mule $FullPath & } if { $shurui($i) == "画像" } { exec xv $FullPath & } } } } # ドラッグでアイコンを動かす proc MoveIcon { x y } { global x0 y0 iconX iconY icon filelabel selectList MoveIconList MoveIconList_Exist set x1 [expr $x-$x0] set y1 [expr $y-$y0] if { $MoveIconList_Exist == 1 } { if { [lsearch $MoveIconList $selectList] != -1 } { set selectList $MoveIconList } } foreach i $selectList { .c0 raise $icon($i) .c0 raise $filelabel($i) .c0 move $icon($i) $x1 $y1 .c0 move $filelabel($i) $x1 $y1 set iconX($i) [expr $iconX($i)+$x1] set iconY($i) [expr $iconY($i)+$y1] } set x0 $x set y0 $y } # アイコンをドロップした時の処理 proc DropIcon { inum x y } { global selectList MoveIconList MoveIconList_Exist IconNum IconImage iconX iconY shurui Crtdir Filename for { set i 0 } { $i < $IconNum } { set i [expr $i+1] } { set disX [expr abs($iconX($i)-$x)] set disY [expr abs($iconY($i)-$y)] if { $i != $inum } { if { ($disX < 20) && ($disY < 20) } { foreach t $selectList { if { $shurui($i) == "ディレクトリ" } { set orgName($t) [join "$Crtdir $Filename($t)" "/"] set nName($i) [join "$Crtdir $Filename($i)" "/"] exec mv $orgName($t) $nName($i) } } Refresh } } } set MoveIconList "" set MoveIconList_Exist 0 } # メインルーチン GetInfo SetIconXY BuildGUI DrawIcon Event bind .e0 { Refresh }