[Résolu] Pouvez-vous m'aider ?
-
- Messages : 2194
- Inscription : jeu. 27/janv./2005 19:07
Re: Pouvez-vous m'aider ?
Pour les diagonales inclinées "gauche-droite" il faut faire tourner la boucle jusqu'à
1-000000
2-111111
3-222222
4-333333
5-4444X4
6-55555X
La boucle For va de 0 à LongueurFichier-(LongueurLigne+2) au pas de LongueurLigne + 1
En admettant que les mots à trouver peuvent avoir 2 lettres minimum
0000001111112222223333334444X455555X
1-000000
2-111111
3-222222
4-333333
5-4444X4
6-55555X
La boucle For va de 0 à LongueurFichier-(LongueurLigne+2) au pas de LongueurLigne + 1
En admettant que les mots à trouver peuvent avoir 2 lettres minimum
0000001111112222223333334444X455555X
Re: Pouvez-vous m'aider ?
C'est bien ce que j'avais cru comprendre, je fais une boucle qui balaye ma chaîne de 0 à LongueurChaine, si elle ne trouve pas ma chaîne recherchée, elle passe au suivant, sinon, j'ajoute LongueurLigne+1 pour trouver l’occurrence suivante et je fais un Break si toute la chaîne recherchée est trouvée, ou si ma boucle + LongueurLigne+1 dépasse LongueurChaine. J'ai bien résumé ?
Mille remerciements pour m'avoir apporter vos lumières.
Mille remerciements pour m'avoir apporter vos lumières.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Un homme doit être poli, mais il doit aussi être libre !
Re: Pouvez-vous m'aider ?
J'ai encore un problème, quand je cherche
000000
X11111
2X2222
33X333
etc...
je trouve
0X0000
11X111
222X22
etc...
Comment pourrais-je faire, pour pouvoir remédier à ce problème
Je vous remercie énormément pour votre contribution.
000000
X11111
2X2222
33X333
etc...
je trouve
0X0000
11X111
222X22
etc...
Comment pourrais-je faire, pour pouvoir remédier à ce problème
Je vous remercie énormément pour votre contribution.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Un homme doit être poli, mais il doit aussi être libre !
Re: Pouvez-vous m'aider ?
Nous redonner du code...Micoute a écrit : Comment pourrais-je faire, pour pouvoir remédier à ce problème
Mais le soucis vient probablement d'une boucle.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Re: Pouvez-vous m'aider ?
Bien volontiers, je l'ai un peu modifié grâce aux indications de Dobro que je remercie spécialement, car ça m'a permis de supprimer les tableaux, le voici bien que pas achevé.
Merci de donner de votre temps, rien que pour moi.
Code : Tout sélectionner
Enumeration
#Fichier
#Droite
#Gauche
#Haut
#Bas
#DiagonaleDN ; descendante normale
#DiagonaleMN ; montante normale
#DiagonaleDI ; descendante inversée
#DiagonaleMI ; descendante inversée
EndEnumeration
Global NomFich$, *AdrFich.String, Fich$, Dir$, ChaineATrouver$, RCAT$, ChaineComplete$, RCC$, ChaineTrouvee$,Caractere$
Global.i LongFich, *IDMem, NbrLigFich, LongLigFich, LCC, Lig, Col, Rech1, Rech2, D, XD, YD, L, PosLig, PosCol, NonTrouve.b = 0
Declare Afficher()
Procedure ChercherChaine8Dir(ChaineATrouver.s)
ChaineATrouver$ = ChaineATrouver
RCAT$ = ReverseString(ChaineATrouver)
NomFich$ = OpenFileRequester("Veuillez sélectionner un fichier", "", "Fichiers Textes | *.txt", 0)
If NomFich$
If ReadFile(#Fichier, NomFich$)
LongFich = Lof(#Fichier)
*IDMem = AllocateMemory(LongFich)
If *IDMem
ReadData(#Fichier, *IDMem, LongFich)
*AdrFich = @*IDMem
Fich$ = *AdrFich\s
If Fich$ <> ""
NbrLigFich = CountString(Fich$, #CRLF$)
LongLigFich = Len(StringField(Fich$, 1, #CRLF$))
L = Len(ChaineATrouver$)
For i = 1 To LongFich
If Mid(Fich$, i, 1) > #CR$
ChaineComplete$ + Mid(Fich$, i, 1)
EndIf
Next
LCC = Len(ChaineComplete$)
CloseFile(#Fichier)
FreeMemory(*IDMem)
For Col = 1 To NbrLigFich
For lig = Col To LCC Step 6
RCC$ + Mid(ChaineComplete$, Lig,1)
Next Lig
Next Col
Else
MessageRequester("Attention", "Le fichier "+NomFich$+" n'a pas pu être chargé !", #MB_ICONEXCLAMATION)
EndIf
Else
MessageRequester("Erreur", "Impossible d'allouer "+Str(LongFich)+" octets !", #MB_ICONERROR)
EndIf
EndIf
EndIf
For Lig = 1 To LCC
ChaineTrouvee$ + Mid(ChaineComplete$, Lig)
Rech1 = FindString(ChaineTrouvee$, ChaineATrouver$)
Rech2 = FindString(ChaineTrouvee$, RCAT$)
If Rech1 ;- gauche à droite
If Mid(ChaineTrouvee$, FindString(ChaineTrouvee$,ChaineATrouver$), Len(ChaineATrouver$)) = ChaineATrouver$
D = #Droite
XD = Rech1
If Rech1 > LongLigFich
Repeat
XD - LongLigFich
Until XD <= LongLigFich
EndIf
YD = ((Rech1 + L)-1) / NbrLigFich
If YD = 0
YD = 1
EndIf
Afficher()
ChaineTrouvee$ = ""
Break
EndIf
ElseIf Rech2 ;- droite à gauche
ChaineTrouvee$ = ReverseString(ReverseString(ChaineATrouver$))
If ChaineTrouvee$ = ChaineATrouver$
D = #Gauche
XD = Rech2 + L -1
If XD > LongLigFich
Repeat
XD - LongLigFich
YD + 1
Until XD <= LongLigFich
EndIf
If XD = 0
XD + LongLigFich
EndIf
YD + 1
Afficher()
ChaineTrouvee$ = ""
Break
EndIf
Else
ChaineTrouvee$ = ""
ChaineTrouvee$ + Mid(RCC$, Lig)
Rech1 = FindString(ChaineTrouvee$, ChaineATrouver$)
Rech2 = FindString(ChaineTrouvee$, ReverseString(ChaineATrouver$))
If Rech1 ;- haut en bas
If Mid(ChaineTrouvee$, FindString(ChaineTrouvee$,ChaineATrouver$), Len(ChaineATrouver$)) = ChaineATrouver$
D = #Haut
YD = Rech1; -1
If YD > LongLigFich
Repeat
YD - LongLigFich
XD +1
Until YD <= LongLigFich
EndIf
If YD = 0
YD + 1
EndIf
XD+1
Afficher()
ChaineTrouvee$ = ""
Break
EndIf
ElseIf Rech2 ;- bas en haut
ChaineTrouvee$ = ReverseString(ReverseString(ChaineATrouver$))
If ChaineTrouvee$ = ChaineATrouver$
D = #Bas
YD =Rech2 + L - 1
If YD > LongLigFich
Repeat
YD - LongLigFich
XD+1
Until YD <= LongLigFich
EndIf
If YD = 0
YD + 1
EndIf
XD + 1
Afficher()
ChaineTrouvee$ = ""
Break
EndIf
EndIf ; vertical
EndIf ; horizontal
Next Lig
If D = 0
NonTrouve = 1
EndIf
;- diagonale descendante normale
If NonTrouve
ChaineTrouvee$ = ""
Y = 0
For Lig = 0 To LCC
;Debug Lig
ChaineTrouvee$ + Mid(ChaineComplete$,Lig+1,1)
Rech1 = FindString(ChaineATrouver$, ChaineTrouvee$)
Rech2 = FindString(RCAT$, ChaineTrouvee$)
If Rech1 And (Lig + LongLigFich) < LCC-1
Lig + LongLigFich
Y+1
z+1
ElseIf Rech2 And (Lig + LongLigFich) < LCC-1
Lig + LongLigFich
Y+1
z+1
ElseIf Rech1 = 0 And Rech2 = 0
If lig > LongLigFich*2
lig - LongLigFich*2 -2
EndIf
ChaineTrouvee$ = ""
Y = 0
EndIf
If ChaineTrouvee$ = ChaineATrouver$ Or ChaineTrouvee$ = RCAT$ Or Z > LCC
Break
EndIf
Next
If ChaineTrouvee$ <> "" And Rech1
D = #DiagonaleDN
XD = Mod(Lig, LongLigFich-1)+1
YD = Rech1
Afficher()
ChaineTrouvee$ = ""
;End
;- diagonale montante inversée
ElseIf ChaineTrouvee$ = ReverseString(ChaineATrouver$)
D = #DiagonaleMI
XD = Rech2
YD = 0
Afficher()
ChaineTrouvee$ = ""
;End
EndIf
;- diagonale montante normale
ChaineTrouvee$ = ""
Y = 0
For Lig = 0 To LCC
Debug Lig
ChaineTrouvee$ + Mid(RCC$,Lig+1,1)
If FindString(ChaineATrouver$, ChaineTrouvee$)
If repere = 0
repere = lig
EndIf
EndIf
Rech1 = FindString(ChaineATrouver$, ChaineTrouvee$)
Rech2 = FindString(RCAT$, ChaineTrouvee$)
If Rech1 And (Lig + LongLigFich) < LCC-1
Lig + LongLigFich
Y+1
z+1
ElseIf Rech2 And (Lig + LongLigFich) < LCC-1
Lig + LongLigFich
Y+1
z+1
ElseIf Rech1 = 0 And Rech2 = 0
ChaineTrouvee$ = ""
Y = 0
EndIf
If ChaineTrouvee$ = ChaineATrouver$ Or ChaineTrouvee$ = RCAT$ Or Z > LCC
Break
EndIf
Next
If ChaineTrouvee$ <> ""
D = #DiagonaleMN
XD= 0
YD = Rech1
Afficher()
ChaineTrouvee$ = ""
;End
ElseIf ChaineTrouvee$ = RCAT$
;- diagonale descendante inversée
D = #DiagonaleDI
XD = Rech2
YD = 0
Afficher()
EndIf
EndIf ;non trouvé
;CallDebugger
EndProcedure
Procedure Afficher()
Select D
Case #Droite
Dir$ = "de gauche à droite"
Case #Gauche
Dir$ = "de droite à gauche"
Case #Haut
Dir$ = "de haut en bas"
Case #Bas
Dir$ = "de bas en haut"
Case #DiagonaleDN
Dir$ = "diagonale descendante normale"
Case #DiagonaleMN
Dir$ = "diagonale montante normale"
Case #DiagonaleDI
Dir$ = "diagonale desendante inversée"
Case #DiagonaleMI
Dir$ = "diagonale montante inversée"
EndSelect
MessageRequester("Résultats", "Direction de recherche : "+Dir$+#CRLF$+"Position X : "+Str(XD)+#CRLF$+"Position Y : "+Str(YD)+#CRLF$+"Longueur de la chaine : "+Str(L)+#CRLF$+"Chaîne à trouver : "+ChaineATrouver$,#MB_ICONINFORMATION)
EndProcedure
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Un homme doit être poli, mais il doit aussi être libre !
Re: Pouvez-vous m'aider ?
et voila ma version
Code : Tout sélectionner
Declare recherchemot(mot$)
Declare hilight(pos,sens)
If OpenConsole()
EnableGraphicalConsole(1)
EndIf
Global chaine$="a0run0bt00e0iuo0e0v0a0n0ns00n0j000te00o0u000r0u0s0n00ur0000000p"
Global mot$ ; mot a rechercher
Global largeur=9
For y=1 To Len(chaine$)/largeur
For x=1 To largeur
ConsoleLocate(x,y)
Print( Mid(chaine$,x+((y-1)*largeur),1))
Next
Next
PrintN("")
PrintN("mots: oui,ver,run,bonjour,ajun,son,test,pure")
Print("entrez le mot a rechercher : ")
mot$=Input()
PrintN("")
PrintN("mot recherche :"+mot$)
PrintN("pressez une touche")
Input()
recherchemot(mot$)
Input()
Procedure recherchemot(mot$)
For sens=0 To 7
Select sens
Case 0; de gauche a droite
cmpmod=1
largeurmod=0
larg=1
Case 1; de droite a gauche
cmpmod=-1
largeurmod=0
larg=1
Case 2 ;en diagonale de la gauche vers la droite du haut vers le bas
cmpmod=1
largeurmod=1
larg=largeur
Case 3 ;en diagonale de la droite vers la gauche du haut vers le bas
cmpmod=1
largeurmod=-1
larg=largeur
Case 4 ; en diagonale de la gauche vers la droite du bas vers le haut
cmpmod=-1
largeurmod=-1
larg=largeur
Case 5 ; en diagonale de la droite vers la gauche du bas vers le haut
cmpmod=-1
largeurmod=1
larg=largeur
Case 6; vers le bas
cmpmod=1
largeurmod=0
larg=largeur
Case 7; vers le haut
cmpmod=1
largeurmod=0
larg=largeur*-1
EndSelect
For pos=1 To Len(chaine$)
If Mid(chaine$,pos,1)=Left(mot$,1) ; on a trouvé la première lettre
result=#True
For cmp=0 To Len(mot$)-1
If Mid(chaine$,pos+(cmp*cmpmod)*(larg+largeurmod),1)<>Mid(mot$,1+cmp,1)
result=#False
Break
EndIf
Next
If result=#True
hilight(pos,sens)
Break 2
EndIf
EndIf
Next
Next
EndProcedure
Procedure hilight(pos,sens)
Select sens
Case 0
xx=1
yy=0
Case 1
xx=-1
yy=0
Case 2
xx=1
yy=1
Case 3
xx=-1
yy=1
Case 4
xx=1
yy=-1
Case 5
xx=-1
yy=-1
Case 6
xx=0
yy=1
Case 7
xx=0
yy=-1
EndSelect
pos=pos-1
x=pos-(pos/largeur*largeur)
y=(pos-x)
y=y/largeur
For l=1 To Len(mot$)
ConsoleLocate(1+x,1+y)
ConsoleColor(10,0)
Print( Mid(mot$,l,1))
x+xx
y+yy
Next
EndProcedure
Re: Pouvez-vous m'aider ?
Je planche sur une je m'arrache les cheveux 

~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Re: Pouvez-vous m'aider ?
Case, elle est très bien ta version et en plus nous fait voir le mot recherché, et je pense qu'on peut l'adapter pour qu'il fonctionne avec un fichier chargé par l'utilisateur et dont on ne connait pas les dimensions. Merci.
Ar-s, merci beaucoup de chercher à m'aider.
Et merci aussi à tous ceux qui m'ont ou vont faire de même, car c'est vrai que c'est très complexe.
Ar-s, merci beaucoup de chercher à m'aider.
Et merci aussi à tous ceux qui m'ont ou vont faire de même, car c'est vrai que c'est très complexe.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Un homme doit être poli, mais il doit aussi être libre !
Re: Pouvez-vous m'aider ?
Ma version fonctionnelle pour tableau fixe.
4 x 4 pour l'exemple.
pour ton usage, il sera ensuite simple d'utiliser un fichier chargé en entrant les lignes dans une nouvelle liste.
(tableau() par exemple) plutôt que d'utiliser les t1 t2 t3...
A++
4 x 4 pour l'exemple.
Code : Tout sélectionner
; By Ar-S Juillet 2012
; recherche de mot en diagonale
Global NewList Phrase.s()
Global.s chaine, ChaineGB, chaineDH, chaineDB, ChaineGH, Direction
Declare.s ChercheMot(Mot.s)
#DB = 0
#DH = 1
#GB = 2
#GH = 3
; Notre tableau
t1.s = "t1t1"
t2.s = "1234"
t3.s = "3333"
t4.s = "ABCD"
; On met tout en majuscule pour éviter les erreurs
t1 = UCase(t1)
t2 = UCase(t2)
t3 = UCase(t3)
t4 = UCase(t4)
; ----------------------------
; PROCEDURE
; ----------------------------
Procedure.s ChercheMot(Mot.s)
DiagMot.s = ""
Mot = UCase(Mot)
Debug "Mot à trouver : " + Mot
; Recherche
ForEach Phrase()
For i = 1 To Len(Phrase()) Step 5
car.s = Mid(Phrase(),i,1)
DiagMot.s + car
Next
If DiagMot = Mot
Select ListIndex(Phrase())
Case #DB
Direction = " Droite Bas "
Case #DH
Direction = " Droite Haut "
Case #GB
Direction = " Gauche Bas "
Case #GH
Direction = " Gauche Haut "
EndSelect
ProcedureReturn DiagMot + " trouvé en diagonale "+ Direction
Else
DiagMot = ""
EndIf
Next
EndProcedure
; ----------------------------
; PROGRAMME
; ----------------------------
; ----------------------------
; CREATION DES LISTES
; ----------------------------
; En résumer c'est la chaine de départ que je modifie
chaine = t1+t2+t3+t4 ; "TOTO12343333ABCD"
AddElement(Phrase()) ;DB
Phrase() = chaine
AddElement(Phrase()) ; DH
Phrase() = t4+t3+t2+t1
AddElement(Phrase()) ; GB
Phrase() = ReverseString(t1) + ReverseString(t2) + ReverseString(t3) + ReverseString(t4)
AddElement(Phrase()) ; GH
Phrase() = ReverseString(t4) + ReverseString(t3) + ReverseString(t2) + ReverseString(t1)
; TEST
;
Debug ChercheMot("T23D") ; trouvable en DROIT BAS
Debug "----------------------------------"
Debug ChercheMot("A331") ; trouvable en DROIT HAUT
Debug "----------------------------------"
Debug ChercheMot("133A") ; trouvable en GAUCHE BAS
Debug "----------------------------------"
Debug ChercheMot("D32T") ; trouvable en GAUCHE HAUT
(tableau() par exemple) plutôt que d'utiliser les t1 t2 t3...
A++
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Re: Pouvez-vous m'aider ?
C'est très bien, mais on ne peut trouver que des mots de 4 caractères. Je ne voudrais paraître pointilleux, mais je souhaiterais qu'avec le programme, on puisse trouver des mots de 2 à LongueurLigne, donc pour les directions habituelles, gauche à droite, droite à gauche, haut en bas, bas en haut, pas de problème, mais les diagonales, j'échoue lamentablement.
Je pense que si j'arrive à en trouver une, les autres seront plus faciles, vu que j'aurai compris le principe.
Alors, s'il vous plait, je vous en supplie, pouvez-vous m'aider ?
Je suis sûr que oui et je vous en remercie énormément.
Je pense que si j'arrive à en trouver une, les autres seront plus faciles, vu que j'aurai compris le principe.
Alors, s'il vous plait, je vous en supplie, pouvez-vous m'aider ?
Je suis sûr que oui et je vous en remercie énormément.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Un homme doit être poli, mais il doit aussi être libre !
Re: Pouvez-vous m'aider ?
Il suffit de remplacer
par
Ce qui donne
Code : Tout sélectionner
;If DiagMot = Mot
Code : Tout sélectionner
;If FindString(DiagMot,Mot)
Code : Tout sélectionner
; By Ar-S Juillet 2012
; recherche de mot en diagonale
Global NewList Phrase.s()
Global.s chaine, ChaineGB, chaineDH, chaineDB, ChaineGH, Direction
Declare.s ChercheMot(Mot.s)
#DB = 0
#DH = 1
#GB = 2
#GH = 3
; Notre tableau
t1.s = "t1t1"
t2.s = "1234"
t3.s = "3333"
t4.s = "ABCD"
; On met tout en majuscule pour éviter les erreurs
t1 = UCase(t1)
t2 = UCase(t2)
t3 = UCase(t3)
t4 = UCase(t4)
; ----------------------------
; PROCEDURE
; ----------------------------
Procedure.s ChercheMot(Mot.s)
DiagMot.s = ""
Mot = UCase(Mot)
Debug "Mot à trouver : " + Mot
; Recherche
ForEach Phrase()
For i = 1 To Len(Phrase()) Step 5
car.s = Mid(Phrase(),i,1)
DiagMot.s + car
Next
If FindString(DiagMot,Mot)
;If DiagMot = Mot
Select ListIndex(Phrase())
Case #DB
Direction = " Droite Bas "
Case #DH
Direction = " Droite Haut "
Case #GB
Direction = " Gauche Bas "
Case #GH
Direction = " Gauche Haut "
EndSelect
ProcedureReturn Mot + " trouvé en diagonale "+ Direction
Else
DiagMot = ""
EndIf
Next
EndProcedure
; ----------------------------
; PROGRAMME
; ----------------------------
; ----------------------------
; CREATION DES LISTES
; ----------------------------
; En résumer c'est la chaine de départ que je modifie
chaine = t1+t2+t3+t4 ; "TOTO12343333ABCD"
AddElement(Phrase()) ;DB
Phrase() = chaine
AddElement(Phrase()) ; DH
Phrase() = t4+t3+t2+t1
AddElement(Phrase()) ; GB
Phrase() = ReverseString(t1) + ReverseString(t2) + ReverseString(t3) + ReverseString(t4)
AddElement(Phrase()) ; GH
Phrase() = ReverseString(t4) + ReverseString(t3) + ReverseString(t2) + ReverseString(t1)
; TEST
;
Debug ChercheMot("T23") ; trouvable en DROIT BAS
Debug "----------------------------------"
Debug ChercheMot("A331") ; trouvable en DROIT HAUT
Debug "----------------------------------"
Debug ChercheMot("133A") ; trouvable en GAUCHE BAS
Debug "----------------------------------"
Debug ChercheMot("32") ; trouvable en GAUCHE HAUT
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Re: Pouvez-vous m'aider ?
Oh merci ô mon bon maître, ça c'est de la balle, si avec toutes ces combines, je n'y arrive pas, il vaudrait mieux que j'arrête la programmation.
Et encore merci à tous, je suis vraiment fier de faire partie de ce forum, et merci à Fred pour son langage qui nous a rassemblés.
Je vous enverrai ma version finale, ça pourra peut-être servir à quelqu'un.
Et encore merci à tous, je suis vraiment fier de faire partie de ce forum, et merci à Fred pour son langage qui nous a rassemblés.
Je vous enverrai ma version finale, ça pourra peut-être servir à quelqu'un.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Un homme doit être poli, mais il doit aussi être libre !
Re: Pouvez-vous m'aider ?
Comme promis, je poste la version que j'ai retenue, c'est celle de Case à qui je dois tout ma gratitude, mais je remercie aussi tous les autres, sans citer tout le monde.
Code : Tout sélectionner
Declare recherchemot(ChaineATrouver$)
Declare hilight(pos,sens)
#Fichier = 0
Global.i LongFich, LongLigFich, NbrLigFich, *IDMem, X, Y
Global NomFich$, *AdrFich.String, Fich$, ChaineComplete$, ChaineATrouver$
Procedure ChargerFichier8Dir()
NomFich$ = OpenFileRequester("Veuillez sélectionner un fichier", "", "Fichiers Textes | *.txt", 0)
If NomFich$
If ReadFile(#Fichier, NomFich$)
LongFich = Lof(#Fichier)
*IDMem = AllocateMemory(LongFich)
If *IDMem
ReadData(#Fichier, *IDMem, LongFich)
*AdrFich.String = @*IDMem
Fich$ = *AdrFich\s
If Fich$ <> ""
NbrLigFich = CountString(Fich$, #CRLF$)
LongLigFich = Len(StringField(Fich$, 1, #CRLF$))
CloseFile(#Fichier)
FreeMemory(*IDMem)
Else
MessageRequester("Attention", "Le fichier "+NomFich$+" n'a pas pu être chargé !", #MB_ICONEXCLAMATION)
EndIf
Else
MessageRequester("Erreur", "Impossible d'allouer "+Str(LongFich)+" octets !", #MB_ICONERROR)
EndIf
EndIf
EndIf
EndProcedure
If OpenConsole()
EnableGraphicalConsole(1)
EndIf
ChargerFichier8Dir()
For i = 1 To LongFich
If Mid(Fich$, i, 1) > #CR$
ChaineComplete$ + Mid(Fich$, i, 1)
EndIf
Next
For y=1 To Len(ChaineComplete$)/LongLigFich
For x=1 To LongLigFich
ConsoleLocate(x,y)
Print( Mid(ChaineComplete$,x+((y-1) * LongLigFich),1))
Next
Next
PrintN("")
PrintN("")
Print("entrez le mot a rechercher : ")
ChaineATrouver$=Input()
PrintN("")
PrintN("mot recherche :"+ChaineATrouver$)
PrintN("pressez une touche")
Input()
recherchemot(ChaineATrouver$)
Input()
Procedure recherchemot(ChaineATrouver$)
For sens=0 To 7
Select sens
Case 0; de gauche a droite
cmpmod=1
largeurmod=0
larg=1
Case 1; de droite a gauche
cmpmod=-1
largeurmod=0
larg=1
Case 2 ;en diagonale de la gauche vers la droite du haut vers le bas
cmpmod=1
largeurmod=1
larg=LongLigFich
Case 3 ;en diagonale de la droite vers la gauche du haut vers le bas
cmpmod=1
largeurmod=-1
larg=LongLigFich
Case 4 ; en diagonale de la gauche vers la droite du bas vers le haut
cmpmod=-1
largeurmod=-1
larg=LongLigFich
Case 5 ; en diagonale de la droite vers la gauche du bas vers le haut
cmpmod=-1
largeurmod=1
larg=LongLigFich
Case 6; vers le bas
cmpmod=1
largeurmod=0
larg=LongLigFich
Case 7; vers le haut
cmpmod=1
largeurmod=0
larg=LongLigFich*-1
EndSelect
For pos=1 To Len(ChaineComplete$)
If Mid(ChaineComplete$,pos,1)=Left(ChaineATrouver$,1) ; on a trouvé la première lettre
result=#True
For cmp=0 To Len(ChaineATrouver$)-1
If Mid(ChaineComplete$,pos+(cmp*cmpmod)*(larg+largeurmod),1)<>Mid(ChaineATrouver$,1+cmp,1)
result=#False
Break
EndIf
Next
If result=#True
hilight(pos,sens)
Break 2
EndIf
EndIf
Next
Next
EndProcedure
Procedure hilight(pos,sens)
Select sens
Case 0
xx=1
yy=0
Case 1
xx=-1
yy=0
Case 2
xx=1
yy=1
Case 3
xx=-1
yy=1
Case 4
xx=1
yy=-1
Case 5
xx=-1
yy=-1
Case 6
xx=0
yy=1
Case 7
xx=0
yy=-1
EndSelect
pos=pos-1
x=pos-(pos/LongLigFich*LongLigFich)
y=(pos-x)
y=y/LongLigFich
For l=1 To Len(ChaineATrouver$)
ConsoleLocate(1+x,1+y)
ConsoleColor(10,0)
Print( Mid(ChaineATrouver$,l,1))
x+xx
y+yy
Next
EndProcedure
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Un homme doit être poli, mais il doit aussi être libre !