[Résolu] Pouvez-vous m'aider ?

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Re: Pouvez-vous m'aider ?

Message par Frenchy Pilou »

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
Est beau ce qui plaît sans concept :)
Speedy Galerie
Avatar de l’utilisateur
Micoute
Messages : 2583
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Pouvez-vous m'aider ?

Message par Micoute »

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.
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 !
Avatar de l’utilisateur
Micoute
Messages : 2583
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Pouvez-vous m'aider ?

Message par Micoute »

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.
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 !
Avatar de l’utilisateur
Ar-S
Messages : 9539
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Pouvez-vous m'aider ?

Message par Ar-S »

Micoute a écrit : Comment pourrais-je faire, pour pouvoir remédier à ce problème
Nous redonner du code...
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
Avatar de l’utilisateur
Micoute
Messages : 2583
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Pouvez-vous m'aider ?

Message par Micoute »

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é.

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
Merci de donner de votre temps, rien que pour moi.
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 !
Avatar de l’utilisateur
case
Messages : 1545
Inscription : lun. 10/sept./2007 11:13

Re: Pouvez-vous m'aider ?

Message par case »

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


ImageImage
Avatar de l’utilisateur
Ar-S
Messages : 9539
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Pouvez-vous m'aider ?

Message par Ar-S »

Je planche sur une je m'arrache les cheveux :mrgreen:
~~~~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
Avatar de l’utilisateur
Micoute
Messages : 2583
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Pouvez-vous m'aider ?

Message par Micoute »

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.
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 !
Avatar de l’utilisateur
Ar-S
Messages : 9539
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Pouvez-vous m'aider ?

Message par Ar-S »

Ma version fonctionnelle pour tableau fixe.
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
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++
~~~~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
Avatar de l’utilisateur
Micoute
Messages : 2583
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Pouvez-vous m'aider ?

Message par Micoute »

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.
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 !
Avatar de l’utilisateur
Ar-S
Messages : 9539
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Pouvez-vous m'aider ?

Message par Ar-S »

Il suffit de remplacer

Code : Tout sélectionner

      ;If DiagMot = Mot
par

Code : Tout sélectionner

    ;If FindString(DiagMot,Mot)
Ce qui donne

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
Avatar de l’utilisateur
Micoute
Messages : 2583
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Pouvez-vous m'aider ?

Message par Micoute »

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.
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 !
Avatar de l’utilisateur
Micoute
Messages : 2583
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Pouvez-vous m'aider ?

Message par Micoute »

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 !
Répondre