'***************************************************************************
'* Copyright (C) 2007 by Veronese Alberto *
'*
'* *
'* This program is free software; you can redistribute it and/or modify *
'* it under the terms of the GNU General Public License as published by *
'* the Free Software Foundation; either version 2 of the License, or *
'* (at your option) any later version. *
'* *
'* This program is distributed in the hope that it will be useful, *
'* but WITHOUT ANY WARRANTY; without even the implied warranty of *
'* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
'* GNU General Public License for more details. *
'* *
'* You should have received a copy of the GNU General Public License *
'* along with this program; if not, write to the *
'* Free Software Foundation, Inc., *
'* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
'***************************************************************************
Const n = 14
Dim v(0 To n) As Integer
Dim num As Integer
Dim i As Integer, j As Integer, temp As Integer
Dim item As Integer
Dim m As Integer
Dim confronti As Integer
Dim flag As Boolean
Dim f As Boolean
Dim u As Integer
Dim p As Integer
Public pos As Integer
Dim v2(0 To n) As Integer
Private Sub cmdcerca_Click()
On Error GoTo error
If flag Then
pos = 0
confronti = 0
item = InputBox("Inserisci l'elemento da cercare", "Inserisci elemento")
If Not IsNumeric(item) Then
MsgBox "Devi inserire un numero intero", vbInformation, "Parametro errato"
Exit Sub
End If
For i = 0 To n
If v2(i) = item Then
pos = i
End If
Next i
m = (0 + n) / 2
If item < v(0) Or item > v(n) Then
Txtric.Text = "Elemento non presente nel vettore"
Txtric.Text = Txtric.Text & vbCrLf & "confronti : 1"
Exit Sub
End If
If item = v(m) Then
Txtric.Text = "Elemento presente nel vettore"
Txtric.Text = Txtric.Text & vbCrLf & "Confronti : 1"
Txtric.Text = Txtric.Text & vbCrLf & "Posizione : " & m
List2.ListIndex = m
Exit Sub
End If
p = 0
u = n
While p <= u
m = (p + u) \ 2
If v(m) < item Then
p = m + 1
confronti = confronti + 1
If item = v(p) Then
Txtric.Text = "Elemento presente nel vettore"
Txtric.Text = Txtric.Text & vbCrLf & "Confronti : " & confronti
Txtric.Text = Txtric.Text & vbCrLf & "Posizione : " & p
confronti = 0
List2.ListIndex = p
List1.ListIndex = pos
Exit Sub
End If
Else
u = m - 1
confronti = confronti + 1
If item = v(u) Then
Txtric.Text = "Elemento presente nel vettore"
Txtric.Text = Txtric.Text & vbCrLf & "Confronti : " & confronti
Txtric.Text = Txtric.Text & vbCrLf & "Posizione : " & u
confronti = 0
List2.ListIndex = u
List1.ListIndex = pos
Exit Sub
End If
End If
Wend
Txtric.Text = item & " non è presente nel vettore"
Else
MsgBox "Il vettore deve prima essere ordinato", vbInformation, "Ordina il vettore"
End If
Exit Sub
error: MsgBox Err.Description
End Sub
Private Sub cmdgen_Click()
List1.Clear
For i = 0 To n
f = False
Randomize
num = Int(Rnd * 99) + 1
For j = 0 To i
If num = v(j) Then
f = True
i = i - 1
End If
Next j
If Not f Then
v(i) = num
End If
Next i
For i = 0 To n
List1.AddItem v(i)
Next i
For i = 0 To n
v2(i) = v(i)
Next i
End Sub
Private Sub cmdsort_Click()
List2.Clear
For i = 0 To n - 1
For j = i To n
If v(i) > v(j) Then
temp = v(j)
v(j) = v(i)
v(i) = temp
End If
Next j
Next i
For i = 0 To n
List2.AddItem v(i)
Next i
flag = True
End Sub
Private Sub Form_Load()
flag = False
f = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
MsgBox "Programma realizzato da Veronese Alberto - albertking82 il (5 novembre 2007)", vbInformation, "Creatore"
End Sub
