The following sample program, browser2.cbl, demonstrates usage of the ACUCOBOL-GT WEB-BROWSER2 control. Additional samples have been provided in the sample directory on your ACUCOBOL-GT distribution media. See webbrows.cbl for another useful example.
identification division.
program-id. browser2.
* Copyright (C) 2020 Micro Focus or one
* of its affiliates.
*
* The only warranties for products and services of Micro Focus
* and its affiliates and licensors ("Micro Focus") are set
* forth in the express warranty statements accompanying such
* products and services. Nothing herein should be construed as
* constituting an additional warranty. Micro Focus shall not
* be liable for technical or editorial errors or omissions
* contained herein. The information contained herein is
* subject to change without notice.
*
* Contains Confidential Information. Except as specifically
* indicated otherwise, a valid license is required for possession,
* use or copying. Consistent with FAR 12.211 and 12.212,
* Commercial Computer Software, Computer Software Documentation,
* and Technical Data for Commercial Items are licensed to the U.S.
* Government under vendor's standard commercial license.
remarks.
This program illustrates the WEB-BROWSER2 control.
**************************************************
data division.
working-storage section.
copy "acucobol.def".
copy "acugui.def".
copy "winvers.def".
77 key-status
is special-names crt status pic 9(4) value 0.
88 exit-button-pushed value 27.
01 event-status
is special-names event status.
03 event-type pic x(4) comp-x.
03 event-window-handle usage handle.
03 event-control-handle usage handle.
03 event-control-id pic x(2) comp-x.
03 event-data-1 usage signed-short.
03 event-data-2 usage signed-long.
03 event-action pic x comp-x.
78 event-occurred value 96.
78 go-btn-pressed value 707.
78 back-btn-pressed value 708.
78 forward-btn-pressed value 709.
78 home-btn-pressed value 710.
78 refresh-btn-pressed value 711.
78 search-btn-pressed value 712.
78 stop-btn-pressed value 713.
78 print-btn-pressed value 714.
78 save-btn-pressed value 715.
78 select-btn-pressed value 716.
78 copy-btn-pressed value 717.
78 clear-btn-pressed value 718.
77 ef-url pic x(1000).
77 wb-1-url pic x(1000).
77 wb-1-title pic x(100).
77 wb-1-status pic x(100).
77 wb-1-progress pic 9(7).
77 wb-1-max-progress pic 9(7).
77 progress-percent pic 9(9).
77 mb-value pic 9.
77 gt-bitmap pic s9(9) comp-4.
01 configuration-data.
05 current-lines pic s99999V99 value 25.
05 current-size pic s99999v99 value 73.
05 current-wb2-lines pic s99999v99 value 16.
05 current-wb2-size pic s99999v99 value 65.
05 current-exit-line pic s99999v99 value 24.
05 current-exit-col pic s99999v99 value 32.
**************************************************
screen section.
01 screen-1.
03 entry-field, column 5, line 6, size 55 max-text = 0
value ef-url.
03 push-button, "&Back",
column 5, line 2, size 9
self-act
termination-value = back-btn-pressed.
03 push-button, "&Forward",
column + 2, size 9
self-act
termination-value = forward-btn-pressed.
03 push-button, "&Home",
column + 2, size 9
self-act
termination-value = home-btn-pressed.
03 push-button, "&Refresh",
column + 2, size 9
self-act
termination-value = refresh-btn-pressed.
03 push-button, "&Find",
column + 2, size 9
self-act
termination-value = search-btn-pressed.
03 push-button, "&Stop",
column + 2, size 9
self-act
termination-value = stop-btn-pressed.
03 push-button, "&Print",
column 5, line 4, size 9
self-act
termination-value = print-btn-pressed.
03 push-button, "Save",
column + 2, size 9
self-act
termination-value = save-btn-pressed.
03 push-button, "Select url and copy",
column + 2, size 18
self-act
termination-value = select-btn-pressed.
03 push-button, "&Go", default-button
column 55.2, line 6,
termination-value = go-btn-pressed.
03 exit-1 push-button, "E&xit",
cancel-button,
line current-exit-line, column current-exit-col,
size 11.
03 busy-bitmap bitmap bitmap-handle = gt-bitmap,
size 39, bitmap-start = 1, bitmap-end = 15,
bitmap-timer = 0,
line 2, column 65.g
03 wb-1 web-browser2
column 5, line 8,
lines current-wb2-lines cells,
size current-wb2-size cells
context-menus, script-dialogs, script,
builtin-error-page, status-bar,
event procedure is browser-event-handler.
**************************************************
procedure division.
main-logic.
accept terminal-abilities from terminal-info.
* Setup a gray screen background
display standard window,
title "Web-Browser2 Sample - browser2.cbl"
lines current-lines, size current-size,
resizable
background-low.
call "w$bitmap" using wbitmap-load, "gtanima.bmp",
giving gt-bitmap.
display screen-1.
modify wb-1 value="www.wikipedia.org".
perform, with test after, until exit-button-pushed
accept screen-1
evaluate key-status
when go-btn-pressed
move ef-url to wb-1-url
modify wb-1 value=wb-1-url
when back-btn-pressed
modify wb-1 go-back=1
when forward-btn-pressed
modify wb-1 go-forward=1
when refresh-btn-pressed
modify wb-1 refresh=1
when stop-btn-pressed
modify wb-1 stop-browser=1
when print-btn-pressed
modify wb-1 print=1
when save-btn-pressed
modify wb-1 save-as=1
when select-btn-pressed
modify wb-1 select-all=1
modify wb-1 copy-selection=1
when copy-btn-pressed
modify wb-1 copy-selection=1
when event-occurred
if event-type = ntf-resized
divide event-data-1 by 100 giving current-lines
divide event-data-2 by 100 giving current-size
subtract 9 from current-lines
giving current-wb2-lines
subtract 8 from current-size
giving current-wb2-size
modify wb-1
lines current-wb2-lines
size current-wb2-size
subtract 1 from current-lines
giving current-exit-line
compute current-exit-col = (current-size - 11) / 2
modify exit-1
line current-exit-line
col current-exit-col
end-if
end-evaluate
end-perform.
stop run.
browser-event-handler.
evaluate event-type
when msg-wb-before-navigate
inquire wb-1 navigate-url in ef-url
if event-data-1 = 0
display message ef-url
title "OK to navigate?"
type is mb-yes-no
giving mb-value
if mb-value = mb-no
move event-action-fail to event-action
end-if
end-if
when msg-wb-navigate-complete
inquire wb-1 value in wb-1-url
if wb-1-url is not = ef-url then
move wb-1-url to ef-url
display screen-1
end-if
when msg-wb-title-change
inquire wb-1 title in wb-1-title
display wb-1-title upon global window title
end-evaluate.