２００１/０６/０９版

当バージョンでは　発地と着地の選択を可能にし　金額計算を発地　着地を元に計算するよう改訂。
またＴｃｌ／Ｔｋ　ＣＯＢＯＬのコーディングを見直し（ちょっとコメント追加する）
開発環境　Ｖｉｎｅ　Ｌｉｎｕｘ　２.０　Ｔｉｎｙｃｏｂｏｌ-0.53
今回は発地と着地選択の追加。発地決定ボタンを押すとリストボックス上部に選択した地域が表示されます。その発地と着地を元にＣＯＢＯＬで金額計算します。
金額計算はサイズ毎にＯＣＣＵＲＳ１２×ＯＣＣＵＲＳ１２のテーブルを内部テーブルとして持ち、発地と着地をインデックスにし金額を決定しております。
Ｔｃｌ／Ｔｋの画面に関してはこれがほぼ最終形になります。
次期バージョンでは内部テーブルのファイル化,出来ればＰｏｓｔｇｒｅＳＱＬを使用して金額を算出したいと思っております。

　　以下にソースを紹介いたします。

まずはＣＯＢＯＬでyamato．ｃｏｂです。

IDENTIFICATION DIVISION.
PROGRAM-ID. YAMATO.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
DATA DIVISION.
FILE SECTION.

WORKING-STORAGE SECTION.
01 WK-OUT PIC X(20).
01 CMDLINE-PARMS PIC X(64).
01 WK-PRONAME PIC X(10) VALUE '$$$$$$$$$$'.
01 WK-ACC01 PIC X(15) VALUE '$$$$$$$$$$$$$$$'.
01 WK-ACC02 PIC X(15) VALUE '$$$$$$$$$$$$$$$'.
01 WK-ACC03 PIC X(15) VALUE '$$$$$$$$$$$$$$$'.
01 WK-ACC04 PIC X(15) VALUE '$$$$$$$$$$$$$$$'.
01 WK-ACC05 PIC X(02) VALUE '$$'.
01 WK-ACC06 PIC X(02) VALUE '$$'.
01 A PIC X(15).
01 C PIC S9(12)V9(3).
01 JSW PIC 9.
01 WK-KWKKA.
03 WK-TATE PIC S9(06)V9(3).
03 WK-YOKO PIC S9(06)V9(3).
03 WK-TAKA PIC S9(06)V9(3).
03 WK-OMOS PIC S9(06)V9(3).
01 WK-SIZE1 PIC S9(06)V9(3).
01 WK-SIZE2 PIC S9(06)V9(3).
01 WK-SIZE PIC S9(06)V9(3).
01 WK-3HEN PIC S9(06)V9(3).
01 WK-DKIN PIC ZZ,ZZZ,ZZ9.
01 WK-OUT PIC X(10).
01 I PIC 9(3).
01 J PIC 9(3).
01 WK-INDEXH PIC 9(3).
01 WK-INDEXC PIC 9(3).
01 WT-60.
03 WT-60DAT.
05 WT-60DAT1 PIC X(48) VALUE
"074009501050116011601260126014701580168017901890".
05 WT-60DAT2 PIC X(48) VALUE
"095007400740084008400950095010501160126013701580".
05 WT-60DAT3 PIC X(48) VALUE
"105007400740074007400840084009501160126013701470".
05 WT-60DAT4 PIC X(48) VALUE
"116008400740074007400740074008400950105011601260".
05 WT-60DAT5 PIC X(48) VALUE
"116008400740074007400740074008400950105011601370".
05 WT-60DAT6 PIC X(48) VALUE
"126009500840074007400740074007400840095009501260".
05 WT-60DAT7 PIC X(48) VALUE
"126009500840074007400740074007400840095009501370".
05 WT-60DAT8 PIC X(48) VALUE
"126009500840074007400740074007400840095009501370".
05 WT-60DAT9 PIC X(48) VALUE
"158011601160095009500840084007400740084007401260".
05 WT-60DAT10 PIC X(48) VALUE
"168012601260105010500950095008400840074008401260".
05 WT-60DAT11 PIC X(48) VALUE
"179013701370116011600950095008400740084007401160".
05 WT-60DAT12 PIC X(48) VALUE
"189015801470126013701260137012601260126011600740".
03 WT-60TBL.
05 WT-60TBLX OCCURS 12.
07 WT-60KIN PIC 9(04) OCCURS 12.
01 WT-80.
03 WT-80DAT.
05 WT-80DAT1 PIC X(48) VALUE
"095011601260137013701470147016801790189020002420".
05 WT-80DAT2 PIC X(48) VALUE
"116009500950105010501160116012601370147015802100".
05 WT-80DAT3 PIC X(48) VALUE
"126009500950095009501050105011601370147015802000".
05 WT-80DAT4 PIC X(48) VALUE
"137010500950095009500950095010501160126013701790".
05 WT-80DAT5 PIC X(48) VALUE
"137010500950095009500950095010501160126013701890".
05 WT-80DAT6 PIC X(48) VALUE
"147011601050095009500950095009501050116011601790".
05 WT-80DAT7 PIC X(48) VALUE
"147011601050095009500950095009501050116011601890".
05 WT-80DAT8 PIC X(48) VALUE
"168012601160105010500950095009500950105010501790".
05 WT-80DAT9 PIC X(48) VALUE
"179013701370116011601050105009500950105009501790".
05 WT-80DAT10 PIC X(48) VALUE
"189014701470126012601160116010501050095010501790".
05 WT-80DAT11 PIC X(48) VALUE
"200015801580137013701160116010500950105009501680".
05 WT-80DAT12 PIC X(48) VALUE
"242021002000179018901790189017901790179016800950".
03 WT-80TBL.
05 WT-80TBLX OCCURS 12.
07 WT-80KIN PIC 9(04) OCCURS 12.
01 WT-100.
03 WT-100DAT.
05 WT-100DAT1 PIC X(48) VALUE
"116013701470158015801680168018902000210022102940".
05 WT-100DAT2 PIC X(48) VALUE
"137011601160126012601370137014701580168017902630".
05 WT-100DAT3 PIC X(48) VALUE
"147011601160116011601260126013701580168017902520".
05 WT-100DAT4 PIC X(48) VALUE
"158012601160116011601160116012601370147015802310".
05 WT-100DAT5 PIC X(48) VALUE
"158012601160116011601160116012601370147015802420".
05 WT-100DAT6 PIC X(48) VALUE
"168013701260116011601160116011601260137013702310".
05 WT-100DAT7 PIC X(48) VALUE
"168013701260116011601160116011601260137013702420".
05 WT-100DAT8 PIC X(48) VALUE
"189014701370126012601160116011601160126012602310".
05 WT-100DAT9 PIC X(48) VALUE
"200015801580137013701260126011601160126011602310".
05 WT-100DAT10 PIC X(48) VALUE
"210016801680147014701370137012601260116012602310".
05 WT-100DAT11 PIC X(48) VALUE
"221017901790158015801370137012601160126011602210".
05 WT-100DAT12 PIC X(48) VALUE
"294026302520231024202310242023102310231022101160".
03 WT-100TBL.
05 WT-100TBL1 OCCURS 12.
07 WT-100KIN PIC 9(04) OCCURS 12.
01 WT-120.
03 WT-120DAT.
05 WT-120DAT1 PIC X(48) VALUE
"137015801680179017901890189021002210231024203470".
05 WT-120DAT2 PIC X(48) VALUE
"158013701370147014701580158016801790189020003150".
05 WT-120DAT3 PIC X(48) VALUE
"168013701370137013701470147015801790189020003050".
05 WT-120DAT4 PIC X(48) VALUE
"179014701370137013701370137014701580168017902840".
05 WT-120DAT5 PIC X(48) VALUE
"179014701370137013701370137014701580168017902940".
05 WT-120DAT6 PIC X(48) VALUE
"189015801470137013701370137013701470158015802840".
05 WT-120DAT7 PIC X(48) VALUE
"189015801470137013701370137013701470158015802940".
05 WT-120DAT8 PIC X(48) VALUE
"210016801580147014701370137013701370147014702840".
05 WT-120DAT9 PIC X(48) VALUE
"221017901790158015801470147013701370147013702840".
05 WT-120DAT10 PIC X(48) VALUE
"231018901890168016801580158014701470137014702840".
05 WT-120DAT11 PIC X(48) VALUE
"242020002000179017901580158014701370147013702730".
05 WT-120DAT12 PIC X(48) VALUE
"347031503050284029402840294028402840284027301370".
03 WT-120TBL.
05 WT-120TBL1 OCCURS 12.
07 WT-120KIN PIC 9(04) OCCURS 12.
01 WT-140.
03 WT-140DAT.
05 WT-140DAT1 PIC X(48) VALUE
"158017901890200020002100210023102420252026303990".
05 WT-140DAT2 PIC X(48) VALUE
"179015801580168016801790179018902000210022103680".
05 WT-140DAT3 PIC X(48) VALUE
"189015801580158015801680168017902000210022103570".
05 WT-140DAT4 PIC X(48) VALUE
"200016801580158015801580158016801790189020003360".
05 WT-140DAT5 PIC X(48) VALUE
"200016801580158015801580158016801790189020003470".
05 WT-140DAT6 PIC X(48) VALUE
"210017901680158015801580158015801680179017903360".
05 WT-140DAT7 PIC X(48) VALUE
"210017901680158015801580158015801680179017903470".
05 WT-140DAT8 PIC X(48) VALUE
"231018901790168016801580158015801580168016803360".
05 WT-140DAT9 PIC X(48) VALUE
"242020002000179017901680168015801580168015803360".
05 WT-140DAT10 PIC X(48) VALUE
"252021002100189018901790179016801680158016803360".
05 WT-140DAT11 PIC X(48) VALUE
"263022102210200020001790179016801580168015803260".
05 WT-140DAT12 PIC X(48) VALUE
"399036803570336034703360347033603360336032601580".
03 WT-140TBL.
05 WT-140TBL1 OCCURS 12.
07 WT-140KIN PIC 9(04) OCCURS 12.
01 WT-160.
03 WT-160DAT.
05 WT-160DAT1 PIC X(48) VALUE
"179020002100221022102310231025202630273028404520".
05 WT-160DAT2 PIC X(48) VALUE
"200017901790189018902000200021002210231024204200".
05 WT-160DAT3 PIC X(48) VALUE
"210017901790179017901890189020002210231024204100".
05 WT-160DAT4 PIC X(48) VALUE
"221018901790179017901790179018902000210022103890".
05 WT-160DAT5 PIC X(48) VALUE
"221018901790179017901790179018902000210022103990".
05 WT-160DAT6 PIC X(48) VALUE
"231020001890179017901790179017901890200020003890".
05 WT-160DAT7 PIC X(48) VALUE
"231020001890179017901790179017901890200020003990".
05 WT-160DAT8 PIC X(48) VALUE
"252021002000189018901790179017901790189018903890".
05 WT-160DAT9 PIC X(48) VALUE
"263022102210200020001890189017901790189017903890".
05 WT-160DAT10 PIC X(48) VALUE
"273023102310210021002000200018901890179018903890".
05 WT-160DAT11 PIC X(48) VALUE
"284024202420221022102000200018901790189017903780".
05 WT-160DAT12 PIC X(48) VALUE
"452042004100389039903890399038903890389037801790".
03 WT-160TBL.
05 WT-160TBL1 OCCURS 12.
07 WT-160KIN PIC 9(04) OCCURS 12.
PROCEDURE DIVISION.
A-000.
ACCEPT CMDLINE-PARMS FROM COMMAND-LINE.
UNSTRING CMDLINE-PARMS DELIMITED BY ' ' INTO
WK-PRONAME WK-ACC01 WK-ACC02 WK-ACC03 WK-ACC04 WK-ACC05 WK-ACC06.
** 縦 **
MOVE WK-ACC01 TO A.
MOVE ZERO TO C.
CALL "SUBX" USING A C JSW.
MOVE C TO WK-TATE.
** **
MOVE WK-ACC02 TO A.
MOVE ZERO TO C.
CALL "SUBX" USING A C JSW.
MOVE C TO WK-YOKO.
** **
MOVE WK-ACC03 TO A.
MOVE ZERO TO C.
CALL "SUBX" USING A C JSW.
MOVE C TO WK-TAKA.
** 重 **
MOVE WK-ACC04 TO A.
MOVE ZERO TO C.
CALL "SUBX" USING A C JSW.
MOVE C TO WK-OMOS.
** 地 **
MOVE WK-ACC05 TO WK-INDEXH.
** 地 **
MOVE WK-ACC06 TO WK-INDEXC.
*
** サイズチェック **
COMPUTE WK-3HEN = WK-TATE + WK-YOKO + WK-TAKA.
IF WK-3HEN NOT > 60
MOVE 60 TO WK-SIZE1
ELSE
IF WK-3HEN NOT > 80
MOVE 80 TO WK-SIZE1
ELSE
IF WK-3HEN NOT > 100
MOVE 100 TO WK-SIZE1
ELSE
IF WK-3HEN NOT > 120
MOVE 120 TO WK-SIZE1
ELSE
IF WK-3HEN NOT > 140
MOVE 140 TO WK-SIZE1
ELSE
IF WK-3HEN NOT > 160
MOVE 160 TO WK-SIZE1
ELSE
MOVE "サイズ オーバー" TO WK-OUT
GO TO A-999.
*
IF WK-OMOS NOT > 2000
MOVE 60 TO WK-SIZE2
ELSE
IF WK-OMOS NOT > 5000
MOVE 80 TO WK-SIZE2
ELSE
IF WK-OMOS NOT > 10000
MOVE 100 TO WK-SIZE
ELSE
IF WK-OMOS NOT > 15000
MOVE 120 TO WK-SIZE2
ELSE
IF WK-OMOS NOT > 20000
MOVE 140 TO WK-SIZE2
ELSE
IF WK-OMOS NOT > 25000
MOVE 160 TO WK-SIZE2
ELSE
MOVE "重 オーバー" TO WK-OUT
GO TO A-999.
*
IF WK-SIZE1 > WK-SIZE2
MOVE WK-SIZE1 TO WK-SIZE
ELSE
MOVE WK-SIZE2 TO WK-SIZE.
*
IF WK-INDEXH = 0
MOVE 1 TO I
ELSE
IF WK-INDEXH = 1 OR 2 OR 3
MOVE 2 TO I
ELSE
IF WK-INDEXH = 4 OR 5 OR 6
MOVE 3 TO I
ELSE
IF WK-INDEXH = 7 OR 8 OR 9 OR 10 OR
11 OR 12 OR 13 OR 14
MOVE 4 TO I
ELSE
IF WK-INDEXH = 15 OR 16
MOVE 5 TO I
ELSE
IF WK-INDEXH = 17 OR 18 OR 19
MOVE 6 TO I
ELSE
IF WK-INDEXH = 20 OR 21 OR 22 OR 23
MOVE 7 TO I
ELSE
IF WK-INDEXH = 24 OR 25 OR 26 OR 27 OR
28 OR 29
MOVE 8 TO I
ELSE
IF WK-INDEXH = 30 OR 31 OR 32 OR 33 OR
34
MOVE 9 TO I
ELSE
IF WK-INDEXH = 35 OR 36 OR 37 OR 38
MOVE 10 TO I
ELSE
IF WK-INDEXH = 39 OR 40 OR 41 OR 42 OR
43 OR 44 OR 45
MOVE 11 TO I
ELSE
MOVE 12 TO I.
*
IF WK-INDEXC = 0
MOVE 1 TO J
ELSE
IF WK-INDEXC = 1 OR 2 OR 3
MOVE 2 TO J
ELSE
IF WK-INDEXC = 4 OR 5 OR 6
MOVE 3 TO J
ELSE
IF WK-INDEXC = 7 OR 8 OR 9 OR 10 OR
11 OR 12 OR 13 OR 14
MOVE 4 TO J
ELSE
IF WK-INDEXC = 15 OR 16
MOVE 5 TO J
ELSE
IF WK-INDEXC = 17 OR 18 OR 19
MOVE 6 TO J
ELSE
IF WK-INDEXC = 20 OR 21 OR 22 OR 23
MOVE 7 TO J
ELSE
IF WK-INDEXC = 24 OR 25 OR 26 OR 27 OR
28 OR 29
MOVE 8 TO J
ELSE
IF WK-INDEXC = 30 OR 31 OR 32 OR 33 OR
34
MOVE 9 TO J
ELSE
IF WK-INDEXC = 35 OR 36 OR 37 OR 38
MOVE 10 TO J
ELSE
IF WK-INDEXC = 39 OR 40 OR 41 OR 42 OR
43 OR 44 OR 45
MOVE 11 TO J
ELSE
MOVE 12 TO J.
*
MOVE WT-60DAT TO WT-60TBL.
MOVE WT-80DAT TO WT-80TBL.
MOVE WT-100DAT TO WT-100TBL.
MOVE WT-120DAT TO WT-120TBL.
MOVE WT-140DAT TO WT-140TBL.
MOVE WT-160DAT TO WT-160TBL.
EVALUATE WK-SIZE
WHEN 60
MOVE WT-60KIN (I J) TO WK-DKIN
WHEN 80
MOVE WT-80KIN (I J) TO WK-DKIN
WHEN 100
MOVE WT-100KIN (I J) TO WK-DKIN
WHEN 120
MOVE WT-120KIN (I J) TO WK-DKIN
WHEN 140
MOVE WT-140KIN (I J) TO WK-DKIN
WHEN 160
MOVE WT-160KIN (I J) TO WK-DKIN
END-EVALUATE.
*
MOVE WK-DKIN TO WK-OUT.
A-999.
DISPLAY WK-OUT.
EXIT-PROGRAM.

Ｔｃｌ／Ｔｋです。unchin．ｔｃｌ　
（ちなみに当方Ｔｃｌ／Ｔｋに関しては全くの初心者ですのでセオリー通りに作成出来ていなく、お恥ずかしいのですが　一応紹介いたします。）

#! /usr/bin/wish
#option add *font kanji16
frame .hat ; #発地
frame .hat.box ; #発地ボックス
frame .chk ; #着地
frame .chk.box ; #着地ボックス
frame .midasi ; #表題
frame .tate ; #縦
frame .yoko -bg red ; #横
frame .taka -bg red ; #高さ
frame .omos -bg red ; #重量
set ent1 ""
set ent2 ""
set ent3 ""
set ent4 ""
set indexa ""
set indexb ""
set dataa ""
set datab ""
#
#ボックスセット内容
set ken {北海道 青森県 秋田県 岩手県 宮城県 山形県 福島県 茨城県 栃木県
群馬県 埼玉県 千葉県 東京都 神奈川県 山梨県 長野県 新潟県 富山県
石川県 福井県 静岡県 愛知県 岐阜県 三重県 滋賀県 京都府 大阪府
兵庫県 奈良県 和歌山県 岡山県 広島県 山口県 鳥取県 島根県
徳島県 香川県 愛媛県 高知県 福岡県 佐賀県 長崎県 熊本県 大分県
宮崎県 鹿児島県 沖縄県}
#
#発地ボックス
entry .hat.dspken -relief groove -bd 2 -width 10
listbox .hat.box.lis -height 15 -width 8 -background white -yscrollcommand {.hat.box.scrl set}
foreach i ${ken} {
.hat.box.lis insert end $i
}
scrollbar .hat.box.scrl -command {.hat.box.lis yview}
button .hat.b1 -relief raised -text "発地決定" -background #cccccc -command sethat
#
#着地ボックス
entry .chk.dspken -relief groove -bd 2 -width 10
listbox .chk.box.lis -height 15 -width 8 -background "#66cccc" -yscrollcommand {.chk.box.scrl set}
foreach j ${ken} {
.chk.box.lis insert end $j
}
scrollbar .chk.box.scrl -command {.chk.box.lis yview}
button .chk.b1 -relief raised -text "着地決定" -background "#229999" -command setchk
#
#サイズ入力
label .midasi.la1 -text 宅配便送料算出
label .tate.inputlabel -bg #990000 -fg white -text 縦のサイズ -width 10
entry .tate.inputentry -width 8 -relief sunken -textvariable ent1
label .yoko.inputlabel -bg #000099 -fg white -text 横のサイズ -width 10
entry .yoko.inputentry -width 8 -relief sunken -textvariable ent2
label .taka.inputlabel -bg #009900 -fg white -text 高さ -width 10
entry .taka.inputentry -width 8 -relief sunken -textvariable ent3
label .omos.inputlabel -bg black -fg white -text 重量(グラム) -width 10
entry .omos.inputentry -width 8 -relief sunken -textvariable ent4
#
#種類選択
radiobutton .rad1 -text "クロネコヤマト宅急便" -variable sw -value "A" -selectcolor blue
radiobutton .rad2 -text "ゆうパック" -variable sw -value "B" -selectcolor red
radiobutton .rad3 -text "定形外郵便" -variable sw -value "C" -selectcolor yellow
#
#実行ボタン
button .enter -text 実行 -command {enter [.tate.inputentry get] [.yoko.inputentry get] [.taka.inputentry get] [.omos.inputentry get] $indexa $indexb $sw}
#
#終了ボタン
button .syuryo -text 終了 -command exit
#パッキング
pack .midasi
pack .hat.box.lis .hat.box.scrl -fill y -in .hat.box -side left
pack .hat.dspken .hat.box .hat.b1 -in .hat -side top
pack .chk.box.lis .chk.box.scrl -fill y -in .chk.box -side left
pack .chk.dspken .chk.box .chk.b1 -in .chk -side top
pack .hat -side left
pack .chk -side left
pack .midasi.la1
pack .tate.inputlabel .tate.inputentry -in .tate -side left
pack .yoko.inputlabel .yoko.inputentry -in .yoko -side left
pack .taka.inputlabel .taka.inputentry -in .taka -side left
pack .omos.inputlabel .omos.inputentry -in .omos -side left
pack .midasi .tate .yoko .taka .omos -side top
pack .rad1 .rad2 .rad3 .enter .syuryo -side top -anchor w
#
#---------------エンター処理---------------
proc enter {arg1 arg2 arg3 arg4 arg5 arg6 arg7} {
global indexa
global indexb
if {$arg1 < 1 } {
tk_messageBox -message "縦サイズ エラー"
focus .tate.inputentry
} elseif {$arg2 < 1} {
tk_messageBox -message "横サイズ エラー"
focus .yoko.inputentry
} elseif {$arg3 < 1} {
tk_messageBox -message "高さサイズ エラー"
focus .taka.inputentry
} elseif {$arg4 < 1} {
tk_messageBox -message "重さ エラー"
focus .omos.inputentry
} elseif {$arg5 < 0} {
tk_messageBox -message "発地未選択 エラー"
focus .omos.inputentry
} elseif {$arg6 < 0} {
tk_messageBox -message "着地未選択 エラー"
focus .omos.inputentry
} elseif {$arg7 == "A"} {
set command "./yamato $arg1 $arg2 $arg3 $arg4 $arg5 $arg6"
set result [eval exec $command]
tk_messageBox -message $result
focus .tate.inputentry
if {$result < 9999} {
.hat.dspken delete 0 end
.chk.dspken delete 0 end
set indexa ""
set indexb ""
set dataa ""
set datab ""
}
} elseif {$arg7 == "B"} {
set command "./yupack $arg1 $arg2 $arg3 $arg4 $arg5 $arg6"
set result [eval exec $command]
tk_messageBox -message $result
focus .tate.inputentry
if {$result < 9999} {
.hat.dspken delete 0 end
.chk.dspken delete 0 end
set indexa ""
set indexb ""
set dataa ""
set datab ""
}
} elseif {$arg7 == "C"} {
set command "./teigai $arg1 $arg2 $arg3 $arg4 $arg5 $arg6"
set result [eval exec $command]
tk_messageBox -message $result
focus .tate.inputentry
if {$result < 9999} {
.hat.dspken delete 0 end
.chk.dspken delete 0 end
set indexa ""
set indexb ""
set dataa ""
set datab ""
}
} else {
tk_messageBox -message "便選択 エラー"
focus .tate.inputentry
}
}
#
#-----------発地セット処理--------------
proc sethat {} {
global indexa
global dataa
set indexa [.hat.box.lis curselection]
set dataa [.hat.box.lis get $indexa]
.hat.dspken delete 0 end
.hat.dspken insert 0 $dataa
}
#
#-----------着地セット処理-------------
proc setchk {} {
global indexb
global datab
set indexb [.chk.box.lis curselection]
set datab [.chk.box.lis get $indexb]
.chk.dspken delete 0 end
.chk.dspken insert 0 $datab
}