$$$$ @HISTOGR * @HISTOGR PROCEDUR BP208322 19/08/23 21:15:01 10289 ************************************************************************ * NOM : @HISTOGR * DESCRIPTION : Création/Tracé de données sous forme d'histogramme ************************************************************************ * HISTORIQUE : 2/05/2012 : JCARDO : création de la procédure * HISTORIQUE : 22/08/2019 : BP * HISTORIQUE : ************************************************************************ * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES * en cas de modification de ce sous-programme afin de faciliter * la maintenance ! ************************************************************************ * ENTRÉES :: LVAL1*'LISTREEL' = données à tracer * TOPT1/'TABLE' = mise en forme des barres du graphique * LSOR1/'LOGIQUE' = renvoyer des objets en sortie ? * SORTIES :: EVOHIS/'EVOLUTION' = courbes à transmettre à DESS * TABHIS/'TABLE' = options de format à transmettre à DESS ************************************************************************ * SYNTAXE (GIBIANE) : * * (EVOHIS TABHIS) = @HISTOGR LVAL1 (TOPT1) (LSOR1) * ************************************************************************ DEBP @HISTOGR LVAL1*'LISTREEL' TOPT1/'TABLE' LSOR1/'LOGIQUE' ; EVO1 = VIDE 'EVOLUTIO' ; * ========================================== * RÉCUPÉRATION ET VÉRIFICATION DES ARGUMENTS * ========================================== NVAL1 = DIME LVAL1 ; SI (NVAL1 EGA 0) ; QUIT @HISTO ; FINS ; * Renvoyer une EVOLUTION et une TABLE en sortie ? BSOR1 = FAUX ; SI (EXIS LSOR1) ; BSOR1 = LSOR1 ; FINS ; * Parcours de la table d'options TOPT1 * ---------------------------------------------------------------- * 'COUL' [MOT ou LISTMOTS] = Couleur(s) des barres (défaut='DEFA') * 'NOMS' [TABLE] = Noms des barres (défaut=aucun) * 'LARG' [LISTREEL] = Largeurs des barres (défaut=0.8) * 'ESPA' [FLOTTANT] = Espace entre 2 barres (défaut=0.2) * 'HPOS' [FLOTTANT] = Décalage horizontal (défaut=0.) * 'INVE' [LOGIQUE] = De droite à gauche ? (défaut=FAUX) * 'DESS' [MOT] = Options passées à DESS (défaut=' ') * ---------------------------------------------------------------- SI (NON (EXIS TOPT1)) ; TOPT1 = TABL ; FINS ; * COUL * --------------------------------------------------------------------- LCOUL = MOTS 'DEFA' 'BLEU' 'ROUG' 'ROSE' 'VERT' 'TURQ' 'JAUN' 'BLAN' 'NOIR' 'VIOL' 'ORAN' 'AZUR' 'OCEA' 'CYAN' 'OLIV' 'GRIS' ; COUMULT = FAUX ; LCOU1 = MOTS 'DEFA' ; SI (EXIS TOPT1 'COUL') ; SI (EGA (TYPE (TOPT1 . 'COUL')) 'MOT') ; LCOU1 = MOTS (TOPT1 . 'COUL') ; SINON ; SI (EGA (TYPE (TOPT1 . 'COUL')) 'LISTMOTS') ; COUMULT = VRAI ; LCOU1 = TOPT1 . 'COUL' ; SINON ; MESS 'Indice "COUL" : type d objet incorrect' ; QUIT @HISTO ; FINS ; FINS ; FINS ; * NOMS * --------------------------------------------------------------------- BNOM1 = FAUX ; SI (EXIS TOPT1 'NOMS') ; SI (EGA (TYPE (TOPT1 . 'NOMS')) 'TABLE') ; TNOM1 = TOPT1 . 'NOMS' ; BNOM1 = VRAI ; SINON ; MESS 'Indice "NOMS" : type d objet incorrect' ; QUIT @HISTO ; FINS ; FINS ; * LARG * --------------------------------------------------------------------- LLAR1 = PROG NVAL1*0.8 ; SI (EXIS TOPT1 'LARG') ; SI (EGA (TYPE (TOPT1 . 'LARG')) 'LISTREEL') ; LLAR1 = TOPT1 . 'LARG' ; SI (NEG (DIME LLAR1) NVAL1) ; MESS 'Indice "LARG" : liste de longueur incorrecte' ; QUIT @HISTO ; FINS ; SINON ; MESS 'Indice "LARG" : type d objet incorrect' ; QUIT @HISTO ; FINS ; FINS ; * ESPA * --------------------------------------------------------------------- ESPA1 = 0.2 ; SI (EXIS TOPT1 'ESPA') ; SI (EGA (TYPE (TOPT1 . 'ESPA')) 'FLOTTANT') ; ESPA1 = ABS TOPT1 . 'ESPA' ; SINON ; MESS 'Indice "ESPA" : type d objet incorrect' ; QUIT @HISTO ; FINS ; FINS ; * HPOS * --------------------------------------------------------------------- HPOS1 = 0. ; SI (EXIS TOPT1 'HPOS') ; SI (EGA (TYPE (TOPT1 . 'HPOS')) 'FLOTTANT') ; HPOS1 = TOPT1 . 'HPOS' ; SINON ; MESS 'Indice "HPOS" : type d objet incorrect' ; QUIT @HISTO ; FINS ; FINS ; * INVE * --------------------------------------------------------------------- DIR1 = 1. ; SI (EXIS TOPT1 'INVE') ; SI (EGA (TYPE (TOPT1 . 'INVE')) 'LOGIQUE') ; SI (EGA (TOPT1 . 'INVE') VRAI) ; DIR1 = -1. ; FINS ; SINON ; MESS 'Indice "INVE" : type d objet incorrect' ; QUIT @HISTO ; FINS ; FINS ; * DESS * --------------------------------------------------------------------- BDES1 = FAUX ; MDES1 = ' ' ; SI (EXIS TOPT1 'DESS') ; SI (EGA (TYPE (TOPT1 . 'DESS')) 'MOT') ; BDES1 = VRAI ; MDES1 = TOPT1 . 'DESS' ; SINON ; MESS 'Indice "DESS" : type d objet incorrect' ; QUIT @HISTO ; FINS ; FINS ; * ============================ * FABRICATION DE L'HISTOGRAMME * ============================ EVOHIS TABHIS = VIDE 'EVOLUTIO' 'TABLE' ; TABHIS . 'TITRE' = TABL ; XPOS = DIR1*HPOS1 ; REPE BLOHIS NVAL1 ; * Récupération des paramètres de la barre VAL1 = EXTR LVAL1 &BLOHIS ; LAR1 = EXTR LLAR1 &BLOHIS ; MCOU1 = EXTR LCOU1 ((@MOD (&BLOHIS - 1) (DIME LCOU1)) + 1) ; NOM1 = CHAI &BLOHIS ; SI (BNOM1) ; SI (EXIS TNOM1 &BLOHIS) ; NOM1 = CHAI TNOM1 . &BLOHIS ; FINS ; FINS ; * Création des listes LX et LY LX = PROG ; LY = PROG ; SI (ESPA1 > 0.) ; XPOS = XPOS + (0.5*DIR1*ESPA1) ; FINS ; LX = LX ET XPOS ; LY = LY ET VAL1 ; XPOS = XPOS + (DIR1*LAR1) ; LX = LX ET XPOS ; LY = LY ET VAL1 ; SI (ESPA1 > 0.) ; XPOS = XPOS + (0.5*DIR1*ESPA1) ; FINS ; * Mise à jour de EVOHIS et TABHIS EVO1 = EVOL MCOU1 'MANU' 'TYPE' 'HIST' 'LEGE' NOM1 LX LY ; EVOHIS = EVOHIS ET EVO1 ; TABHIS . 'TITRE' . &BLOHIS = CHAI NOM1 ; TABHIS . &BLOHIS = MOT 'REMP' ; FIN BLOHIS ; * =================== * FIN DE LA PROCEDURE * =================== SI (BDES1) ; DESS EVOHIS TABHIS (TEXT MDES1) ; FINS ; SI (BSOR1) ; RESP EVOHIS TABHIS ; FINS ; FINP ;