Cominciamo questa lezione correggendo quella precedente: nella routine cmdTrova_Click era infti nascosto (anzi, era abbastanza evidente) un bug di cui avreste dovuto accorgervi: la parte di codice destina a cercare l'ultimo testo puro in realtà non trova l'ultimo, ma quello successivo al primo. La correzione è molto semplice:
'ultimo testo "puro"
lFine = Len(txtTrova.Text)
Do While Mid$(txtTrova.Text, lFine, 1) Like "[*?#]" And lFine > 1
lFine = lFine - 1
Loop
lInizio = IIf(lFine > 1, lFine, 2)
Do
lInizio = lInizio - 1
Loop Until Mid$(txtTrova.Text, lInizio, 1) Like "[*?#]" Or lInizio <= 1
If Mid$(txtTrova.Text, lInizio, 1) Like "[*?#]" Then
sTestoPuro(1) = Mid$(txtTrova.Text, lInizio + 1, lFine - lInizio)
Else
sTestoPuro(1) = Mid$(txtTrova.Text, lInizio, lFine - lInizio + 1)
End If
La soluzione consiste nuralmente nel partire "dal fondo" e risalire all'indietro la stringa alla ricerca di un cartere jolly che delimiti l'ultimo testo puro: la ricerca giunge sino all'inizio della stringa se occorre, e a tal fine è sta inserita la condizione "and lFine>1" nel primo loop; se infti l'utente cerca solo carteri jolly, lFine arriverebbe fino a zero generando un errore nella funzione Mid$(); per lo stesso motivo la variabile lInizio è inizializza a 2 se lFine è uguale a 1. Quando lFine=1, alla fine del secondo loop anche lInizio è uguale a 1, così che sTestoPuro(1) diventa la stringa vuota. La If finale serve a distinguere il caso in cui c'è un solo testo puro: in tal caso la ricerca si ferma quando lInizio=1 e per estrarre correttamente il testo puro occorre capire se il primo cartere è un cartere jolly (quindi il testo puro parte dal secondo cartere) oppure no (quindi il testo puro parte dal primo cartere); se invece la ricerca si ferma prima (ovvero dopo il primo cartere, do che si parte dal fondo) significa che essa è termina perché abbiamo incontro un cartere jolly: non ci sarebbe bisogno di eseguire la If, ma per evitarlo avremmo dovuto introdurre un ulteriore controllo sul valore di lInizio (If lInizio=1 then …).
La nostra routine trova sempre il primo e l'ultimo testo puro, anche nel caso in cui questi coincidono (ad es. quando l'utente vuole cercare "?pippo#" o semplicemente "pippo"): se ciò si verifica, per evitare problemi nella ricerca del testo è opportuno impostare l'ultimo testo puro alla stringa nulla, in modo da essere consapevoli che di testo puro effettivamente ce n'è uno solo:
If InStr(1, txtTrova.Text, sTestoPuro(0), vbBinaryCompare) = _
InStrRev(txtTrova.Text, sTestoPuro(1), , vbBinaryCompare) Then
'il primo e l'ultimo testo puro coincidono
sTestoPuro(1) = ""
End If
Per verificare la coincidenza dei due testi non basta che siano uguali (l'utente potrebbe cercare, ad es., "pippo*pippo"): condizione necessaria e sufficiente affinché i due testi siano coincidenti è che la loro posizione all'interno della stringa inserita dall'utente sia la stessa; il primo testo lo cerchiamo a partire dall'inizio della stringa con la funzione InStr, l'ultimo lo cerchiamo a partire dal fondo con la funzione InStrRev: se le due posizioni sono uguali, i due testi coincidono.
Fto ciò, potremmo cominciare a cercare il testo, ma non abbiamo ancora considero il caso in cui il primo e l'ultimo testo puro sia rispettivamente preceduto o seguito da carteri jolly; in tal caso occorre infti verificare se l'utente cerca anche una cifra oppure no. Gli asterischi, potendo rappresentare anche zero carteri, non influiscono concretamente sulla ricerca; i punti di domanda non danno indicazioni su quale cartere cercare, pertanto basta verificare che ci siano tanti carteri quanti sono i punti di domanda specifici nella stringa da cercare. Invece i cancelletti rappresentano una cifra, e non possono essere liquidi tanto facilmente: la cosa più conveniente è trtarli come se fossero "testo puro": quindi se l'utente specifica, ad es., "??*#pippo*?piero##", anziché limitarsi a trovare "pippo" e "piero" occorre trovare un "pippo" preceduto da una cifra e un "piero" seguito da due cifre. In realtà, le cose sono un po' più semplici: basta cercare due cifre all'interno del testo, assicurarsi che la prima cifra sia preceduta da almeno due carteri, e confrontare l'intero testo contenuto tra questi limiti con la stringa cerca dall'utente: l'operore like ci dirà se i due testi corrispondono oppure no.
Utilizziamo un vettore lCifra(1) per indicare quanti carteri devono precedere la prima cifra e quanti devono seguire l'ultima: nell'esempio, lCifra(0) sarebbe uguale a 2 mentre lCifra(1)=0; si trta del minimo numero di carteri per soddisfare la sequenza cerca dall'utente, in realtà la prima cifra potrebbe essere preceduta anche da 10 carteri o l'ultima seguita da 10 carteri. Specifichiamo il valore -1 per indicare che non dobbiamo cercare cifre: ad es. nel caso "?pippo*piero*#" sarebbe lCifra(0)= -1, lCifra(1)=0.
Analogamente, utilizziamo un vettore lCartere(1) per indicare quanti carteri devono precedere il testo puro iniziale o seguire il testo puro finale: questa informazione ci servirà solo nel caso in cui la stringa da cercare non contenga numeri, ovvero carteri "#". In un caso come "?pippo#", sarà lCifra(0)=-1, lCifra(1)=0, lCartere(0)=1, lCartere(0)=0; se non usassimo lCartere, non potremmo sapere che prima di "pippo" ci deve essere almeno un cartere, anche se non è una cifra; lCartere(1) non sarà utilizzo in quanto già lCifra(1) ci dà tutte le informazioni necessarie.
Ora possiamo cercare il testo. L'algoritmo è relivamente semplice: se il primo testo puro è preceduto da una cifra, cerchiamo una cifra, altrimenti cerchiamo il testo puro iniziale; una volta trovo, cerchiamo da quel punto in poi il testo puro finale o la cifra che lo deve seguire. A questo punto confrontiamo il testo contenuto tra gli estremi iniziale e finale e lo confrontiamo con la stringa definita dall'utente: se l'esito è negivo, continuiamo la ricerca del testo puro finale o della cifra finale, ricorsivamente, fino alla fine del file. Se invece l'esito è positivo, evidenziamo il testo trovo e ci prepariamo a un'ulteriore ricerca.
lInizio = 0: lFine = 0
lTipoRicerca = IIf(chkCaseSens.Value = vbChecked, _
vbBinaryCompare, vbTextCompare)
With frmNotePad.txtFile
Do
If lCifra(0) >= 0 Then
'cerca la prima cifra
Do
lInizio = lInizio + 1
Loop Until Mid$(.Text, lInizio, 1) _
Like "#" Or lInizio > Len(.Text)
If lInizio > Len(.Text) Then
lInizio = 0
Else
lFine = lInizio
End If
Else
If Len(sTestoPuro(0)) Then
'cerca il testo puro iniziale
lInizio = InStr(lInizio + 1, .Text, sTestoPuro(0), lTipoRicerca)
End If
lFine = lInizio + Len(sTestoPuro(0))-1
End If
If lInizio Then
Do
If lCifra(1) >= 0 Then
'cerca l'ultima cifra
Do
lFine = lFine + 1
Loop Until Mid$(.Text, lFine, 1) Like "#" Or lFine > Len(.Text)
If lFine > Len(.Text) Then lFine = 0
Else
LFine = lFine+1
'cerca il testo puro finale
If Len(sTestoPuro(1)) Then
lFine = InStr(lInizio + 1, .Text, sTestoPuro(1), lTipoRicerca)
End If
End If
If lFine = 0 Then
Exit Do
Else
lInizioTemp = lInizio - IIf(lCifra(0) < 0, IIf(lCartere(0) < 0, _
0, lCartere(0)), lCifra(0))
If lCifra(1) >= 0 Then
lFineTemp = lFine + lCifra(1)
Else
lFineTemp = lFine + Len(sTestoPuro(1)) + IIf(lCartere(1) < 0, _
0, lCartere(1)) - 1
End If
End If
DoEvents
sTestoTrovo = Mid$(.Text, lInizioTemp, lFineTemp - lInizioTemp+1)
Loop Until IIf(lTipoRicerca = vbBinaryCompare, _
(sTestoTrovo Like txtTrova.Text), _
UCase$(sTestoTrovo) Like UCase$(txtTrova.Text))
If lFine Then
.SelStart = lInizioTemp - 1
.SelLength = lFineTemp - lInizioTemp+1
End If
Else
'cifra o testo iniziale non trovi
MsgBox "Testo non trovo", vbOKOnly + vbExclamion, App.Title
End If
Loop While (lFine = 0) And (lInizio < Len(.Text))
End With
Prima di tutto inizializziamo i due contori lInizio e lFine, poi per comodità memorizziamo in lTipoRicerca se la ricerca deve essere case sensitive oppure no; dopo aver cerco la prima cifra o il primo testo puro, parte un ciclo per la ricerca dell'ultima cifra o dell'ultimo testo puro: se il testo non viene trovo, la variabile lFine è posta a 0 e il ciclo termina. Altrimenti gli estremi iniziali e finali del testo vengono aggiusti per tener conto dei carteri identifici dai punti di domanda nella stringa specifica dall'utente; dopodiché, l'operore like ci dice se il testo corrisponde a quello cerco oppure no: in quest'ultimo caso, la ricerca continua a partire dal punto in cui siamo arrivi. Se invece il testo corrisponde, esso viene evidenzio nella finestra frmNotePad. Se il testo non viene trovo per tutto il file, viene visualizzo un messaggio di errore: la proprietà App.Title indica il titolo dell'applicazione (si imposta tramite le proprietà del progetto, nella scheda "crea"). Nella routine ci sono due loop annidi, che idealmente hanno il compito di cercare il testo puro iniziale (il loop esterno) e quello finale (il loop interno); essi corrispondono a questa logica:
1) se c'è un testo puro iniziale, lo cerco: se lo trovo, passo al punto 2, altrimenti genero un errore;
2) se c'è un testo puro finale, lo cerco: se lo trovo, passo al punto 3, altrimenti torno al punto 1 cercando il successivo testo puro iniziale;
3) se il testo contenuto tra i due testi puri corrisponde a quello cerco dall'utente, lo seleziono; altrimenti torno al punto 2 e cerco il successivo testo puro finale
Detto in altri termini, prima cerco il testo puro iniziale: se lo trovo, procedo da quel punto in poi cercando il testo puro finale finché trovo un testo che globalmente corrisponda a quello cerco dall'utente (loop interno); se non lo trovo, torno all'inizio (loop esterno) e cerco il testo puro iniziale successivo a quello trovo nell'iterazione precedente, dopodiché ricomincio la ricerca del testo puro finale, a partire dalla posizione del testo puro iniziale appena trovo. L'errore "testo non trovo" viene perciò genero solo quando non trovo più un testo puro iniziale entro la fine del file, altrimenti devo continuare la ricerca del testo puro finale. Questa situazione è controlla dalla condizione del loop esterno: (lFine = 0) And (lInizio < Len(.Text)); se non ho trovo un testo puro finale (lFine=0) e se non ho ancora cerco per tutto il file (lInizio
Per verificare la congruenza del testo trovo con quello cerco dall'utente, l'operore Like viene utilizzo in due modalità diverse a seconda che la ricerca sia case sensitive oppure no: se vi ricorde, nella lezione scorsa avevo indico l'opportunità di specificare l'istruzione Option Compare Binary nel form frmTrova; pertanto, se la ricerca è case sensitive è sufficiente usare l'operore like, ma se la ricerca non è case sensitive, occorre ignorare la specifica Option Compare Binary usando la funzione Ucase$(); ecco perché la condizione del loop interno dipende dall'istruzione IIf(lTipoRicerca=vbBinaryCompare…).
L'istruzione With…End With indica che all'interno del blocco è "sottinteso" l'oggetto frmNotePad.txtFile: è un modo per rendere più chiaro e leggibile il codice e per rendere più veloce il riferimento alle proprietà di quell'oggetto.
La routine appena vista consente di cercare il testo dall'inizio del file, il che significa che premendo più volte il pulsante "trova", la stringa trova sarà sempre la stessa, la prima dall'inizio del file; per fare in modo che si possano cercare anche le successive occorrenze del testo, basta fare una semplicissima modifica: anziché inizializzare lInizio a zero, bisogna inizializzarlo alla posizione corrente del cursore nel file. Questa posizione è da dalle proprietà SelStart e SelLength dell'oggetto TextBox, che indicano rispettivamente il numero del cartere iniziale del testo seleziono e il numero di carteri selezioni: se ad es. nel testo "pippo e topolino" seleziono "po e to", risulterà SelStart=3 e SelLength=7; infti SelStart inizia a contare da zero, nel senso che quando il cursore è proprio all'inizio del file aperto (prima della prima lettera), SelStart vale zero. Tornando al nostro algoritmo, basta modificare la prima riga in questo modo :
With frmNotePad.txtFile
lInizio = .SelStart + .SelLength: lFine = 0
…
La riga di inizializzazione è sta porta all'interno del blocco With per comodità; lInizio è inizializzo alla posizione finale della selezione, se esiste un testo seleziono: questo perché l'algoritmo, quando trova il testo cerco dall'utente, lo seleziona. Se facessimo semplicemente lInizio=.SelStart, la ricerca partirebbe dal primo cartere della selezione, e quindi troverebbe ancora il testo già seleziono, e non quello successivo: in altre parole non avremmo risolto il nostro problema. Se fe qualche prova vi accorgerete che anche il vero blocco note e word funzionano allo stesso modo.
In conclusione, la nostra routine cmdTrova_Click, è la seguente:
Public Sub cmdTrova_Click()
Dim lTipoRicerca As Long
Dim lCifra(1) As Long
Dim lCartere(1) As Long
Dim lInizio As Long
Dim lFine As Long
Dim lInizioTemp As Long
Dim lFineTemp As Long
Dim sTestoPuro(1) As String
Dim sTestoTrovo As String
lInizio = 0: lFine = 0
Erase sTestoPuro
Erase lCifra
cmdTrova.Enabled = False
cmdChiudi.Enabled = False
Me.MousePointer = vbHourglass
Do
lInizio = lInizio + 1
Loop While Mid$(txtTrova.Text, lInizio, 1) = "*"
lFine = Len(txtTrova.Text)
Do While Mid$(txtTrova.Text, lFine, 1) = "*"
lFine = lFine - 1
Loop
txtTrova.Text = Mid$(txtTrova.Text, lInizio, lFine - lInizio + 1)
'primo testo "puro"
lInizio = 0
Do
lInizio = lInizio + 1
Loop While Mid$(txtTrova.Text, lInizio, 1) Like "[*?#]"
lFine = lInizio
Do
lFine = lFine + 1
Loop Until Mid$(txtTrova.Text, lFine, 1) _
Like "[*?#]" Or lFine > Len(txtTrova.Text)
sTestoPuro(0) = Mid$(txtTrova.Text, lInizio, lFine - lInizio)
lCifra(0) = InStr(1, Replace(Left$(txtTrova.Text, _
lInizio - 1), "*", ""), "#") - 1
lCartere(0) = InStr(1, Replace(txtTrova.Text, _
"*", ""), sTestoPuro(0)) - 1
'ultimo testo "puro"
lFine = Len(txtTrova.Text)
Do While Mid$(txtTrova.Text, lFine, 1) _
Like "[*?#]" And lFine > 1
lFine = lFine - 1
Loop
lInizio = IIf(lFine > 1, lFine, 2)
Do
lInizio = lInizio - 1
Loop Until Mid$(txtTrova.Text, lInizio, 1) Like "[*?#]" Or lInizio <= 1
If Mid$(txtTrova.Text, lInizio, 1) Like "[*?#]" Then
sTestoPuro(1) = Mid$(txtTrova.Text, lInizio + 1, lFine - lInizio)
Else
sTestoPuro(1) = Mid$(txtTrova.Text, lInizio, lFine - lInizio + 1)
End If
lCifra(1) = Len(Replace(Mid$(txtTrova.Text, lFine + 1), "*", "")) - _
InStrRev(Replace(Mid$(txtTrova.Text, lFine + 1), "*", ""), "#")
If lCifra(1) = Len(Replace(Mid$(txtTrova.Text, lFine + 1), "*", "")) Then
lCifra(1) = -1
End If
lCartere(1) = Len(Replace(txtTrova.Text, "*", "")) - _
InStrRev(Replace(txtTrova.Text, "*", ""), sTestoPuro(1)) - Len(sTestoPuro(1))
If InStr(1, txtTrova.Text, sTestoPuro(0), vbBinaryCompare) = _
InStrRev(txtTrova.Text, sTestoPuro(1), , vbBinaryCompare) Then
'il primo e l'ultimo testo puro coincidono
sTestoPuro(1) = ""
End If
With frmNotePad.txtFile
lInizio = .SelStart + .SelLength: lFine = 0
lTipoRicerca = IIf(chkCaseSens.Value = vbChecked, _
vbBinaryCompare, vbTextCompare)
Do
If lCifra(0) >= 0 Then
'cerca la prima cifra
Do
lInizio = lInizio + 1
Loop Until Mid$(.Text, lInizio, 1) _
Like "#" Or lInizio > Len(.Text)
If lInizio > Len(.Text) Then
lInizio = 0
Else
lFine = lInizio
End If
Else
If Len(sTestoPuro(0)) Then
'cerca il testo puro iniziale
lInizio = InStr(lInizio + 1, _
.Text, sTestoPuro(0), lTipoRicerca)
End If
lFine = lInizio + Len(sTestoPuro(0)) - 1
End If
If lInizio Then
Do
If lCifra(1) >= 0 Then
'cerca l'ultima cifra
Do
lFine = lFine + 1
Loop Until Mid$(.Text, lFine, 1) Like "#" Or _
lFine > Len(.Text)
If lFine > Len(.Text) Then lFine = 0
Else
lFine = lFine + 1
'cerca il testo puro finale
If Len(sTestoPuro(1)) Then
lFine = InStr(lInizio + 1, _
.Text, sTestoPuro(1), lTipoRicerca)
End If
End If
If lFine = 0 Then
Exit Do
Else
lInizioTemp = lInizio - IIf(lCifra(0) < 0, _
IIf(lCartere(0) < 0, 0, lCartere(0)), lCifra(0))
If lCifra(1) >= 0 Then
lFineTemp = lFine + lCifra(1)
Else
lFineTemp = lFine + Len(sTestoPuro(1)) + _
IIf(lCartere(1) < 0, 0, lCartere(1)) - 1
End If
End If
DoEvents
sTestoTrovo = Mid$(.Text, lInizioTemp, _
lFineTemp - lInizioTemp + 1)
Loop Until IIf(lTipoRicerca = vbBinaryCompare, _
(sTestoTrovo Like txtTrova.Text), _
UCase$(sTestoTrovo) Like UCase$(txtTrova.Text))
If lFine Then
.SelStart = lInizioTemp - 1
.SelLength = lFineTemp - lInizioTemp + 1
End If
Else
'cifra o testo iniziale non trovi
MsgBox "Testo non trovo", vbOKOnly + vbExclamion, App.Title
End If
Loop While (lFine = 0) And (lInizio < Len(.Text))
End With
cmdTrova.Enabled = True
cmdChiudi.Enabled = True
Me.MousePointer = vbDefault
txtTrova.SetFocus
End Sub
Restano ancora da definire un paio di dettagli: sfruttare gli optionbutton OptSu, OptGiu, OptTutto, e permettere la ricerca dei carteri usi come jolly; intendo dire proprio i carteri "#", "?" e "*", e non il testo che essi, in quanto carteri jolly, rappresentano. Se l'utente, specificando ad es. "pippo*", volesse cercare proprio "pippo*" e non "pippo" seguito da un qualunque numero di carteri? La nostra routine non glielo consentirebbe. Nella prossima lezione vedremo come risolvere il problema.
Note sul corso:
I diritti di ognuna delle lezioni presente in queste pagine appartengono all'autore Giorgio Abraini. La riproduzione e la divulgazione delle stesse sono consentite solamente dietro citazione di fonte ed autore.
Per suggerimenti, consigli o richieste conttare giorgio102@libero.it.
Fonte : VBItalia.it