143 lines
3.8 KiB
Plaintext
143 lines
3.8 KiB
Plaintext
|
subroutine U5114( Resultat, Status, Long )
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Saisie de caracteres avec caractere de fin de saisie
|
||
|
|
*
|
||
|
|
* 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.
|
||
|
|
* 08/18/96 18335 MAA Added new code for port of 9 to Siemens Nixdorf.
|
||
|
|
* 01/14/91 7930 JWT Added new Ucode for Siemens/Nixdorf
|
||
|
|
* 17/07/89 - BHX creation du source
|
||
|
|
* 26/09/89 - HBI Ajout test ECHO ON/OFF
|
||
|
|
* 10/09/90 - BHX Abandon de PTERM => TTYGET / TTYSET
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE TTY
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE DEF.USERS
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE TERMINFO
|
||
|
|
*** si longueur egale a zero saisir un seul caractere : <CR>
|
||
|
|
IF Long = 0 THEN
|
||
|
|
TTYGET tty$ ELSE Status = 1 ; RETURN
|
||
|
|
SAVEICRNL=CRMODE.ICRNL
|
||
|
|
CRMODE.ICRNL = 0
|
||
|
|
TTYSET tty$ ELSE Status = 1 ; RETURN
|
||
|
|
10 Command = KEYIN() ; IF Command # Exec AND Command # Envoi THEN GOTO 10
|
||
|
|
Status = 0
|
||
|
|
CRMODE.ICRNL=SAVEICRNL
|
||
|
|
TTYSET tty$ ELSE Status = 1 ; RETURN
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
*** validiter de la demande
|
||
|
|
IF (NOT( NUM( Long )) OR Long < 0 OR Long > 500) THEN
|
||
|
|
Status = 1
|
||
|
|
*** demande valide
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
UnCarAGauche = KEY.MOVE.CURSOR.LEFT
|
||
|
|
Status = 0
|
||
|
|
Resultat = ""
|
||
|
|
Nombre = 0
|
||
|
|
TTYGET tty$ ELSE Status = 1 ; RETURN
|
||
|
|
SAVEICRNL=CRMODE.ICRNL
|
||
|
|
CRMODE.ICRNL = 0
|
||
|
|
TTYSET tty$ ELSE Status = 1 ; RETURN
|
||
|
|
********
|
||
|
|
debut: *
|
||
|
|
********
|
||
|
|
*** saisie d'un caractere quelconque de CHAR(0) a CHAR(255)
|
||
|
|
Command = KEYIN()
|
||
|
|
IF CASE.INVERT THEN
|
||
|
|
*** Inversion upcase/downcase
|
||
|
|
IF Command >= 'a' AND Command <= 'z' THEN
|
||
|
|
Command = CHAR(SEQ(Command)-32)
|
||
|
|
END ELSE
|
||
|
|
IF Command >= 'A' AND Command <= 'Z' THEN
|
||
|
|
Command = CHAR(SEQ(Command)+32)
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
*** test du caractere recu
|
||
|
|
Flag = 0
|
||
|
|
BEGIN CASE
|
||
|
|
*** fleche a gauche (^Y, basckspace sans effacement?)
|
||
|
|
CASE Command = KEY.MOVE.CURSOR.LEFT
|
||
|
|
Flag = 4
|
||
|
|
*** exec (^J)
|
||
|
|
CASE Command = Exec
|
||
|
|
Flag = 1
|
||
|
|
*** abandon (^N)
|
||
|
|
CASE Command = Abandon
|
||
|
|
Flag = 1
|
||
|
|
*** sortie (^W)
|
||
|
|
CASE Command = Sortie
|
||
|
|
Flag = 1
|
||
|
|
*** vider (^L)
|
||
|
|
CASE Command = Vider
|
||
|
|
Flag = 1
|
||
|
|
*** envoi (^M)
|
||
|
|
CASE Command = Envoi
|
||
|
|
Flag = 1
|
||
|
|
*** fleche en haut (^Z)
|
||
|
|
CASE Command = KEY.MOVE.CURSOR.UP
|
||
|
|
Flag = 1
|
||
|
|
*** fleche en bas (^K)
|
||
|
|
CASE Command = KEY.MOVE.CURSOR.DOWN
|
||
|
|
Flag = 1
|
||
|
|
*** IMP ECRAN (^S, a ignorer!!!)
|
||
|
|
CASE Command = ImpEcran
|
||
|
|
Flag = 9
|
||
|
|
END CASE
|
||
|
|
*** si caractere de controle autre que ceux prevu, l'absorber
|
||
|
|
IF (Command < CHAR(32) OR Command > CHAR(249)) THEN
|
||
|
|
IF Flag = 0 OR Flag = 9 THEN
|
||
|
|
GOTO debut
|
||
|
|
END
|
||
|
|
END
|
||
|
|
*** si backspace
|
||
|
|
IF Flag = 4 THEN
|
||
|
|
IF Nombre = 0 THEN
|
||
|
|
PRINT BELL:
|
||
|
|
END ELSE
|
||
|
|
Nombre = Nombre - 1
|
||
|
|
Command = ""
|
||
|
|
PRINT UnCarAGauche:" ":UnCarAGauche:
|
||
|
|
Resultat = Resultat[1,LEN(Resultat)-1]
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
*** si longueur atteinte faire beep
|
||
|
|
IF Nombre = Long AND Flag # 1 THEN
|
||
|
|
PRINT BELL:
|
||
|
|
END ELSE
|
||
|
|
Nombre = Nombre + 1
|
||
|
|
*** echo
|
||
|
|
*** Test ECHO ON/OFF
|
||
|
|
ResulImp=""
|
||
|
|
IF(SYSTEM(24))THEN ResulImp=Command
|
||
|
|
IF Flag = 0 THEN PRINT ResulImp:
|
||
|
|
*** cumuler le resultat saisi
|
||
|
|
Resultat = Resultat:Command
|
||
|
|
IF Flag = 1 THEN GOTO fin
|
||
|
|
END
|
||
|
|
END
|
||
|
|
GOTO debut
|
||
|
|
END
|
||
|
|
*******
|
||
|
|
fin : *
|
||
|
|
*******
|
||
|
|
CRMODE.ICRNL=SAVEICRNL
|
||
|
|
TTYSET tty$ ELSE Status = 1 ; RETURN
|
||
|
|
RETURN
|
||
|
|
END
|