404 lines
12 KiB
Plaintext
404 lines
12 KiB
Plaintext
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* New System Admin - This module allows the user to create a box on the
|
||
|
|
* screen which contains some text (Which you can page through),
|
||
|
|
* and from 1 to 4 buttons.
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description.........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 05/15/96 18330 LDG Changed LEN() function to LENDP() for NLS DBCS.
|
||
|
|
* 01/17/92 8963 TMC fix dealing with lines >= width
|
||
|
|
* 06/19/91 8408 DPB Fixed number of lines bug for HELP routines.
|
||
|
|
* 06/12/91 7673 DTM Added More functionality for HELP routines
|
||
|
|
* 05/31/91 8408 DPB Added @FM feature for HELP routines
|
||
|
|
* 05/13/91 8345 DTM changed print to tprint
|
||
|
|
* 03/05/91 7673 DTM Fixed error conditions
|
||
|
|
* 11/05/90 7393 DPB Routine first created and admin'd.
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
SUBROUTINE CHOICE.BOX.B(start.line, max.lines, width, textstr.orig, Button.Array, selvalue,helpstring)
|
||
|
|
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
|
||
|
|
EQU KEYNUM TO 7
|
||
|
|
DIM string.array(KEYNUM)
|
||
|
|
DIM string.codes(KEYNUM)
|
||
|
|
Default.list=0
|
||
|
|
|
||
|
|
textstr=textstr.orig
|
||
|
|
|
||
|
|
Help.number=0
|
||
|
|
IF width < 25 THEN width = 25
|
||
|
|
start.col = 39-int(width/2)
|
||
|
|
text.start = start.col
|
||
|
|
IF LENDP(textstr) < width THEN text.start = (39-int(LENDP(textstr)/2)) -1
|
||
|
|
|
||
|
|
IF Button.Array="" THEN
|
||
|
|
selvalue=-2
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
IF selvalue > Button.Array<1> OR selvalue <= 0 THEN selvalue=1
|
||
|
|
|
||
|
|
IF Button.Array<1> > 4 OR NUM(Button.Array<1>) = 0 THEN
|
||
|
|
selvalue = -2
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
FOR i=2 to Button.Array<1>+1
|
||
|
|
IF UPCASE(Button.Array<i>)="HELP" THEN Help.number=i-1
|
||
|
|
NEXT i
|
||
|
|
TPRINT CURSOR.INVISIBLE:
|
||
|
|
GOSUB screen.init
|
||
|
|
GOSUB light.label
|
||
|
|
GOSUB key.init
|
||
|
|
|
||
|
|
TTYGET tty$ ELSE NULL
|
||
|
|
tmptty=""
|
||
|
|
tmptty=tty$
|
||
|
|
CRMODE.ICRNL=0
|
||
|
|
CRMODE.ONLCR=0
|
||
|
|
TTYSET tty$ ELSE NULL
|
||
|
|
looplabel1:
|
||
|
|
left.over=""
|
||
|
|
CALL *GET.TOKEN.B(25, 75, 100, KEYNUM, mat string.array, mat string.codes, ESC.KEY, MNEMONIC, 0, Button.Array<1>, MNEMOS, left.over, input.code, mnemos)
|
||
|
|
|
||
|
|
|
||
|
|
looplabel2:
|
||
|
|
BEGIN CASE
|
||
|
|
|
||
|
|
CASE input.code = ESCAPE
|
||
|
|
selvalue = -1
|
||
|
|
GOSUB cleanup
|
||
|
|
GOTO end.stuff
|
||
|
|
|
||
|
|
CASE input.code = NEXT.PAGE
|
||
|
|
IF ((cur.screen+1)*(box.lines-2)) < numlines THEN
|
||
|
|
GOSUB Blank.Page
|
||
|
|
cur.screen += 1
|
||
|
|
GOSUB Draw.Page
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE input.code = PREV.PAGE
|
||
|
|
IF (cur.screen -1) >= 0 THEN
|
||
|
|
GOSUB Blank.Page
|
||
|
|
cur.screen -= 1
|
||
|
|
GOSUB Draw.Page
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE input.code = SEL.ACTION
|
||
|
|
selvalue = item.no -1
|
||
|
|
IF UPCASE(Button.Array<selvalue+2>) = "MORE" THEN
|
||
|
|
input.code = NEXT.PAGE
|
||
|
|
GOTO looplabel2
|
||
|
|
END
|
||
|
|
IF selvalue=Help.number-1 THEN
|
||
|
|
IF helpstring # "" THEN
|
||
|
|
CALL *HELP.BOX.B(start.line+3,start.col+3,0,helpstring)
|
||
|
|
CALL *DRAW.BOX.B(start.line, start.col, box.lines, width, 1)
|
||
|
|
GOSUB Draw.Page
|
||
|
|
GOSUB Do.Labels
|
||
|
|
GOSUB light.label
|
||
|
|
GOTO looplabel1
|
||
|
|
END
|
||
|
|
END
|
||
|
|
GOSUB cleanup
|
||
|
|
GOTO end.stuff
|
||
|
|
|
||
|
|
CASE input.code = RIGHT.ARROW
|
||
|
|
IF ((item.no +1) > Button.Array<1> AND Button.Array<1> # 1) THEN
|
||
|
|
GOSUB unlight.label
|
||
|
|
item.no = 1
|
||
|
|
GOSUB light.label
|
||
|
|
END
|
||
|
|
ELSE IF Button.Array<1> # 1 THEN
|
||
|
|
GOSUB unlight.label
|
||
|
|
item.no += 1
|
||
|
|
GOSUB light.label
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE input.code = LEFT.ARROW
|
||
|
|
IF ((item.no -1) < 1 AND Button.Array<1> # 1) THEN
|
||
|
|
GOSUB unlight.label
|
||
|
|
item.no = Button.Array<1>
|
||
|
|
GOSUB light.label
|
||
|
|
END
|
||
|
|
ELSE IF Button.Array<1> # 1 THEN
|
||
|
|
GOSUB unlight.label
|
||
|
|
item.no -= 1
|
||
|
|
GOSUB light.label
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE input.code = MNEMONIC
|
||
|
|
item.no = mnemos
|
||
|
|
input.code = SEL.ACTION
|
||
|
|
GOTO looplabel2
|
||
|
|
|
||
|
|
CASE 1
|
||
|
|
GOTO looplabel1
|
||
|
|
END CASE
|
||
|
|
GOTO looplabel1
|
||
|
|
|
||
|
|
TPRINT CURSOR.VISIBLE:
|
||
|
|
GOTO end.stuff
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
*
|
||
|
|
* Everything after this point is support routines.
|
||
|
|
*
|
||
|
|
|
||
|
|
cleanup:
|
||
|
|
CALL *DRAW.BOX.B(start.line, start.col, box.lines, width, 0)
|
||
|
|
TPRINT CURSOR.VISIBLE:
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
Draw.Page:
|
||
|
|
FOR I = 1 to box.lines-2
|
||
|
|
TPRINT @(text.start+2, start.line+I):tstr<I+cur.screen*(box.lines-2)>:
|
||
|
|
NEXT I
|
||
|
|
|
||
|
|
IF cur.screen < max.screen THEN
|
||
|
|
IF cur.screen < 1 THEN
|
||
|
|
IF r.tee = "+" THEN
|
||
|
|
TPRINT @(28,start.line+1+box.lines):r.tee:
|
||
|
|
TPRINT " Page Down ":l.tee:
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
TPRINT @(28,start.line+1+box.lines):LINEDRAW.BEGIN:
|
||
|
|
TPRINT r.tee:" Page Down ":l.tee:LINEDRAW.END:
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF r.tee = "+" THEN
|
||
|
|
TPRINT @(28,start.line+1+box.lines):r.tee:
|
||
|
|
TPRINT " Page Up/Page Down ":l.tee:
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
TPRINT @(28,start.line+1+box.lines):LINEDRAW.BEGIN:
|
||
|
|
TPRINT r.tee:" Page Up/Page Down ":l.tee:LINEDRAW.END:
|
||
|
|
END
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
IF cur.screen < 1 AND max.screen < 1 THEN
|
||
|
|
IF h.line = '-' THEN
|
||
|
|
TPRINT @(28,start.line+1+box.lines):STR(h.line,9):
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
TPRINT @(28,start.line+1+box.lines):LINEDRAW.BEGIN:
|
||
|
|
TPRINT STR(h.line,9):LINEDRAW.END:
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF r.tee = '+' THEN
|
||
|
|
TPRINT @(28,start.line+1+box.lines):r.tee:
|
||
|
|
TPRINT " Page Up ":l.tee:
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
TPRINT @(28,start.line+1+box.lines):LINEDRAW.BEGIN:
|
||
|
|
TPRINT r.tee:" Page Up ":l.tee:LINEDRAW.END:
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
Blank.Page:
|
||
|
|
FOR I = 1 to box.lines-2
|
||
|
|
TPRINT@(text.start+2, start.line+I):STR(" ",LENDP(tstr<I+cur.screen*(box.lines-2)>)):
|
||
|
|
NEXT I
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
light.label:
|
||
|
|
If item.no <= int(Button.Array<1>/2) THEN
|
||
|
|
spacing = 0 - ((int(Button.Array<1>/2)+1) - item.no)
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
spacing = (item.no - (int(Button.Array<1>/2)))
|
||
|
|
END
|
||
|
|
TPRINT @(start.col + spacing - 1 +((item.no*Offset) - int (LENDP(Button.Array<item.no+1>)/2)) + LENDP(Button.Array<item.no+1>)+1, start.line + box.lines):
|
||
|
|
CALL *INVERSE.B(0)
|
||
|
|
TPRINT @(start.col + spacing - 1 +((item.no*Offset) - int (LENDP(Button.Array<item.no+1>)/2)), start.line + box.lines):
|
||
|
|
CALL *INVERSE.B(1)
|
||
|
|
TPRINT Button.Array<item.no+1>:
|
||
|
|
CALL *INVERSE.B(0)
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
unlight.label:
|
||
|
|
If item.no <= int(Button.Array<1>/2) THEN
|
||
|
|
spacing = 0 - ((int(Button.Array<1>/2)+1) - item.no)
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
spacing = (item.no - (int(Button.Array<1>/2)))
|
||
|
|
END
|
||
|
|
TPRINT @(start.col + spacing - 1 +((item.no*Offset) - int (LENDP(Button.Array<item.no+1>)/2)) + LENDP(Button.Array<item.no+1>)+1, start.line + box.lines):
|
||
|
|
CALL *INVERSE.B(0)
|
||
|
|
TPRINT @(start.col + spacing - 1 +((item.no*Offset) - int (LENDP(Button.Array<item.no+1>)/2)), start.line + box.lines):
|
||
|
|
CALL *INVERSE.B(0)
|
||
|
|
TPRINT Button.Array<item.no+1>:
|
||
|
|
CALL *INVERSE.B(0)
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
|
||
|
|
Do.Labels:
|
||
|
|
FOR I = 1 to Button.Array<1>
|
||
|
|
IF I <= int(Button.Array<1>/2) THEN
|
||
|
|
spacing = 0 - ((int(Button.Array<1>/2)+1) - I)
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
spacing = (I - (int(Button.Array<1>/2)))
|
||
|
|
END
|
||
|
|
TPRINT @(start.col + spacing + ((I*Offset) - int (LENDP(Button.Array<I+1>)/2)), start.line + box.lines):Button.Array<I+1>:
|
||
|
|
NEXT I
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
UnDo.Labels:
|
||
|
|
FOR I = 1 to Button.Array<1>
|
||
|
|
IF I <= int(Button.Array<1>/2) THEN
|
||
|
|
spacing = 0 - ((int(Button.Array<1>/2)+1) - I)
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
spacing = (I - (int(Button.Array<1>/2)))
|
||
|
|
END
|
||
|
|
TPRINT @(start.col + spacing + ((I*Offset) - int (LENDP(Button.Array<I+1>)/2)), start.line + box.lines):STR(" ",LENDP(Button.Array<I+1>)):
|
||
|
|
NEXT I
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
screen.init:
|
||
|
|
GOSUB format.labels
|
||
|
|
GOSUB format.text
|
||
|
|
CALL *DRAW.BOX.B(start.line, start.col, box.lines, width, 1)
|
||
|
|
GOSUB Draw.Page
|
||
|
|
GOSUB Do.Labels
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
format.text:
|
||
|
|
cur.screen = 0
|
||
|
|
tstr = ""
|
||
|
|
numlines = 0
|
||
|
|
loop1:
|
||
|
|
numlines += 1
|
||
|
|
temp = INDEX(textstr,@FM,1)
|
||
|
|
IF ((temp <= width) AND (temp # 0)) THEN
|
||
|
|
tstr<numlines> = textstr[1,temp-1]
|
||
|
|
textstr = textstr[temp+1, LENDP(textstr)]
|
||
|
|
GOTO loop1
|
||
|
|
END
|
||
|
|
IF LENDP(textstr) > width THEN
|
||
|
|
temp = width-1
|
||
|
|
LOOP UNTIL textstr[temp,1] = ' ' OR temp <= 0 DO
|
||
|
|
temp -= 1
|
||
|
|
REPEAT
|
||
|
|
IF temp < width - int(width/4) THEN temp = width-1
|
||
|
|
tstr<numlines> = textstr[1,temp]
|
||
|
|
textstr = textstr[temp+1, LENDP(textstr)]
|
||
|
|
GOTO loop1
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
IF LENDP(textstr) > 0 THEN
|
||
|
|
tstr<numlines> = textstr
|
||
|
|
END
|
||
|
|
IF numlines < max.lines -2 THEN
|
||
|
|
box.lines = numlines+2
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
box.lines = max.lines
|
||
|
|
END
|
||
|
|
max.screen = INT((numlines-1)/(box.lines-2))
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
format.labels:
|
||
|
|
item.no = selvalue
|
||
|
|
IF selvalue < 0 THEN
|
||
|
|
item.no = 1
|
||
|
|
END
|
||
|
|
IF selvalue > 4 THEN
|
||
|
|
item.no =4
|
||
|
|
END
|
||
|
|
IF Button.Array<1> = 0 THEN
|
||
|
|
Button.Array<1> = 3
|
||
|
|
Button.Array<2> = "Ok"
|
||
|
|
Button.Array<3> = "Cancel"
|
||
|
|
Button.Array<4> = "Help"
|
||
|
|
Help.number=3
|
||
|
|
Default.list=1
|
||
|
|
END
|
||
|
|
button.width = 0
|
||
|
|
FOR I = 1 to Button.Array<1>
|
||
|
|
button.width += LENDP(Button.Array<I+1>) + 2
|
||
|
|
NEXT I
|
||
|
|
If width < button.width THEN width = button.width
|
||
|
|
Offset = int(width/(Button.Array<1>+1))
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
key.init:
|
||
|
|
OPEN "","INCLUDE" TO alt.key.file ELSE GOTO end.loop
|
||
|
|
alt.record=""
|
||
|
|
READ alt.record FROM alt.key.file,"ALT.MTF.KEYS" ELSE GOTO end.loop
|
||
|
|
alt.rec.count=COUNT(alt.record,@FM)+1
|
||
|
|
FOR i=1 TO alt.rec.count STEP 2
|
||
|
|
BEGIN CASE
|
||
|
|
CASE alt.record<i>="ALT.RT.ARROW"
|
||
|
|
KEY.MOVE.CURSOR.RIGHT=alt.record<i+1>
|
||
|
|
CASE alt.record<i>="ALT.LT.ARROW"
|
||
|
|
KEY.MOVE.CURSOR.LEFT=alt.record<i+1>
|
||
|
|
CASE alt.record<i>="ALT.PAGE.UP"
|
||
|
|
KEY.PREVIOUS.PAGE=alt.record<i+1>
|
||
|
|
CASE alt.record<i>="ALT.PAGE.DOWN"
|
||
|
|
KEY.NEXT.PAGE=alt.record<i+1>
|
||
|
|
END CASE
|
||
|
|
NEXT i
|
||
|
|
CLOSE alt.record
|
||
|
|
end.loop:
|
||
|
|
string.array(1) = CHAR(27)
|
||
|
|
string.array(2) = KEY.PREVIOUS.PAGE
|
||
|
|
string.array(3) = KEY.NEXT.PAGE
|
||
|
|
string.array(4) = " "
|
||
|
|
string.array(5) = CARRIAGE.RETURN
|
||
|
|
string.array(6) = KEY.MOVE.CURSOR.RIGHT
|
||
|
|
string.array(7) = KEY.MOVE.CURSOR.LEFT
|
||
|
|
string.codes(1) = ESCAPE
|
||
|
|
string.codes(2) = PREV.PAGE
|
||
|
|
string.codes(3) = NEXT.PAGE
|
||
|
|
string.codes(4) = SEL.ACTION
|
||
|
|
string.codes(5) = SEL.ACTION
|
||
|
|
string.codes(6) = RIGHT.ARROW
|
||
|
|
string.codes(7) = LEFT.ARROW
|
||
|
|
|
||
|
|
CALL *TOKEN.SORT.B(KEYNUM, mat string.array, mat string.codes)
|
||
|
|
|
||
|
|
FOR I = 1 to KEYNUM
|
||
|
|
IF string.codes(I) = ESCAPE THEN ESC.KEY = I
|
||
|
|
NEXT I
|
||
|
|
|
||
|
|
MNEMOS = ""
|
||
|
|
FOR I = 1 TO Button.Array<1>
|
||
|
|
FOR J = 1 to LENDP(Button.Array<I+1>)
|
||
|
|
IF Button.Array<I+1>[J,1] = UPCASE(Button.Array<I+1>[J,1]) THEN
|
||
|
|
MNEMOS<I> = Button.Array<I+1>[J,1]
|
||
|
|
GOTO out
|
||
|
|
END
|
||
|
|
NEXT J
|
||
|
|
out:
|
||
|
|
NEXT I
|
||
|
|
RETURN
|
||
|
|
end.stuff:
|
||
|
|
TTYGET tty$ ELSE NULL
|
||
|
|
tty$=tmptty
|
||
|
|
TTYSET tty$ ELSE NULL
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|