Enlever les blancs dans une variable CL

Bonjour,

Par défaut, une variable de type *char contient des blancs, par contre si tu désires supprimer des blancs insérer à d'autres caractères tu devras utiliser deux boucles imbriquées de type DOWHILE par exemple, possible depuis la V5r4 mais un peu usine à gaz. Plus facile par programme !

Exemple :
Il est peut être possible d'optimiser, je l'ai fait d'un seul jet !

PGM(&VAR1)

DLC &VAR1 TYPE(*CHAR) LEN(256)
DCL &LENVAR TYPE(*DEC) LEN(3 0) VALUE(256)
DCL &LGL1 TYPE(*LGL) VALUE ('1') => Opérateur logique
DCL &LGL2 Idem
DCL &I1 TYPE(*DEC) LEN(5 0) /* Indice */
DLC &I2 ------------------------ /* Indice */
DLC &I3 ------------------------ /* Indice */
DLC &I4 ------------------------ /* Indice */
DLC &PAS TYPE(*DEC) LEN(1 0) VALUE(1) /* Taille à comparer */

/* Tester que la variable contient au - 1 caractère non blanc */
IF COND(&VAR1 *EQ ' ') THEN(GOTO FIN)

CHGVAR VAR(&I3) VALUE(256)

/* Recherche la position du dernier caractère non blanc */
DOWHILE(&LGL1)
IF COND(%SST(&VAR1 &I3 &PAS)) *EQ ' ') THEN(DO)
CHGVAR VAR(&I3) VALUE(&I3 - &PAS)
ENDDO
ELSE(DO)
CHGVAR VAR(&LGL1) VALUE('0') /* FALSE */
ENDDO
ENDDO

/* Test la position du dernier caractère */
IF COND(&I3 *EQ 1) THEN(GOTO FIN)

CHGVAR VAR(&LGL1) VALUE('1') /* TRUE */
CHGVAR VAR(&I1) VALUE(1)
/* Recherche la position d'1 caractère blanc */
DOWHILE(&LGL1)
IF COND(%SST(&VAR1 &I1 &PAS)) *EQ ' ') THEN(DO)
/* Rechercher la position du prochain caractère non blanc */
CHGVAR VAR(&LGL2) VALUE('1')
CHGVAR VAR(&I2) VALUE(I1 + 1)
DOWHILE(&LGL2)
IF COND(&I2 *EQ &I3) THEN(DO)
CHGVAR VAR(%SST(&VAR1 &I1 &PAS)) +
VALUE(%SST(&VAR1 &I2 &PAS))
CHGVAR VAR(%SST(&VAR1 &I2 &PAS)) +
VALUE(' ')
CHGVAR VAR(&LGL2) VALUE('0') /* FALSE */
CHGVAR VAR(&LGL1) VALUE('0') /* FALSE */
ENDDO /* IF DO */
ELSE(DO)
IF COND(%SST(&VAR1 &I2 &PAS)) *NE ' ') THEN(DO)
/* Calcul la longeur à copier */
CHGVAR(&I4) VALUE(&LENVAR - (&I2 - 1)
CHGVAR VAR(%SST(&VAR1 &I1 &I4)) +
VALUE(%SST(&VAR1 &I2 &I4))
/* RAB du dernier caractère */
CHGVAR VAR(%SST(&VAR1 &I3 &PAS)) +
VALUE(' ')
/* Calcul la nouvelle position du dernier caractère */
CHGVAR(&I3) VALUE(&I3 - 1)
CHGVAR VAR(&LGL2) VALUE('0') /* FALSE */
ENDDO /* IF DO */
ELSE(DO)
CHGVAR VAR(&I2) VALUE(I2 + 1)
ENDDO /* ELSE DO */
ENDDO /* ELSE DO */
ENDDO /* DOWHILE(&LGL2) */
ENDDO /* IF DO*/
ELSE(DO)
CHGVAR VAR(&I1) VALUE(I1 + 1)
ENDDO /* ELSE DO */
ENDDO /* DOWHILE(&LGL1) */

FIN:ENDPGM

J'espère avoir répondu à ta demande !

@+

Patrick

Ta réponse m'a beaucoup plû et m'aider à acquérir nouvelle astuce.
voyance gratuite par mail