PROCEDURE DIVISION using registro-lk.
------*
DECLARATIVES.
IO-ERROR SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON
RGREGIS.
END DECLARATIVES.
MAIN SECTION.
INICIO.
A0.
initialize nombre-regis
set presupuesto-ptas to true
perform varying i from 1 by 1 until i > 80
or fic-lk(i) = ' '
move fic-lk(i) to nombre-regis(i:1)
end-perform
perform abrir-pantalla.
d accept nombre-regis update line 1 end-accept
PERFORM VARYING INDICE FROM 1 BY 1 UNTIL INDICE = 2001
if es-unix then
inspect linea-atributo(indice) converting
'*‚¡¢£¤¥§¦‡€' to 'áéíóúñѺªçÇ'
end-if
MOVE LINEA-ATRIBUTO(INDICE) TO LINEA-Aa(INDICE)
END-PERFORM
if RM-VersionNumber = ' '
display linea-P line 1 position 1 LOW
CONTROL sicolor
end-if
PERFORM VARYING LINEA FROM 1 BY 1 UNTIL LINEA = 25
PERFORM VARYING COLUMNA FROM 1 BY 1 UNTIL COLUMNA = 81
COMPUTE INDICE = (LINEA - 1) * 80 + COLUMNA
IF LINEA-ATRIBUTO(INDICE) < '³' or > 'Ú'
or RM-VersionNumber = ' '
* or es-unix
EVALUATE LINEA-COLOR(INDICE)
WHEN ''
if RM-VersionNumber not = ' '
DISPLAY LINEA-ATRIBUTO(INDICE) low
LINE LINEA POSITION COLUMNA
CONTROL sicolor
end-if
WHEN ''
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL sicolor
WHEN 'p'
DISPLAY LINEA-ATRIBUTO(INDICE) LOW
LINE LINEA POSITION COLUMNA
CONTROL sicolor reverse
* CONTROL 'FCOLOR=BLACK, BCOLOR=WHITE'
WHEN ''
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=GREY, BCOLOR=WHITE'
WHEN '?'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=WHITE, BCOLOR=CYAN'
WHEN 'O'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=WHITE, BCOLOR=RED'
WHEN '0'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA LOW
CONTROL 'FCOLOR=BLACK, BCOLOR=CYAN'
WHEN 'K'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=CYAN, BCOLOR=RED'
WHEN ';'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA REVERSE
CONTROL 'FCOLOR=CYAN, BCOLOR=CYAN'
WHEN ' '
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=CYAN, BCOLOR=BLACK'
WHEN OTHER
DISPLAY LINEA-ATRIBUTO(INDICE) low
LINE LINEA POSITION COLUMNA
CONTROL sicolor
* CONTINUE
* DISPLAY LINEA-ATRIBUTO(INDICE)
* LINE LINEA POSITION COLUMNA LOW
END-EVALUATE
ELSE
move ' ' to high-graphics
string sicolor 'high GRAPHICS' delimited by size into
HIGH-GRAPHICS
EVALUATE LINEA-ATRIBUTO(INDICE)
WHEN '³'
MOVE 'x' TO LINEA-ATRIBUTO(INDICE)
WHEN '´'
MOVE 'u' TO LINEA-ATRIBUTO(INDICE)
WHEN 'µ'
MOVE 'u' TO LINEA-ATRIBUTO(INDICE)
WHEN '¶'
MOVE 'u' TO LINEA-ATRIBUTO(INDICE)
WHEN '·'
MOVE 'k' TO LINEA-ATRIBUTO(INDICE)
WHEN '¸'
MOVE 'k' TO LINEA-ATRIBUTO(INDICE)
WHEN '¹'
MOVE 'U' TO LINEA-ATRIBUTO(INDICE)
WHEN 'º'
MOVE 'X' TO LINEA-ATRIBUTO(INDICE)
WHEN '»'
MOVE 'K' TO LINEA-ATRIBUTO(INDICE)
WHEN '¼'
MOVE 'J' TO LINEA-ATRIBUTO(INDICE)
WHEN '½'
MOVE 'j' TO LINEA-ATRIBUTO(INDICE)
WHEN '¾'
MOVE 'j' TO LINEA-ATRIBUTO(INDICE)
WHEN '¿'
MOVE 'k' TO LINEA-ATRIBUTO(INDICE)
WHEN 'À'
MOVE 'm' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Á'
MOVE 'v' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Â'
MOVE 'w' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ã'
MOVE 't' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ä'
MOVE 'q' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Å'
MOVE 'n' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Æ'
MOVE 't' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ç'
MOVE 't' TO LINEA-ATRIBUTO(INDICE)
WHEN 'È'
MOVE 'M' TO LINEA-ATRIBUTO(INDICE)
WHEN 'É'
MOVE 'L' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ê'
MOVE 'V' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ë'
MOVE 'W' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ì'
MOVE 'T' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Í'
MOVE 'Q' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Î'
MOVE 'N' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ï'
MOVE 'v' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ð'
MOVE 'v' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ñ'
MOVE 'w' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ò'
MOVE 'w' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ó'
MOVE 'm' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ô'
MOVE 'm' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Õ'
MOVE 'l' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ö'
MOVE 'l' TO LINEA-ATRIBUTO(INDICE)
WHEN '×'
MOVE 'n' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ø'
MOVE 'n' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ù'
MOVE 'j' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ú'
MOVE 'l' TO LINEA-ATRIBUTO(INDICE)
WHEN OTHER
MOVE ' ' TO LINEA-ATRIBUTO(INDICE)
* CONTINUE
END-EVALUATE
EVALUATE LINEA-COLOR(INDICE)
WHEN ''
* if linea = 2 and columna = 2
* accept high-graphics line 1 position 1 update
* end-if
DISPLAY LINEA-ATRIBUTO(INDICE) LOW
LINE LINEA POSITION COLUMNA
* CONTROL HIGH-GRAPHICS
CONTROL 'BCOLOR=BLUE , FCOLOR=WHITE HIGH GRAPHICS'
WHEN ''
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL HIGH-GRAPHICS
WHEN 'p'
DISPLAY LINEA-ATRIBUTO(INDICE) LOW
LINE LINEA POSITION COLUMNA
CONTROL HIGH-GRAPHICS reverse
* CONTROL 'FCOLOR=BLACK, BCOLOR=WHITE'
WHEN ''
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL
'BCOLOR=WHITE , FCOLOR=HIGH-INTENSITY WHITE HIGH GRAPHICS'
* CONTROL 'FCOLOR=GREY, BCOLOR=WHITE HIGH GRAPHICS'
WHEN '?'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=WHITE, BCOLOR=CYAN HIGH GRAPHICS'
WHEN 'O'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=WHITE, BCOLOR=RED HIGH GRAPHICS'
WHEN '0'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA LOW
CONTROL 'FCOLOR=BLACK, BCOLOR=CYAN HIGH GRAPHICS'
WHEN 'K'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=CYAN, BCOLOR=RED HIGH GRAPHICS'
WHEN ';'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA REVERSE
CONTROL 'FCOLOR=CYAN, BCOLOR=CYAN HIGH GRAPHICS'
WHEN ' '
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=CYAN, BCOLOR=BLACK HIGH GRAPHICS'
WHEN OTHER
DISPLAY LINEA-ATRIBUTO(INDICE) LOW
LINE LINEA POSITION COLUMNA
* CONTROL HIGH-GRAPHICS
CONTROL 'BCOLOR=BLUE , FCOLOR=WHITE'
* DISPLAY LINEA-ATRIBUTO(INDICE)
* LINE LINEA POSITION COLUMNA LOW
END-EVALUATE
END-IF
END-PERFORM
END-PERFORM
initialize indice
inspect nombre-regis tallying indice for all '.cr6' '.cp6'
initialize i
inspect nombre-regis tallying indice for all '.cr5' '.cp5'
if indice = 0 and i = 0 then
if mun00-corr-ex > 50 then
move 1900 to ejercicio-presupuesto
else
move 2000 to ejercicio-presupuesto
end-if
add mun00-corr-ex to ejercicio-presupuesto
initialize linea-p
string 'Presupuesto ' delimited by size
ejercicio-presupuesto delimited by size
' Entidad ' delimited by size
mun00-cif-ex delimited by ' '
' ' delimited by size
mun00-nombre-ex delimited by size
into linea-p
move 0 to indice j k
perform varying i from 80 by -1 until i = 0 or i = indice
if linea-p(i:1) not = ' ' and indice = 0 then
compute indice = ( 80 - i ) / 2
compute indice = 80 - indice
compute k = indice + 2
end-if
if indice not = 0 then
move linea-p(i:1) to linea-p(indice:1)
if linea-p(indice:1) not = ' '
compute j = indice - 2
end-if
move ' ' to linea-p(i:1)
subtract 1 from indice
end-if
end-perform
display linea-p(1:80) line 25 position 1 erase eol
CONTROL sicolor low
*************
move ' ' to high-graphics
if RM-VersionNumber not = ' '
string sicolor 'high GRAPHICS' delimited by size into
HIGH-GRAPHICS
MOVE 'qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq'
TO LINEA-p
else
MOVE 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'
TO LINEA-p
end-if
if k <= 80 then
DISPLAY LINEA-p(1 : 80 - k + 1) LOW
LINE 25 POSITION k
CONTROL 'BCOLOR=BLUE , FCOLOR=WHITE HIGH GRAPHICS'
end-if
if j >= 1 then
DISPLAY LINEA-p(1 : j) LOW
LINE 25 POSITION 1
CONTROL 'BCOLOR=BLUE , FCOLOR=WHITE HIGH GRAPHICS'
end-if
*************
else
DISPLAY ' ' low
LINE 25 POSITION 1 erase eol
CONTROL sicolor
end-if.
goback.
abrir-pantalla.
open input rgregis.
d accept nombre-regis update line 1 position 1
if f-noexiste-regis and not presupuesto-euros then
perform varying i from 1 by 1 until nombre-regis(i:1) = ' '
continue
end-perform
perform varying columna from i by -1
until nombre-regis(columna:1) = '\' or = '/'
continue
end-perform
move nombre-regis(columna + 1:) to nombre-regis(1:)
set presupuesto-euros to true
go abrir-pantalla
end-if
read rgregis.
close rgregis.
if si-presupuesto-nuevo then
inspect nombre-regis replacing all '.cr' by '.cp'
open input rgregis
if esta-regis
read rgregis end-read
end-if
close rgregis
end-if.
Otros temas que te pueden interesar
7 de junio de 2022, 08:42
Likes
