ＡＣＵＣＯＢＯＬ　Ａｃｕｃｏｒｐ　（東京システムハウス（株））


ＡＣＵＣＯＢＯＬ　Ｌｉｎｕｘ　版を試用してみました。

以下がＬｉｎｕｘでサンプルプログラムの　”ｌｉｓｔｂｏｘ.cbl”　を実行させた時の画面です。
Ｘ　ｗｉｎｄｏｗのＧＵＩは無いものの　この画面イメージでは分かりにくいですが　リストボックスの機能が実現されていました。



Ｗｉｎｄｏｗｓではどんな感じの画面になるのかと　同じイメージのプログラムをＷｉｎｄｏｗｓで動かしてみました。
以下　の画面です。


以下がＬｉｎｕｘでの　当プログラム　”ｌｉｓｔｂｏｘ.cbl”　のソースです。
（注　Ｗｉｎｄｏｗｓ版のソースは　また違います）

identification division.
program-id. list-demo.

* Copyright (c) 1996 - 2000 by Acucorp, Inc. ACUCOBOLユーザーは、
* このファイルを自由に使用できる。

remarks.
このプログラムは、異なる LISTBOX コントロール型を例証する。

**************************************************************
data division.
working-storage section.

copy "def/acucobol.def".
copy "def/acugui.def".

77 add-item pic x(20).
77 fast-update-flag pic 9 value zero.
88 fast-update value 1, false zero.

01 list-box-choices.
03 pic x(8) value "Lemons".
03 pic x(8) value "Lemurs".
03 pic x(8) value "Lyceum".
03 pic x(8) value "Lynx".
03 pic x(8) value "Locket".
03 pic x(8) value "Lodge".
03 pic x(8) value "Llamas".
03 pic x(8) value "Lyre".
03 pic x(8) value "Lobsters".
03 pic x(8) value "Lyric".
03 pic x(8) value "Lei".
78 number-of-list-choices value 11.

01 list-choice
redefines list-box-choices
occurs number-of-list-choices times
indexed by list-idx pic x(8).

77 list-data1 pic x(11).
77 list-data2 pic x(11).
77 list-data3 pic x(11).
77 list-data4 pic x(11).

01 text-e1 pic x(15).
01 text-v1 pic x(13).
01 text-e2 pic x(15).
01 text-v2 pic x(13).
01 text-e3 pic x(15).
01 text-v3 pic x(13).
01 text-e4 pic x(15).
01 text-v4 pic x(13).

01 list-visible-1 pic 9 value 1.
88 visible-l1 value 1 false 0.
01 list-enabled-1 pic 9 value 1.
88 enabled-l1 value 1 false 0.
01 list-visible-2 pic 9 value 1.
88 visible-l2 value 1 false 0.
01 list-enabled-2 pic 9 value 1.
88 enabled-l2 value 1 false 0.
01 list-visible-3 pic 9 value 1.
88 visible-l3 value 1 false 0.
01 list-enabled-3 pic 9 value 1.
88 enabled-l3 value 1 false 0.
01 list-visible-4 pic 9 value 1.
88 visible-l4 value 1 false 0.
01 list-enabled-4 pic 9 value 1.
88 enabled-l4 value 1 false 0.

77 key-status
is special-names crt status pic 9(4).
88 exit-button-pushed value 13.

01 screen-control
is special-names screen control.
03 accept-control pic 9.
88 continue-accept value 1.
03 control-value pic 999 value zero.
**************************************************************
screen section.
01 screen-1.
03 label " 省略値"
line 2 column 5 size 10 cells center.

03 list-1 list-box using list-data1
line 3.5 column 5
lines 5 cells size 12 cells
notify-selchange
item-to-add = add-item
mass-update = fast-update-flag
visible = list-visible-1
enabled = list-enabled-1
exception disp-elem.

03 label "選択された項目:"
line 9 column 5.

03 entry-field from list-data1, read-only
enabled 0,
line + 1 column 5 size 12 cells.

03 push-button text-e1
line + 1.5 column 5 size 12 cells
exception-value = 101
exception button-pushed.

03 push-button text-v1
line + 1.5 column 5 size 12 cells
exception-value = 102
exception button-pushed.

03 label "分類なし"
line 2 column 20 size 9 cells center.

03 list-2 list-box using list-data2 unsorted
line 3.5 column 20
lines 5 cells size 12 cells
notify-selchange
item-to-add = add-item
mass-update = fast-update-flag
visible = list-visible-2
enabled = list-enabled-2
exception procedure is disp-elem.

03 label "選択された項目:"
line 9 column 20.

03 entry-field from list-data2, read-only,
enabled 0,
line + 1 column 20 size 12 cells.

03 push-button text-e2
line + 1.5 column 20 size 12 cells
exception-value = 201
exception button-pushed.

03 push-button text-v2
line + 1.5 column 20 size 12 cells
exception-value = 202
exception button-pushed.

03 label "ボックスなし"
line 2 column 35 size 12 cells center.

03 list-3 list-box using list-data3 no-box
line 3.5 column 35
lines 5 cells size 12 cells
notify-selchange
item-to-add = add-item
mass-update = fast-update-flag
visible = list-visible-3
enabled = list-enabled-3
exception disp-elem.

03 label "選択された項目:"
line 9 column 35.

03 entry-field from list-data3, read-only,
enabled 0,
line + 1 column 35 size 12 cells.

03 push-button text-e3
line + 1.5 column 35 size 12 cells
exception-value = 301
exception button-pushed.

03 push-button text-v3
line + 1.5 column 35 size 12 cells
exception-value = 302
exception button-pushed.

03 label "3-D"
line 2 column 50 size 12 cells center.

03 list-4 list-box using list-data4 3-D
line 3.5 column 50
lines 5 cells size 12 cells
notify-selchange
item-to-add = add-item
mass-update = fast-update-flag
visible = list-visible-4
enabled = list-enabled-4
exception disp-elem.

03 label "選択された項目:"
line 9 column 50.

03 entry-field from list-data4, read-only,
enabled 0,
line + 1 column 50 size 12 cells.

03 push-button text-e4
line + 1.5 column 50 size 12 cells
exception-value = 401
exception button-pushed.

03 push-button text-v4
line + 1.5 column 50 size 12 cells
exception-value = 402
exception button-pushed.

03 push-button "終了(&x)"
ok-button
line 16 column 27 size 13.

*****************************************************************
procedure division.
main-logic.
* 灰色の画面背景を設定する。
display standard window,
title "リストボックスサンプル - listbox.cbl",
lines 18, size 65,
background-low.

move "使用不可能" to text-e1, text-e2, text-e3, text-e4.
move "不可視 " to text-v1, text-v2, text-v3, text-v4.
display screen-1.

* 4つのリストボックスすべてを、ここに並行してロードアップする。最
* 初に、より速いMASS-UPDATEモードをセットする。それから、ボックス
* を充たし、最後にボックスの内容を表示するためにMASS-UPDATEモード
* をクリアする。
set fast-update to true.
perform varying list-idx from 1 by 1
until list-idx > number-of-list-choices
move list-choice(list-idx) to add-item
display screen-1
end-perform.
move spaces to add-item.
set fast-update to false.
display screen-1.

perform with test after until exit-button-pushed
accept screen-1 on exception continue end-accept
end-perform.
stop run.

disp-elem.
display screen-1.

button-pushed.
evaluate true
when key-status = 101
if enabled-l1 set enabled-l1 to false
move "使用可能" to text-e1
else set enabled-l1 to true
move "使用不可能" to text-e1
end-if
when key-status = 102
if visible-l1 set visible-l1 to false
move "可視" to text-v1
else set visible-l1 to true
move "不可視" to text-v1
end-if
when key-status = 201
if enabled-l2 set enabled-l2 to false
move "使用可能" to text-e2
else set enabled-l2 to true
move "使用不可能" to text-e2
end-if
when key-status = 202
if visible-l2 set visible-l2 to false
move "可視" to text-v2
else set visible-l2 to true
move "不可視" to text-v2
end-if
when key-status = 301
if enabled-l3 set enabled-l3 to false
move "使用可能" to text-e3
else set enabled-l3 to true
move "使用不可能" to text-e3
end-if
when key-status = 302
if visible-l3 set visible-l3 to false
move "可視" to text-v3
else set visible-l3 to true
move "不可視" to text-v3
end-if
when key-status = 401ＣＤ・ほめ
if enabled-l4 set enabled-l4 to false
move "使用可能" to text-e4
else set enabled-l4 to true
move "使用不可能" to text-e4
end-if
when key-status = 402
if visible-l4 set visible-l4 to false
move "可視" to text-v4
else set visible-l4 to true
move "不可視" to text-v4
end-if
end-evaluate.
display screen-1.
set continue-accept to true.