set env(PGCLIENTENCODING) UNICODE
package require Tix
load /usr/local/pgsql/lib/libpgtcl.so
wm title . "Items"
option add *Font kanji16
namespace eval MMitems {
# 修正フラグ(その行のいずれかのセルが修正されたら1、初期は0)
variable mo
array set mo { }
# セルの編集状態になったとき、持っておく内容
variable prevContent {}
# 現在のマスターの行数(セルのY座標の最大値)
variable rows 0
# 表udb.itemsの全件を検索し、グリッドに表示します。
# 既存の表示/編集内容は警告なく上書きされます。
proc retrieveMaster g {
variable mo
variable rows
set con [pg_connect "udb"]
set sql {
SELECT ITEM_CODE, ITEM_CLASS, NAME, UOM, PO_FACTOR FROM ITEMS
}
set result [pg_exec $con $sql]
set rows [pg_result $result -numTuples]
if {$rows == 0} {
puts [pg_result $result -error]
pg_disconnect $con
return
}
for {set i 0} {$i<$rows} {incr i} {
set data [pg_result $result -getTuple $i]
set y [expr $i+1]
for {set j 0} {$j < 5} {incr j} {
set x [expr $j+1]
$g set $x $y -itemtype text -text [lindex $data $j]
}
$g set 0 $y -itemtype text -text $y
set mo($y) 0
}
pg_disconnect $con
}
# 修正が発生している行を探し、順次DBに更新を行います。
proc updateMaster g {
variable rows
variable mo
set con [pg_connect "udb"]
for {set y 1} {$y <= $rows} {incr y} {
if $mo($y) {
# 主キー列を正しく指定する必要があります
set code [$g entrycget 1 $y -text]
puts "$code は更新が必要です。"
set class [$g entrycget 2 $y -text]
set name [$g entrycget 3 $y -text]
set uom [$g entrycget 4 $y -text]
set pf [$g entrycget 5 $y -text]
set sql "\
UPDATE ITEMS
SET ITEM_CLASS = '$class', NAME = '$name',
UOM = '$uom', PO_FACTOR = $pf
WHERE ITEM_CODE = '$code'"
set result [pg_exec $con $sql]
puts "[pg_result $result -status]:[pg_result $result -error]"
set mo($y) 0
}
}
pg_disconnect $con
}
# グリッドのフォーマットコマンドです。
proc formatCmd {g area x1 y1 x2 y2} {
switch $area {
x-margin {
$g format grid $x1 $y1 $x2 $y2 -bd 1 -bg #c0f0c0 -fill 1 }
y-margin {
$g format grid $x1 $y1 $x2 $y2 -bd 1 -bg #c0c0f0 -fill 1 }
s-margin {
$g format grid $x1 $y1 $x2 $y2 -bd 1 -bg #f0c0c0 -fill 1 }
default {
$g format grid $x1 $y1 $x2 $y2 -bd 1 }
}
}
# グリッドの編集可否を決めるプロシージャ
proc notifyCmd {g x y} {
if {$x == 0 || $y == 0} { return 0 }
# 主キー列は変更できません。ここでは、第1カラム(品目コード)が主キー列。
if {$x == 1} {return 0}
return 1
}
# セルからマウスが離れるときに呼ばれ、編集前と内容が違っていたら
# 修正フラグを立てます。
proc editDoneCmd {g x y} {
variable mo
variable prevContent
set currContent [$g entrycget $x $y -text]
if [string compare $prevContent $currContent] {
puts "修正されました：$x $y $prevContent $currContent"
# その行は修正された(更新が必要)ことをフラグで示す
set mo($y) 1
}
}
# セルがクリックされたときに呼ばれ、その座標の現在の内容を
# 名前空間変数prevContentに保存します。
proc editStartCmd {g cx cy} {
variable prevContent
# ウィジェット座標からセル座標を得る
set cell [$g nearest $cx $cy]
set x [lindex $cell 0]
set y [lindex $cell 1]
# 編集前の内容を保存
set prevContent [$g entrycget $x $y -text]
# puts "保存しました：$x $y $prevContent"
}
# 初期化プロシージャ
proc init {} {
set ns [namespace current]
# グリッドを作成します
set f [frame .f -rel groove -bd 2]
set g [tixGrid $f.g -format "${ns}::formatCmd $f.g" \
-width 6 -height 10\
-editnotifycmd "${ns}::notifyCmd $f.g" \
-editdonecmd "${ns}::editDoneCmd $f.g"\
-xscroll "$f.scrh set" -yscroll "$f.scrv set"]
bind $g "${ns}::editStartCmd %W %x %y"
scrollbar $f.scrv -ori v -command "$g yview"
scrollbar $f.scrh -ori h -command "$g xview"
# カラムの幅と見出しテキストをセットします
set columnWidths {5 20 5 30 4 4}
set i 0; foreach e {No. 品目コード クラス 名称 単位 PF} {
$g set $i 0 -itemtype text -text $e
$g size col $i -size "[lindex $columnWidths $i]char"
incr i
}
# グリッドとスクロールバーをフレームに載せます
grid $g -row 1 -col 1
grid $f.scrv -row 1 -col 2 -sti ns
grid $f.scrh -row 2 -col 1 -sti ew
# メニューバーを作ります
set m [menu .m]
. configure -menu $m
set mf [menu $m.mf]
$m.mf add command -label "終了" -command exit
set me [menu $m.me]
$m.me add command -label "検索" -command "${ns}::retrieveMaster $g"
$m.me add command -label "更新" -command "${ns}::updateMaster $g"
$m add cascade -label "ファイル" -menu $m.mf
$m add cascade -label "データ" -menu $m.me
# フレームを表示します
pack $f
}
}
MMitems::init
# end.
|
