* 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()
|
Retour à la liste
France
Fiche personnelle
Note des membres
Le téléchargement des pièces jointes est limité aux membres