VLOG

VB6 - Binary search ou procura binária

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