109 lines
3.0 KiB
Plaintext
109 lines
3.0 KiB
Plaintext
|
subroutine U0114( Resultat, Status, Long )
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Saisie de caracteres au clavier sans retour-chariot
|
||
|
|
*
|
||
|
|
* 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 Ported release 9 to SNI
|
||
|
|
* 01/14/91 7930 JWT Added new Ucode for Siemens/Nixdorf
|
||
|
|
* 10/09/90 - BHX Abandon de PTERM => TTYGET / TTYSET
|
||
|
|
* 26/09/89 - HBI Ajout test ECHO ON/OFF
|
||
|
|
* 17/07/89 - BHX creation du source
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE TTY
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE DEF.USERS
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE TERMINFO
|
||
|
|
*** validiter de la demande
|
||
|
|
IF (NOT( NUM( Long )) OR Long < 1 OR Long > 140) THEN Long=140
|
||
|
|
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 (basckspace sans effacement?)
|
||
|
|
CASE Command = KEY.MOVE.CURSOR.LEFT
|
||
|
|
Command = ""
|
||
|
|
Flag = 4
|
||
|
|
*** backspace
|
||
|
|
CASE Command = KEY.BACKSPACE
|
||
|
|
Command = ""
|
||
|
|
Flag = 4
|
||
|
|
*** envoi
|
||
|
|
CASE Command = Envoi OR Command = Exec
|
||
|
|
Command = ""
|
||
|
|
Flag = 1
|
||
|
|
END CASE
|
||
|
|
*** c'est fini
|
||
|
|
IF Flag = 1 THEN GOTO fin
|
||
|
|
*** si caractere de controle autre que ceux prevu, l'absorber
|
||
|
|
IF (Command < CHAR(32) OR Command > CHAR(249)) THEN
|
||
|
|
IF Flag = 0 THEN
|
||
|
|
GOTO debut
|
||
|
|
END
|
||
|
|
END
|
||
|
|
*** si backspace
|
||
|
|
IF Flag = 4 THEN
|
||
|
|
IF Nombre = 0 THEN
|
||
|
|
PRINT BELL:
|
||
|
|
END ELSE
|
||
|
|
Nombre = Nombre - 1
|
||
|
|
PRINT UnCarAGauche:" ":UnCarAGauche:
|
||
|
|
Resultat = Resultat[1,LEN(Resultat)-1]
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
Nombre = Nombre + 1
|
||
|
|
*** cumuler le resultat saisi
|
||
|
|
*** Test ECHO ON/OFF
|
||
|
|
ResulImp=""
|
||
|
|
IF(SYSTEM(24))THEN ResulImp=Command
|
||
|
|
PRINT ResulImp:
|
||
|
|
Resultat = Resultat:Command
|
||
|
|
*** si longueur atteinte c'est fini
|
||
|
|
IF Nombre = Long THEN
|
||
|
|
GOTO fin
|
||
|
|
END
|
||
|
|
END
|
||
|
|
GOTO debut
|
||
|
|
*******
|
||
|
|
fin : *
|
||
|
|
*******
|
||
|
|
CRMODE.ICRNL=SAVEICRNL
|
||
|
|
TTYSET tty$ ELSE Status = 1 ; RETURN
|
||
|
|
RETURN
|
||
|
|
END
|