Para quem estava procurando a "procura binária" em Visual Basic 6, está aqui, bonitinha!!!
Para testar esse código, basta criar um "form" com qualquer nome, inserir um text com o nome "txtExibeAlgoritmo" com a propriedade "multiline" igual a "true", outro com o nome "txtNum" e um commandbutton com o nome "cmdProcura"!!! Após isso, execute o programa e digite um número que queira procurar no campo "txtNum", os resultados da busca binária serão exibidos no text "txtExibeAlgoritmo"!!! Após configurar seu "form", copie e cole o código abaixo!!! Enjoy!!!
Option Explicit
Dim aLista() As Integer
Private Sub cmdProcura_Click()
Call sbLimpar
If IsNumeric(txtNum.Text) Then
If CInt(txtNum.Text) > 10 And CInt(txtNum.Text) <>
txtExibeAlgoritmo.Text = "Não é um número válido"
Else
Call fcBinarySearch(aLista(), CInt(txtNum.Text), 0, 9)
End If
Else
txtExibeAlgoritmo.Text = "Não é um número válido"
End If
End Sub
Private Sub Form_Load()
ReDim aLista(9)
aLista(0) = 1
aLista(1) = 2
aLista(2) = 3
aLista(3) = 4
aLista(4) = 5
aLista(5) = 6
aLista(6) = 7
aLista(7) = 8
aLista(8) = 9
aLista(9) = 10
Call sbLimpar
End Sub
Private Sub sbLimpar()
txtExibeAlgoritmo.Text = "aLista(0) = 1" & vbCrLf
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "aLista(1) = 2" & vbCrLf
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "aLista(2) = 3" & vbCrLf
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "aLista(3) = 4" & vbCrLf
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "aLista(4) = 5" & vbCrLf
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "aLista(5) = 6" & vbCrLf
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "aLista(6) = 7" & vbCrLf
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "aLista(7) = 8" & vbCrLf
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "aLista(8) = 9" & vbCrLf
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "aLista(9) = 10" & vbCrLf & vbCrLf
End Sub
Private Function fcBinarySearch(aLista() As Integer, iValue As Integer, iPosEsq As Integer, iPosDir As Integer) As Integer
Dim iMeio As Integer
If txtExibeAlgoritmo.Text <> "" Then txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & vbCrLf
If iPosEsq > iPosDir Then
'Nesse caso o número não está no array
txtExibeAlgoritmo.Text = "Não encontrei o número."
Exit Function
Else
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "Esquerda = " & iPosEsq & " Direita = " & iPosDir & vbCrLf
'Pega a posição central
iMeio = (iPosEsq + iPosDir) / 2
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "Meio = " & iMeio & vbCrLf
If aLista(iMeio) = iValue Then
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "A posição do número é " & iMeio & vbCrLf
fcBinarySearch = iMeio
ElseIf aLista(iMeio) > iValue Then
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "aLista(" & iMeio & ")=" & aLista(iMeio) & " é maior que o valor " & iValue & vbCrLf
'Se for maior que a posição do meio
Call fcBinarySearch(aLista(), iValue, iPosEsq, iMeio - 1)
Else
txtExibeAlgoritmo.Text = txtExibeAlgoritmo.Text & "aLista(" & iMeio & ")=" & aLista(iMeio) & " é menor que o valor " & iValue & vbCrLf
'Se for menor que a posição do meio
Call fcBinarySearch(aLista(), iValue, iMeio + 1, iPosDir)
End If
End If
End Function
Nenhum comentário:
Postar um comentário