ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Quelques utilitaires pour tableaux   



L'auteur

FoxInCloud (Th. Nivelet)
France France
Membre Simple
# 0000000014
enregistré le 13/10/2004

http://www.foxincloud.com/
Nivelet Thierry
75016 Paris
de la société Abaque
Fiche personnelle


Note des membres
pas de note

Contributions > 01 - PRG : Programmation > Tableaux / Array

Quelques utilitaires pour tableaux
# 0000000672
ajouté le 23/02/2009 15:19:18 et modifié le 09/08/2012
consulté 5132 fois
Niveau initié

Version(s) Foxpro :
VFP 9.0


Le téléchargement des pièces jointes est limité aux membres
Veuillez vous identifier ou vous inscrire si vous n'avez pas encore de compte ...
Description

La documentation est dans le code !

Toutes mes excuses pour les éventuelles dépendances non résolues.

Note : ce programme fait partie d'une collection de plus de 500 modules disponibles gratuitement sous licence MIT avec l'Assistant d'Adaptation FoxInCloud : http://foxincloud.com/download.php

23/05/2011 - nouvelle version enrichie de nouveaux modules

09/08/2012 - nouvelle version enrichie de nouveaux modules

Code source :
  * abArray.prg
  * =====================================================
  * (c) SARL Abaque, 66 rue Michel Ange - 75016 Paris - France
  * contact@FoxInCloud.com - http://www.FoxInCloud.com/ - +33 9 53 41 90 90
  * -----------------------------------------------------
  * Ce logiciel est distribué sous licence MIT, tel quel, sans aucune garantie
  * Il peut être utilisé et/ou redistribué sans restriction
  * Toute modification doit être reversée à la communauté
  * La présente mention doit être intégralement reproduite
  && dans toute copie même partielle
  * -----------------------------------------------------
  * This software is distributed under the terms of a MIT-style license, AS IS, without any warranty
  * It may be used and/or distributed without restriction
  * Any substantial improvement must be given for free to the community
  * This permission notice shall be entirely included in all copies
  && or substantial portions of the Software
  * =====================================================

  #INCLUDE AB.H

  *===================================================================
  FUNCTION aChars && Tabule les caractères d'une chaîne
  LPARAMETERS ;
    taResult,; && @ Résultat
    tcString && Chaîne à splitter
  EXTERNAL ARRAY taResult && pour le gestionnaire de projet

  LOCAL llResult, lnChar, lnResult && nombre de lignes du Résultat

  lnResult = 0

  llResult = aClear(@m.taResult) AND Vartype(m.tcString) == 'C'
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Program() - tableau attendu en premier paramètre : <<cLitteral(m.taResult)>>, chaîne en 2nd <<m.tcString>> !]))
  IF m.llResult

    lnResult = Lenc(m.tcString)
    IF m.lnResult > 0

      DIMENSION taResult[m.lnResult]
      FOR lnChar = 1 TO m.lnResult
        taResult[m.lnChar] = Substr(m.tcString, m.lnChar, 1)
      ENDFOR
    ENDIF
  ENDIF

  RETURN m.lnResult

  *===================================================================
  FUNCTION aAdd && Ajoute un élément à un tableau à une dimension
  LPARAMETERS ;
    taResult,; && @ Résultat
    tu,; && élément à ajouter
    tlUnique,; && [.F.] ne pas ajouter l'élément s'il existe déjà
    tlPush && [.F.] Ajouter au début
  EXTERNAL ARRAY taResult && pour le gestionnaire de projet

  LOCAL llResult, lu, lnResult && nombre de lignes du Résultat

  lnResult = 0
  llResult = Type('taResult', 1) == 'A'
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Program() - tableau attendu en premier paramètre : <<cLitteral(m.taResult)>> !]))
  IF m.llResult

    llResult = Alen(taResult,2) = 0
    ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Program() - tableau à une dimension attendu : <<cLitteral(m.taResult)>> !]))
    IF m.llResult

      lnResult = Alen(taResult)
      IF Vartype(m.tlUnique) == 'L' AND m.tlUnique

        IF Vartype(m.tu) == 'O' && Ascan() ne marche pas pour les objets
          FOR EACH lu IN taResult
            llResult = NOT (Vartype(m.lu) == 'O' AND m.lu = m.tu)
            IF NOT m.llResult
              EXIT
            ENDIF
          ENDFOR
        ELSE
          llResult = Ascan(taResult, m.tu, 1, -1, -1, 1+2+4) = 0
        ENDIF
      ENDIF
      IF m.llResult

        lnResult = Iif(laEmpty(@m.taResult), 0, m.lnResult) + 1
        DIMENSION taResult[m.lnResult]
        IF Vartype(m.tlPush) == 'L' AND m.tlPush
          Ains(taResult, 1)
          taResult[1] = m.tu
        ELSE
          taResult[m.lnResult] = m.tu
        ENDIF
      ENDIF
    ENDIF
  ENDIF

  RETURN m.lnResult

  *===================================================================
  FUNCTION aAppend && Ajoute les lignes d'un tableau à un autre
  LPARAMETERS ;
    taDest,; && @ Résultat
    taSrce,; && @ Source des lignes ajoutées à taDest
    tlUnique,; && [.F.] ne pas ajouter les lignes existantes
    tlPrepend && [.F.] ajouter en début de tableau
  EXTERNAL ARRAY taDest, taSrce && pour le gestionnaire de projet
  tlUnique = Vartype(m.tlUnique) == 'L' AND m.tlUnique
  tlPrepend = Vartype(m.tlPrepend) == 'L' AND m.tlPrepend

  LOCAL llResult, lnResult && nombre de lignes du Résultat
  lnResult = 0

  * Si des tableaux ont bien été passés
  llResult = Type('taDest',1) == 'A' AND Type('taSrce', 1) == 'A'
  ASSERT m.llResult MESSAGE 'Les deux paramètres taDest et taSrce doivent être des tableaux'
  IF m.llResult

    * Si le second tableau a des lignes
    LOCAL lnRowsSrce,lnRowSrce, lnRowsDest,lnRowDest
    lnRowsSrce = Iif(laEmpty(@m.taSrce) , 0, Alen(taSrce, 1))
    lnRowsDest = Iif(laEmpty(@m.taDest) , 0, Alen(taDest, 1)) && alen(taDest,1) Fonctionne pour 1 et 2 dimensions
    lnResult = m.lnRowsDest + m.lnRowsSrce
    IF m.lnRowsSrce > 0

      * Ajuster le nombre de lignes et de colonnes du Résultat
      LOCAL lnColsSrce,llColsSrce,lnColSrce, lnColsDest,llColsDest
      lnColsSrce = Alen(taSrce, 2)
      llColsSrce = m.lnColsSrce > 0
      lnColsDest = Alen(taDest, 2) && 0 si 1 dimension
      lnColsDest = Max(m.lnColsDest, m.lnColsSrce)
      llColsDest = m.lnColsDest > 0
      IF m.llColsDest
        DIMENSION taDest[m.lnResult, m.lnColsDest]
      ELSE
        DIMENSION taDest[m.lnResult]
      ENDIF
      IF m.tlPrepend
        FOR m.lnRowSrce = 1 TO m.lnRowsSrce
          Ains(taDest, 1) && ajoute au début du tableau
        ENDFOR
      ENDIF

      * Pour chaque ligne du tableau source
      FOR m.lnRowSrce = 1 TO m.lnRowsSrce

        lnRowDest = Iif(m.tlPrepend, m.lnRowSrce, m.lnRowsDest + m.lnRowSrce)

        DO CASE

        CASE m.llColsDest AND m.llColsSrce && les 2 tableaux ont 2 dimensions
          FOR m.lnColSrce = 1 TO m.lnColsSrce
            taDest[m.lnRowDest, m.lnColSrce] = taSrce[m.lnRowSrce, m.lnColSrce]
          ENDFOR

        CASE m.llColsDest && tableau destination à 2 dimensions, tableau source à 1 dimension
          taDest[m.lnRowDest, 1] = taSrce[m.lnRowSrce]

        OTHERWISE && les 2 tableaux ont 1 dimension
          taDest[m.lnRowDest] = taSrce[m.lnRowSrce]

        ENDCASE
      ENDFOR

      lnResult = Iif(m.tlUnique, aDistinct(@m.taDest), m.lnResult)
    ENDIF
  ENDIF

  RETURN m.lnResult

  *===================================================================
  FUNCTION aSubstract && Soustrait les éléments d'un tableau à un autre
  LPARAMETERS ;
    taDest,; && @ Résultat
    taSrce && @ Tableau contenant les lignes à soustraire de taDest
  EXTERNAL ARRAY taDest, taSrce

  LOCAL liResult, llResult, lnResult

  lnResult = 0
  llResult = Type('taDest', 1) == 'A' AND Type('taSrce', 1) == 'A'
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>> - deux tableaux attendus en paramètres]))
  IF m.llResult

    lnResult = Alen(taDest)
    FOR liResult = m.lnResult TO 1 STEP -1
      IF Ascan(taSrce, taDest[m.liResult], 1, -1, 1, 7+8) > 0 && 7: case insensitive, EXACT ON
        lnResult = m.lnResult - 1
        Adel(m.taDest, m.liResult)
      ENDIF
    ENDFOR

    IF m.lnResult = 0
      aClear(@m.taDest)
    ELSE
      DIMENSION taDest[m.lnResult]
    ENDIF
  ENDIF

  RETURN m.lnResult

  * -------------------------------------------------------------
  PROCEDURE aSubstract_Test && Teste aSubstract()

  LOCAL loTest AS abUnitTest OF abDev.prg, laDest[1]laSrce[1]

  loTest = NewObject('abUnitTest''abDev.prg')
  ALines(laDest, 'toto,tutu,junk,foo,bar'',')
  ALines(laSrce, 'Tutu,fOo'',')

  loTest.Test(3, @m.laDest, @m.laSrce)
  loTest.Assert('toto'laDest[1])
  loTest.Assert('junk'laDest[2])
  loTest.Assert('bar'laDest[3])

  RETURN loTest.Result()

  *===================================================================
  FUNCTION aFilter && Filtre les éléments d'un tableau par un autre
  LPARAMETERS ;
    taDest,; && @ Résultat
    taSrce,; && @ Tableau contenant les lignes filtrant taDest
    tlExactOff,; && [.F.] Comparer avec exact off
    tlCase && [.F.] Comparer en respectant la casse

  EXTERNAL ARRAY taDest, taSrce

  LOCAL liDest, lnSrce, liSrce, liCompare, llResult, lnResult

  lnResult = 0
  llResult = Type('taDest', 1) == 'A' AND Type('taSrce', 1) == 'A'
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>> - deux tableaux attendus en paramètres]))
  IF m.llResult

    lnResult = Alen(taDest, 1)
    lnSrce = Alen(taSrce)
    liCompare = 0;
      + Iif(Vartype(m.tlCase) == 'L' AND m.tlCase, 0, 1);
      + Iif(Vartype(m.tlExactOff) == 'L' AND m.tlExactOff, 0, 2);
      + 4 && override SET EXACT setting
    FOR liDest = m.lnResult TO 1 STEP -1

      IF Ascan(taSrce, taDest[m.liDest, 1], 1, -1, 1, m.liCompare) = 0
        lnResult = m.lnResult - 1
        Adel(m.taDest, m.liDest)
      ENDIF
    ENDFOR

    IF m.lnResult = 0
      aClear(@m.taDest)
    ELSE
      DIMENSION taDest[m.lnResult]
    ENDIF
  ENDIF

  RETURN m.lnResult

  * -------------------------------------------------------------
  PROCEDURE aFilter_Test && Teste aFilter()

  LOCAL loTest AS abUnitTest OF abDev.prg, laDest[1]laSrce[1]

  loTest = NewObject('abUnitTest''abDev.prg')
  ALines(laDest, 'toto,tutu,junk,foo,bar'',')
  ALines(laSrce, 'Tutu,fOo'',')

  loTest.Test(2, @m.laDest, @m.laSrce)
  loTest.Assert('tutu'laDest[1])
  loTest.Assert('foo'laDest[2])

  RETURN loTest.Result()

  *===================================================================
  FUNCTION laEmpty && Tableau inexistant ou vide
  LPARAMETERS ta && @ Tableau à vérifier

  RETURN NOT Type('ta', 1) == 'A' OR ;
    Alen(ta) = 1 AND Vartype(ta[1]) == 'L' AND NOT ta[1]

  EXTERNAL ARRAY ta && après RETURN pour éviter exécution

  * -------------------------------------------------------------
  PROCEDURE laEmpty_test

  LOCAL loTest as abUnitTest OF abDev.prg
  loTest = NewObject('abUnitTest''abDev.prg')

  LOCAL ARRAY laTest[1]
  loTest.Test(.T., @m.laTest)

  RETURN loTest.Result()

  *===================================================================
  FUNCTION aRowDel && Supprime PHYSIQUEMENT une ligne d'un tableau
  LPARAMETERS ;
    taResult,; && @ Résultat
    tnRow && n° de ligne à supprimer
  EXTERNAL ARRAY taResult

  LOCAL llResult, lnResult && par analogie avec aDel(), 1 si la colonne est bien supprimée, 0 sinon

  lnResult = 0
  llResult = NOT Type('taResult[1,2]') == 'U' ; && au moins 2 colonnes
   AND Vartype(m.tnRow) == 'N' ;
   AND m.tnRow > 0 ;
   AND m.tnRow <= Alen(taResult, 1)
  ASSERT m.llResult MESSAGE 'Paramètre(s) requis incorrect(s)'
  IF m.llResult

    * Effacer la ligne
    Adel(taResult, m.tnRow)

    * Redimensionner
    lnResult = Alen(taResult, 1) - 1
    IF m.lnResult = 0
      aClear(@m.taResult)
    ELSE
      DIMENSION taResult[m.lnResult, Alen(taResult, 2)]
    ENDIF
  ENDIF

  RETURN m.lnResult

  *===================================================================
  FUNCTION aColDel && Supprime physiquement une colonne d'un tableau
  LPARAMETERS ;
    taResult,; && @ Résultat
    tnCol && n° de colonne à supprimer
  EXTERNAL ARRAY taResult

  LOCAL lnRows, lnRow, lnCols, llResult, lnResult && par analogie avec aDel(), 1 si la colonne est bien supprimée, 0 sinon

  lnResult = 0
  llResult = NOT Type('taResult[1,2]') == 'U' ; && au moins 2 colonnes
     AND Vartype(m.tnCol) == 'N' ;
     AND m.tnCol > 0 ;
     AND m.tnCol <= Alen(taResult, 2)
  ASSERT m.llResult MESSAGE 'Paramètre(s) requis incorrect(s)'
  IF m.llResult

    * Convertir le tableau en mono-dimensionnel
    lnRows = Alen(taResult, 1)
    lnCols = Alen(taResult, 2)
    DIMENSION taResult[m.lnRows * m.lnCols]

     * Supprimer physiquement les cellules de la colonne à enlever
    FOR m.lnRow = m.lnRows TO 1 STEP -1
      lnResult = Adel(taResult, (m.lnRow - 1) * m.lnCols + m.tnCol)
      IF m.lnResult = 0
        EXIT
      ENDIF
    ENDFOR

     * Rétablir le tableau en 2 dimensions
    IF m.lnResult > 0
      DIMENSION taResult[m.lnRows, m.lnCols - 1]
    ENDIF
  ENDIF

  RETURN m.lnResult

  * --------------------------------------
  PROCEDURE aColDel_Test
  ? Sys(16)
  LOCAL ARRAY laTest[1]

  * Supprimer la colonne de gauche
  DIMENSION laTest[2,3]
  laTest = .F.
  laTest[1,2] = 1
  laTest[2,2] = 2
  laTest[1,3] = 3
  laTest[2,3] = 4
  ? aColDel(@m.laTest, 1) = 1
  ? Alen(laTest, 2) = 2
  ? laTest[1,1] = 1
  ? laTest[2,1] = 2
  ? laTest[1,2] = 3
  ? laTest[2,2] = 4

  * Supprimer une colonne interne
  DIMENSION laTest[2,3]
  laTest = .F.
  laTest[1,1] = 1
  laTest[2,1] = 2
  laTest[1,3] = 3
  laTest[2,3] = 4
  ? aColDel(@m.laTest, 2) = 1
  ? Alen(laTest, 2) = 2
  ? laTest[1,1] = 1
  ? laTest[2,1] = 2
  ? laTest[1,2] = 3
  ? laTest[2,2] = 4

  * Supprimer la colonne de droite
  DIMENSION laTest[2,3]
  laTest = .F.
  laTest[1,1] = 1
  laTest[2,1] = 2
  laTest[1,2] = 3
  laTest[2,2] = 4
  ? aColDel(@m.laTest, 3) = 1
  ? Alen(laTest, 2) = 2
  ? laTest[1,1] = 1
  ? laTest[2,1] = 2
  ? laTest[1,2] = 3
  ? laTest[2,2] = 4

  *===================================================================
  FUNCTION aColsDel && Supprime physiquement plusieurs colonnes d'un tableau
  LPARAMETERS ;
    taResult,; && @ Résultat
    tnCol1,; && n° de la première colonne à supprimer
    tnCol2 && [ultime] N° de la dernière colonne à supprimer
  EXTERNAL ARRAY taResult

  LOCAL llResult, lnResult && analogue à aDel() : 1 si les colonnes sont bien supprimées, 0 sinon
  lnResult = 0

  * Si les paramètres requis sont valides
  llResult = NOT Type('taResult[1,2]') == 'U' ; && au moins 2 colonnes
   AND Vartype(m.tnCol1) == 'N' ;
   AND m.tnCol1 > 0 ;
   AND m.tnCol1 <= Alen(taResult, 2)
  ASSERT m.llResult MESSAGE 'Paramètre(s) requis incorrect(s)'
  IF m.llResult

    * Régler les paramètres optionnels à leur valeur par défaut
    LOCAL lnCols, lnCol2, lnCol
    lnCols = Alen(taResult, 2)
    lnCol2 = Iif(Vartype(m.tnCol2) == 'N' AND m.tnCol2 <= m.lnCols, m.tnCol2, m.lnCols)
    lnCol2 = Max(m.lnCol2, m.tnCol1)

    * Si la suppression des colonnes est possible
    llResult = NOT (m.tnCol1 = 1 AND m.lnCol2 = m.lnCols)
    ASSERT m.llResult MESSAGE "Impossible de supprimer toutes les colonnes d'un tableau"
    IF m.llResult

      * Supprimer chaque colonne
      FOR m.lnCol = m.lnCol2 TO m.tnCol1 STEP -1
        lnResult = aColDel(@m.taResult, m.lnCol)
        IF m.lnResult = 0
          EXIT
        ENDIF
      ENDFOR
    ENDIF
  ENDIF

  RETURN m.lnResult

  * --------------------------------------
  PROCEDURE aColsDel_Test
  ? Sys(16)

  LOCAL ARRAY laTest[1]

  DIMENSION laTest[2,4]
  laTest = .F.
  laTest[1,1] = 1
  laTest[2,1] = 2
  laTest[1,4] = 3
  laTest[2,4] = 4
  ? aColsDel(@m.laTest, 2, 3) = 1
  ? Alen(laTest, 2) = 2
  ? laTest[1,1] = 1
  ? laTest[2,1] = 2
  ? laTest[1,2] = 3
  ? laTest[2,2] = 4

  DIMENSION laTest[2,4]
  laTest = .F.
  laTest[1,1] = 1
  laTest[2,1] = 2
  ? aColsDel(@m.laTest, 2) = 1
  ? Alen(laTest, 2) = 1
  ? laTest[1,1] = 1
  ? laTest[2,1] = 2

  *===================================================================
  FUNCTION aVarType && Vartypes d'après un tableau ou une liste délimité ou non
  LPARAMETERS ;
    taResult,; && @ Résultat
    tuTypes && @ (Var)types (array ou cListe)
  EXTERNAL ARRAY taResult, tuTypes

  LOCAL llArray, llResult

  llResult = aClear(@m.taResult)
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - paramètre(s) invalides : <<cLitteral(m.taResult)>>, <<cLitteral(m.tuTypes)>>]))

  llArray = Type('tuTypes', 1) == 'A'

  RETURN ICase(;
        NOT m.llResult, 0,;
        m.llArray, Min(Acopy(tuTypes, taResult), 0) + Alen(taResult),;
        Vartype(m.tuTypes) == 'C'Iif(;
          ',' $ m.tuTypes OR ';' $ m.tuTypes OR TABUL $ m.tuTypes OR '|' $ m.tuTypes;
                    , ALines(taResult, Upper(m.tuTypes), 1+4, ','';', TABUL, '|'),;
          aChars(@m.taResult, Upper(Chrtran(m.tuTypes, Space(1), Space(0))))),;
        0)


  *===================================================================
  FUNCTION aColsIns && Insère physiquement une ou plusieurs colonne(s) dans un tableau
  LPARAMETERS ;
    taResult,; && @ Résultat
    tnColBef,; && [dernière] n° de colonne APRÈS laquelle insérer la(es) nouvelle(s) colonne(s), 0 pour ajouter au début
    tnColsIns,; && [1] Nombre de colonnes à insérer
    tuVal,; && [.F. ou uEmpty(tuTypes)] Valeur des cellules ajoutées
    tuTypes && @ Types des colonnes (array ou liste) in 'CDGLNOQTUXYI'

  LOCAL llResult, lnResult && Nombre de colonnes après l'insersion
  lnResult = 0

  * Si un tableau a été passé
  llResult = Type('taResult', 1) == 'A'
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Program() - tableau attendu en premier paramètre : <<cLitteral(m.taResult)>> !]))
  IF m.llResult

    LOCAL lnRows, lnRow;
        , lnCols, lnCol

    lnRows = Alen(taResult, 1)
    lnCols = Alen(taResult, 2)

    * Si tableau à une dim.
    IF m.lnCols = 0

      * Convertir à 2 dimensions
      lnCols = 1
      DIMENSION taResult[m.lnRows, m.lnCols]
    ENDIF

    * Vérifier la validité du n° de colonne passé
    IF Vartype(m.tnColBef) == 'N'
      llResult = Between(m.tnColBef, 0, m.lnCols)
      ASSERT m.llResult MESSAGE cAssertMsg(Textmerge("<<Proper(Program())>>() - le n° de colonne <<m.tnColBef>> est hors des limites du tableau."))
    ELSE
      tnColBef = m.lnCols && après la dernière colonne
    ENDIF
  ENDIF

  IF m.llResult

    tnColsIns = Iif(Vartype(m.tnColsIns) == 'N' AND m.tnColsIns > 0, m.tnColsIns, 1)
    lnResult = m.lnCols + m.tnColsIns

    * Créer un tableau de travail
    LOCAL laTemp[m.lnRows, m.lnResult];
      ,  laType[1], lnTypes;
      , llColBeg, lnColIns, llColIns, llColInsTyped

    * Voir si le typage est demandé
    lnTypes = aVarType(@m.laType, @m.tuTypes)

    * Remplir le tableau de travail
    FOR m.lnCol = 1 TO m.lnResult

      llColBeg = m.lnCol <= m.tnColBef

      lnColIns = m.lnCol - m.tnColBef
      llColIns = Between(m.lnColIns, 1, m.tnColsIns)
      llColInsTyped = m.llColIns AND m.lnColIns <= m.lnTypes

      FOR m.lnRow = 1 TO m.lnRows

        laTemp[m.lnRow, m.lnCol] = ICase(;
          m.llColBeg, taResult[m.lnRow, m.lnCol],; && avant la(es) nouvelle(s) colonne(s)
          m.llColIns; && nouvelle(s) colonne(s
                , Iif(m.llColInsTyped;
                    , uEmpty(laType[m.lnColIns]);
                    , m.tuVal;
                ),;
          taResult[m.lnRow, m.lnCol - m.tnColsIns]&& après la(es) nouvelle(s) colonne(s)
          )
      ENDFOR
    ENDFOR

    * Copier le tableau de travail dans le résultat
    DIMENSION taResult[m.lnRows, m.lnResult]
    Acopy(laTemp, taResult) && contrairement à ce que dit la doc, ne dimensionne pas correctement taResult
  ENDIF

  RETURN m.lnResult

  * --------------------------------------
  PROCEDURE aColsIns_Test && Teste aColsIns()

  LOCAL loTest as abUnitTest OF abDev.prg, laTest[1]
  loTest = NewObject('abUnitTest''abDev.prg')

  && TABLEAU À UNE DIMENSION

  aColsIns_Test_a(@m.laTest, 3)
    loTest.Test(3, @m.laTest, 0, 2) && 2 colonnes au début
    loTest.Assert(.F.laTest[3,1]&& 1ère colonne insérée
    loTest.Assert(2, laTest[2,3]&& La colonne initiale est maintenant # 3

  && TABLEAU À DEUX DIMENSIONS

  && ajout au début
  aColsIns_Test_a(@m.laTest, 2, 3)
    loTest.Test(5, @m.laTest, 0, 2) && 2 colonnes au début (1,2)
    loTest.Assert(6, laTest[2,5]&& donnée initiale
    loTest.Assert(.F.laTest[1,2]&& 2ème colonne insérée

  && ajout à l'intérieur
  aColsIns_Test_a(@m.laTest, 2, 3)
    loTest.Test(5, @m.laTest, 2, 2) && 2 colonnes après la 2 (3,4)
    loTest.Assert(6, laTest[2,5]&& donnée initiale
    loTest.Assert(.F.laTest[1,4]&& 2ème colonne insérée

  && ajout à la fin
  aColsIns_Test_a(@m.laTest, 2, 3)
    loTest.Test(5, @m.laTest, , 2) && 2 colonnes à la fin (4,5)
    loTest.Assert(6, laTest[2,3]&& donnée initiale
    loTest.Assert(.F.laTest[2,5]&& 2ème colonne insérée

    && ajout à la fin avec valeur imposée
    aColsIns_Test_a(@m.laTest, 2, 3)
      loTest.Test(5, @m.laTest, , 2, 'test'&& 2 colonnes à la fin (4,5)
      loTest.Assert(6, laTest[2,3]&& donnée initiale
      loTest.Assert('test'laTest[2,5]&& 2ème colonne insérée

    && ajout à la fin avec type imposé
    aColsIns_Test_a(@m.laTest, 2, 3)
      loTest.Test(5, @m.laTest, , 2, , 'IC'&& 2 colonnes à la fin (4,5)
      loTest.Assert(6, laTest[2,3]&& donnée initiale
      loTest.Assert(''laTest[2,5]&& 2ème colonne insérée

    * --------------------------------------
    PROCEDURE aColsIns_Test_a && Initialise le tableau de test avec aElement()
    LPARAMETERS taTest, tnRows, tnCols
    EXTERNAL ARRAY taTest
    IF Empty(m.tnCols)
      DIMENSION taTest[m.tnRows]
    ELSE
      DIMENSION taTest[m.tnRows, m.tnCols]
    ENDIF
    LOCAL lnTest
    FOR lnTest = 1 TO Alen(taTest)
      taTest[m.lnTest] = m.lnTest
    ENDFOR


  *===================================================================
  FUNCTION laEqual && Deux tableaux sont exactement identiques
  LPARAMETERS ;
    ta1,; && @ tableau 1
    ta2,; && @ tableau 2
    tlCase && [.F.] Si élements de type caractère, ignorer la casse, les diacritiques et les espaces de fin
  EXTERNAL ARRAY ta1, ta2

  LOCAL llParms, lnLen, lnElt, luElt1, luElt2, lcType, llResult && Tableaux identiques

  * Si deux tableaux ont bien été passés
  llParms = Type('ta1', 1) == 'A' AND Type('ta2', 1) == 'A'
  ASSERT m.llParms MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - Deux tableaux attendus: <<ta1>> | <<ta2>>]))
  IF m.llParms

    * Si les 2 tableaux ont le même nombre d'éléments
    lnLen = Alen(ta1)
    IF m.lnLen = Alen(ta2)

      * Pour chaque élément
      tlCase = Vartype(m.tlCase) == 'L' AND m.tlCase
      FOR lnElt = 1 TO m.lnLen

        luElt1 = ta1[m.lnElt]
        luElt2 = ta2[m.lnElt]
        lcType = Vartype(m.luElt1)

        llResult = m.lcType == Vartype(m.luElt2); && éléments de même type
           AND Iif(m.lcType = 'C' AND m.tlCase;
              , Upper(cEuroAnsi(Rtrim(m.luElt1))) == Upper(cEuroAnsi(Rtrim(m.luElt2)));
              , luEqual(m.luElt1, m.luElt2);
              )
        IF NOT m.llResult
          EXIT
        ENDIF
      ENDFOR
    ENDIF
  ENDIF

  RETURN m.llResult

  * -------------------------------------------------------------
  PROCEDURE laIdem_test

  LOCAL loTest as abUnitTest OF abDev.prg
  loTest = NewObject('abUnitTest''abDev.prg')

  LOCAL ARRAY la1[5]la2[5]
  la1[1] = 'tete'
  la1[2] = 2.5
  la1[3] = .F.
  la1[4] = Date()
  la1[5] = Datetime()

  la2[1] = 'Tête'
  la2[2] = 2.5
  la2[3] = .F.
  la2[4] = Date()
  la2[5] = Datetime()

  loTest.Test(.T., @m.la1, @m.la2, .T.)

  RETURN loTest.Result()

  *===================================================================
  FUNCTION laOccurs && Un tableau à une dimension est une ligne d'un tableau à 2 dim.
  LPARAMETERS ;
    ta1,; && @ tableau 1 à une dimension
    ta2,; && @ tableau 2 à deux dimensions
    tlCase && [.F.] Élements caractère : Comparer en ignorant la casse, les diacritiques et les espaces de fin
  EXTERNAL ARRAY ta1, ta2
  LOCAL llResult && La ligne existe

  * Si des tableaux ont bien été passés
  llResult = Type('ta1', 1) == 'A'  AND Type('ta2', 1) = 'A'
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - Invalid parameters]))
  IF m.llResult

    * Si le second tableau est à 2 dims et les deux tableaux ont le même nombre de colonnes
    LOCAL lnCols
    lnCols = Alen(ta2, 2)
    llResult = m.lnCols > 0 AND Alen(ta1) = m.lnCols
    ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - Les deux tableaux doivent avoir le même nombre de colonnes]))
    IF m.llResult

      * Pour chaque ligne du second tableau
      LOCAL lnRow, laRow[m.lnCols]
      FOR lnRow = 1 TO Alen(ta2, 1)

        * Extraire la ligne dans un tableau temporaire
        Acopy(ta2, laRow, Aelement(ta2, m.lnRow, 1), m.lnCols)
        DIMENSION laRow[m.lnCols] && Acopy() dimensionne laRow comme ta2

        * Si la ligne est identique au tableau 1, terminé
        llResult = laEqual(@m.laRow, @m.ta1, m.tlCase)
        IF m.llResult
          EXIT
        ENDIF
      ENDFOR
    ENDIF
  ENDIF

  RETURN m.llResult

  *===================================================================
  FUNCTION aDistinct && Tableau dont chaque ligne est unique
  LPARAMETERS taResult && @ Tableau
  EXTERNAL ARRAY taResult

  LOCAL llResult, lnResult && Nombre de lignes du tableau après dédoublonnage
  lnResult = 0

  * Si tableau
  llResult = Type('taResult', 1) == 'A'
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge("<<Proper(Program())>>() - Tableau attendu au lieu de <<cLitteral(taResult)>>"))
  IF m.llResult

    * Si plus d'une ligne
    lnResult = Alen(taResult, 1)
    IF m.lnResult > 1

      * Pour chaque ligne en partant de la fin
      LOCAL laRow[1], lnCols, lnRow, lnRow1, lnCol, llDup
      lnCols = Alen(taResult, 2)
      FOR lnRow = m.lnResult TO 2 STEP -1

        * Copier pour référence
        IF m.lnCols > 0
          Acopy(taResult, laRow, Aelement(taResult, m.lnRow, 1), m.lnCols)
        ELSE
          Acopy(taResult, laRow, Aelement(taResult, m.lnRow), 1)
        ENDIF

        * Pour chaque ligne jusqu'à celle précédant celle examinée
        FOR lnRow1 = 1 TO m.lnRow - 1
          IF m.lnCols > 0
            FOR lnCol = 1 TO m.lnCols
              llDup = taResult[m.lnRow1, m.lnCol] == laRow[m.lnCol]
              IF NOT m.llDup
                EXIT
              ENDIF
            ENDFOR
          ELSE
            llDup = taResult[m.lnRow1] == laRow[1]
          ENDIF
          IF m.llDup
            EXIT
          ENDIF
        ENDFOR

        * Si la ligne existe, supprimer
        IF m.llDup
          Adel(taResult, m.lnRow)
          lnResult = m.lnResult - 1
        ENDIF
      ENDFOR

      * Retailler le tableau
      IF m.lnCols > 0
        DIMENSION taResult[m.lnResult, m.lnCols]
      ELSE
        DIMENSION taResult[m.lnResult]
      ENDIF
    ENDIF
  ENDIF

  RETURN m.lnResult

  * -----------------------------------------------------------------
  PROCEDURE aDistinct_Test && Teste aDistinct

  LOCAL loTest as abUnitTest OF abDev.prg
  loTest = NewObject('abUnitTest''abDev.prg')

  PUBLIC ARRAY laTest[3, 3] && PUBLIC pour l'examiner après test
  laTest[1, 1] = 'toto'
  laTest[1, 2] = 3
  laTest[1, 3] = .T.

  laTest[2, 1] = 'TOTO'
  laTest[2, 2] = 3
  laTest[2, 3] = .T.

  laTest[3, 1] = 'toto'
  laTest[3, 2] = 3
  laTest[3, 3] = .T.

  loTest.Test(2, @m.laTest)

  RETURN m.loTest.Result()

  *===================================================================
  FUNCTION aLookup && Valeur d'une colonne d'un tableau selon une clé cherchée dans une autre colonne
  LPARAMETERS ;
    taSrce,; && @ Tableau source
    tuVal,; && Valeur à trouver
    tnColIn,; && Colonne où chercher
    tnColOut,; && Colonne où trouver
    tnFlags && [15] nFlags selon options de aScan()
  EXTERNAL ARRAY taSrce
  tnFlags = Iif(Vartype(m.tnFlags) == 'N' AND Between(m.tnFlags, 0, 15), m.tnFlags, 15)

  LOCAL liResult, llResult, luResult && Valeur trouvée
  luResult = .NULL&& Si valeur pas trouvée

  llResult = Type('taSrce', 1) == 'A';
   AND Vartype(m.tnColIn) == 'N';
   AND Between(m.tnColIn, 1, Alen(taSrce, 2));
   AND Vartype(m.tnColOut) == 'N';
   AND Between(m.tnColOut, 1, Alen(taSrce, 2));
   AND NOT m.tnColIn = m.tnColOut
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge("<<Proper(Program())>>() - Au moins un paramètre invalide"))
  IF m.llResult
    liResult = Ascan(taSrce, m.tuVal, 1, -1, m.tnColIn, m.tnFlags)
    luResult = Iif(m.liResult > 0, taSrce[m.liResult, m.tnColOut], m.luResult)
  ENDIF

  RETURN m.luResult

  *===================================================================
  FUNCTION aSelect && Lignes d'un tableau selon une clé
  LPARAMETERS ;
    taSrce,; && @ Tableau source
    taDest,; && @ Tableau destination
    tnCol,; && Colonne où chercher
    tuVal,; && Valeur à trouver
    tnFlags && [15] nFlags selon options de aScan()
  EXTERNAL ARRAY taSrce, taDest
  tnFlags = Iif(Vartype(m.tnFlags) == 'N' AND Between(m.tnFlags, 0, 15), m.tnFlags, 15)

  LOCAL liResult, llResult, lnResult && Nombre de lignes trouvées
  lnResult = 0

  llResult = Type('taSrce', 1) == 'A';
   AND Type('taDest', 1) == 'A';
   AND Vartype(m.tnCol) == 'N';
   AND Between(m.tnCol, 1, Alen(taSrce, 2))
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge("<<Proper(Program())>>() - Au moins un paramètre invalide"))
  IF m.llResult

    * Si la valeur existe
    liResult = Ascan(taSrce, m.tuVal, 1, -1, m.tnCol, m.tnFlags)
    IF m.liResult > 0

      aClear(@m.taDest)

      DO WHILE liResult > 0
        aRowCopyIns(@m.taDest, @m.taSrce,, m.liResult)
        lnResult = m.lnResult + 1
        liResult = Ascan(taSrce, m.tuVal, m.liResult+1, -1, m.tnCol, m.tnFlags)
      ENDDO
    ENDIF
  ENDIF

  RETURN m.lnResult

  * -----------------------------------------------------------------
  PROCEDURE aSelect_Test && Teste aSelect

  LOCAL loTest as abUnitTest OF abDev.prg
  loTest = NewObject('abUnitTest''abDev.prg')

  PUBLIC ARRAY laSrce[1]laDest[1] && PUBLIC pour examen après test
  AVcxClasses(laSrce, 'aw.vcx')

  loTest.Test(2, @m.laSrce, @m.laDest, 2, 'form')

  RETURN m.loTest.Result()

  *===================================================================
  FUNCTION aClear && Vide un tableau
  LPARAMETERS ;
    taResult && @ Tableau
  EXTERNAL ARRAY taResult

  IF Type('taResult', 1) == 'A'
    DIMENSION taResult[1]
    taResult[1] = .F.
    RETURN .T.
  ELSE
    RETURN .F.
  ENDIF

  * -------------------------------------------------------------
  PROCEDURE aClear_test

  LOCAL loTest as abUnitTest OF abDev.prg
  loTest = NewObject('abUnitTest''abDev.prg')

  LOCAL ARRAY laTest[3]
  loTest.Test(.T., @m.laTest)

  RETURN loTest.Result()

  *===================================================================
  FUNCTION aRowCopyIns && Copie une ligne d'un tableau et l'insère dans un autre à une position donnée
  LPARAMETERS ;
    taDest,; && @ Résultat
    taSrce,; && @ tableau source des lignes copiées dans taDest
    tiDest,; && [dernière] N° de ligne APRÈS laquelle insérer la ligne copiée, 0 pour insérer au début
    tiSrce   && [1] n° de la ligne du tableau source à copier dans la destination
  EXTERNAL ARRAY taDest, taSrce
  LOCAL lnCols, lnCol, llResult, lnResult && nombre de lignes du tableau destination

  lnResult = 0
  llResult = Type('taDest', 1) == 'A' AND Type('taSrce', 1) == 'A'
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - les deux premiers paramètres doivent être des tableaux]))
  IF m.llResult

    llResult = laEmpty(@m.taDest)
    IF m.llResult
      lnCols = Alen(taSrce,2)
    ELSE
      lnCols = Alen(taDest,2)
      llResult = m.lnCols = Alen(taSrce,2)
      ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - les deux tableaux doivent avoir le même nombre de colonnes]))
      lnResult = Iif(m.llResult, Alen(taDest, 1), 0)
    ENDIF
    IF m.llResult

      tiDest = Iif(Vartype(m.tiDest) == 'N' AND Between(m.tiDest, 0, m.lnResult), m.tiDest, m.lnResult) + 1 && spec aIns() : AVANT
      tiSrce = Iif(Vartype(m.tiSrce) == 'N' AND Between(m.tiSrce, 1, Alen(taSrce, 1)), m.tiSrce, 1)

      * Insérer la nouvelle ligne
      lnResult = m.lnResult + 1
      DIMENSION taDest[m.lnResult, m.lnCols]
      Ains(taDest, m.tiDest)

      * Copier les données dans la nouvelle ligne
      FOR lnCol = 1 TO m.lnCols
        taDest[m.tiDest, m.lnCol] = taSrce[m.tiSrce, m.lnCol]
      ENDFOR
    ENDIF
  ENDIF

  RETURN m.lnResult

  *===================================================================
  FUNCTION aPush && Ajoute un élément à un tableau à UNE dimension
  LPARAMETERS ;
    taResult,; && @ Résultat
    tuElt,; && élément à ajouter
    tlUnique && [.F.] Ne pas ajouter l'élément au tableau s'il y est déjà
  EXTERNAL ARRAY taResult

  LOCAL llResult, lnResult

  lnResult = 0
  llResult = Type('taResult',1) == 'A';
   AND Alen(taResult, 2) = 0; && une dimension
   AND Pcount() >= 2
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - paramètres invalides ou incomplets]))
  IF m.llResult;
   AND (NOT (Vartype(m.tlUnique) == 'L' AND m.tlUnique);
       OR Ascan(m.taResult, m.tuElt, 1, -1, 1, 5) = 0;
       )

    lnResult = Iif(laEmpty(@m.taResult), 0, Alen(taResult)) + 1
    DIMENSION taResult[m.lnResult]
    taResult[m.lnResult] = m.tuElt
  ENDIF

  RETURN m.lnResult

  * -------------------------------------------------
  PROCEDURE aPush_test

  LOCAL loTest as abUnitTest OF abDev.prg;
  , laResult[1], lnResult;
  , laExpected[1], lnExpected

  loTest = NewObject('abUnitTest''abDev.prg')

  lnResult = aLitteral(@m.laResult, [1,'toto',1,2,'tata',2])
  lnExpected = aLitteral(@m.laExpected, [1,'toto',1,2,'tata',2, .F.])
  loTest.Test(m.lnResult + 1, @m.laResult, .F.)
  loTest.Assert(@m.laExpected, @m.laResult)

  lnResult = aLitteral(@m.laResult, [1,'toto',1,2,'tata',2])
  lnExpected = aLitteral(@m.laExpected, [1,'toto',1,2,'tata',2])
  loTest.Test(m.lnResult, @m.laResult, 'toto'.T.)
  loTest.Assert(@m.laExpected, @m.laResult)

  lnResult = aLitteral(@m.laResult, [1,'toto',1,2,'tata',2])
  lnExpected = aLitteral(@m.laExpected, [1,'toto',1,2,'tata',2])
  loTest.Test(m.lnResult, @m.laResult, 1, .T.)
  loTest.Assert(@m.laExpected, @m.laResult)

  RETURN loTest.Result()

  *===================================================================
  FUNCTION aLocate && Cherche plusieurs valeurs dans un tableau à 2 dimensions [à la manière de LOCATE FOR]
  LPARAMETERS ;
    taIn,; && @ Tableau où chercher
    taFor,; && @ Valeurs à chercher dans l'ordre des colonnes ; .NULL. pour ignorer une colonne
    tlCaseNo,; && [.F.] Chercher les valeurs caractères en ignorant la casse
    tlExactNo && [.F.] Chercher les valeurs caractères en EXACT OFF
  EXTERNAL ARRAY taIn, taFor

  LOCAL loExact AS abSet, llResult, liResult && Ligne trouvée, 0 si aucune ne
  liResult = 0

  llResult = Type('taIn', 1) == 'A' AND Type('taFor', 1) == 'A';
   AND Alen(taFor, 2) = 0; && une dimension
   AND Alen(taFor) <= Alen(taIn, 2)
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - au moins un paramètre invalide]))
  IF m.llResult

    LOCAL liCols, liColKey, luKey, lnFlags, liRow, liCol, luFor, lcType

    * Si au moins une valeur à chercher est non nulle (clé)
    liCols = Alen(taFor)
    FOR liColKey = m.liCols TO 1 STEP -1
      luKey = taFor[m.liColKey]
      llResult = NOT IsNull(m.luKey)
      IF m.llResult
        EXIT
      ENDIF
    ENDFOR
    IF m.llResult

      * Si la clé existe dans le tableau
      loExact = CreateObject('abSet''EXACT'Iif(Vartype(m.tlExactNo) == 'L' AND m.tlExactNo, 'OFF''ON'))

      tlCaseNo = Vartype(m.tlCaseNo) == 'L' AND m.tlCaseNo
      lnFlags = Iif(m.tlCaseNo, 1, 0) + Iif(m.tlExactNo, 0, 2) + 4 + 8
      liRow = Ascan(taIn, m.luKey, 1, -1, m.liColKey, m.lnFlags)

      * Pour chaque occurence de la clé
      llResult = .F.
      DO WHILE liRow > 0

        * Si les autres valeurs sont dans la ligne
        FOR liCol = 1 TO m.liCols
          luFor = taFor[m.liCol]
          lcType = Vartype(m.luFor)
          llResult = m.lcType == 'X';
           OR m.lcType == Vartype(taIn[m.liRow, m.liCol]);
            AND Iif(m.lcType == 'C' AND m.tlCaseNo;
                , Upper(taIn[m.liRow, m.liCol]) = Upper(m.luFor);
                , taIn[m.liRow, m.liCol] = m.luFor;
                )

          IF NOT m.llResult
            EXIT
          ENDIF
        ENDFOR
        IF m.llResult
          liResult = m.liRow
          EXIT
        ELSE
          liRow = Ascan(taIn, m.luKey, m.liRow + 1, -1, m.liColKey, m.lnFlags)
        ENDIF
      ENDDO
    ENDIF
  ENDIF

  RETURN m.liResult

  * -------------------------------------------------------------
  PROCEDURE aLocate_test

  LOCAL loTest as abUnitTest OF abDev.prg, laIn[1]laFor[1]
  loTest = NewObject('abUnitTest''abDev.prg')

  aLitteral(@m.laIn, [1,'toto',1,2,'tata',2], 3)
  aLitteral(@m.laFor, [2,'tata',.NULL.])

  loTest.Test(2, @m.laIn, @m.laFor)

  aLitteral(@m.laFor, [2,'TATA',.NULL.])
  loTest.Test(2, @m.laIn, @m.laFor, .T.)

  aLitteral(@m.laFor, [2,'TAT',.NULL.])
  loTest.Test(2, @m.laIn, @m.laFor, .T..T.)

  RETURN loTest.Result()

  *===================================================================
  FUNCTION aLitteral && Tableau d'après une liste de litteraux
  LPARAMETERS ;
    taResult,; && @ Résultat
    tc,; && Constantes séparées par une ',' ou un point ','
    tiCols && [0] Nombre de colonnes
  EXTERNAL ARRAY taResult

  LOCAL liResult, llResult, lnResult && nombre de lignes du Résultat

  lnResult = 0

  llResult = Type('taResult', 1) == 'A' AND Vartype(m.tc) == 'C' AND NOT Empty(m.tc)
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - au moins un paramètre invalide]))
  IF m.llResult

    lnResult = ALines(taResult, m.tc, 1, ','';')
    FOR liResult = 1 TO m.lnResult
      taResult[m.liResult] = Evaluate(taResult[m.liResult])
    ENDFOR

    tiCols = Iif(Vartype(m.tiCols) == 'N' AND Int(tiCols) = m.tiCols, m.tiCols, 0)
    IF tiCols > 0
      lnResult = Ceiling(Alen(taResult) / m.tiCols)
      DIMENSION taResult[m.lnResult, m.tiCols]
    ENDIF
  ENDIF

  RETURN m.lnResult

  *===================================================================
  FUNCTION aColsDelim && Tableau à 2 dim d'après un tableau à une dimension contenant du texte délimité
  LPARAMETERS ;
    taRow,; && @ Tableau à traiter et résultat en retour
    tcSeps,; && [,;<Chr(9)>|] Séparateur de colonnes (plus rapide en le précisant)
    tuTypes && @ Types des colonnes (array ou liste) in 'CDGLNOQTUXYI' - les colonnes non précisées restent en caractères
  EXTERNAL ARRAY taRow, tuTypes

  LOCAL llResult, lnResult && lignes

  llResult = NOT laEmpty(@m.taRow) AND Alen(taRow,2) <= 1
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - le premier paramètre doit être un tableau à une dimension non vide : <<cLitteral(@m.taRow)>>]))
  IF m.llResult

    lnResult = Alen(taRow, 1)

    LOCAL laSep[1], lcSep, llSep;
      ,  laRow[1], liRow, lcRow;
      ,  laCol[1], liCol, lnCols;
      ,  laType[1], lnTypes, llTypes

    * Tabuler les séparateurs de colonnes
    llSep = aChars(@m.laSep, Iif(Vartype(m.tcSeps) == 'C' AND Lenc(m.tcSeps) > 0, m.tcSeps, [,;|] + TABUL)) = 1

    * Calculer le nombre de colonnes et le séparateur s'il est ambigü
    lnCols = 0
    lcSep = Iif(m.llSep, m.tcSeps, Space(0))
    FOR EACH lcRow IN taRow
      lnCols = Max(m.lnCols, 1 + Iif(m.llSep;
                , Occurs(m.lcSep, m.lcRow);
                , aColsDelim_nColsSep(m.lcRow, @m.laSep, @m.lcSep);
                ))
    ENDFOR
    ASSERT Lenc(m.lcSep) = 1 MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() n'a trouvé aucun séparateur, le tableau aura une seule colonne]))

    * Si le typage est demandé, forcer le nombre de colonnes à la spécification de types
    lnTypes = aVarType(@m.laType, @m.tuTypes)
    llTypes = m.lnTypes > 0
    lnCols = Max(m.lnCols, m.lnTypes)

    * Tabuler à deux dimensions
    DIMENSION laRow[m.lnResult, m.lnCols]
    laRow = Space(0)
    FOR liRow = 1 TO m.lnResult
      ALines(laCol, taRow[m.liRow], 1, m.lcSep)
      FOR liCol = 1 TO Alen(laCol)
        laRow[m.liRow, m.liCol] = laCol[m.liCol]
      ENDFOR
    ENDFOR
    DIMENSION taRow[m.lnResult, m.lnCols]
    Acopy(laRow, taRow)

    * Le cas échéant, typer les données
    IF m.llTypes

      FOR liCol = 1 TO Min(m.lnCols, m.lnTypes)
        FOR liRow = 1 TO m.lnResult
          taRow[m.liRow, m.liCol] = uValue(taRow[m.liRow, m.liCol],  laType[m.liCol])
        ENDFOR
      ENDFOR
    ENDIF
  ENDIF

  RETURN m.lnResult

  * -------------------------------------------------------------
  FUNCTION aColsDelim_nColsSep && Nombre de colonnes et séparateur par défaut
  LPARAMETERS tcRow, taSep, tcSep

  LOCAL lcSep, lnSep, lcSepMax, llResult, lnResult

  lnResult = 0
  lcSepMax = Space(0)
  FOR EACH lcSep IN taSep
    lnSep = Occurs(lcSep, m.tcRow)
    IF m.lnSep > m.lnResult
      lnResult = m.lnSep
      lcSepMax = m.lcSep
    ENDIF
  ENDFOR

  IF Lenc(m.tcSep) = 0
    tcSep = m.lcSepMax
    RETURN m.lnResult
  ELSE
    llResult = Lenc(m.lcSepMax) = 0 OR m.lcSepMax == m.tcSep
    ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - Séparateur de colonne ambigu, veuillez préciser '<<m.lcSepMax>>' ou '<<m.tcSep>>']))
    RETURN Iif(m.llResult, m.lnResult, 0)
  ENDIF

  EXTERNAL ARRAY taSep

  *===================================================================
  FUNCTION aLinesCols && Tableau à 2 dim d'après un texte multiligne délimité
  LPARAMETERS ;
    taResult,; && @ Résultat
    tcTxt,; && Texte multiligne tabulé
    tcSep,; && [,;<Chr(9)>|] Séparateur de colonnes (plus rapide en le précisant)
    tuTypes && Types des colonnes (@array ou liste) in 'CDGLNOQTUXYI' - les colonnes non précisées restent en caractères
  EXTERNAL ARRAY taResult, tuTypes

  LOCAL llResult, lnResult && lignes

  llResult = aClear(@m.taResult) AND Vartype(m.tcTxt) == 'C' AND NOT Empty(m.tcTxt)
  ASSERT m.llResult MESSAGE cAssertMsg(Textmerge([<<Proper(Program())>>() - au moins un paramètre invalide]))
  IF m.llResult

    * Tabuler les lignes
    ALines(taResult, m.tcTxt)

    RETURN aColsDelim(@m.taResult, m.tcSep, @m.tuTypes)
  ELSE
    RETURN 0
  ENDIF

  * -------------------------------------------------------------
  PROCEDURE aLinesCols_test && Teste aLinesCols()

  LOCAL loTest as abUnitTest OF abDev.prg, laLinesCols[1], lcTxt, laType[2]
  loTest = NewObject('abUnitTest''abDev.prg')
  TEXT TO lcTxt NOSHOW PRETEXT 1+2
    11  12
    21  22  23
    31  32  33  34  35
  ENDTEXT

  loTest.Test(3, @m.laLinesCols, m.lcTxt, TABUL)
  loTest.Assert(5, Alen(laLinesCols, 2))

  loTest.Test(3, @m.laLinesCols, m.lcTxt, , 'N')
  loTest.Assert(21, laLinesCols[2,1])
  loTest.Assert('22'laLinesCols[2,2])

  loTest.Test(3, @m.laLinesCols, m.lcTxt, , 'N,N')
  loTest.Assert(21, laLinesCols[2,1])
  loTest.Assert(22, laLinesCols[2,2])

  loTest.Test(3, @m.laLinesCols, m.lcTxt, , 'N|N')
  loTest.Assert(21, laLinesCols[2,1])
  loTest.Assert(22, laLinesCols[2,2])

  loTest.Test(3, @m.laLinesCols, m.lcTxt, , 'II')
  loTest.Assert(21, laLinesCols[2,1])
  loTest.Assert(22, laLinesCols[2,2])

  laType = 'I'
  loTest.Test(3, @m.laLinesCols, m.lcTxt, , @m.laType)
  loTest.Assert(21, laLinesCols[2,1])
  loTest.Assert(22, laLinesCols[2,2])

  loTest.Test(3, @m.laLinesCols, m.lcTxt, , Replicate('I', 6))
  loTest.Assert(21, laLinesCols[2,1])
  loTest.Assert(22, laLinesCols[2,2])
  loTest.Assert(0, laLinesCols[1,6]&& nombre de colonnes selon typage

  RETURN loTest.Result()
Commentaires
Aucun commentaire enregistré ...

Publicité

Les pubs en cours :

www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2018.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0