?? ai.frm
字號:
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "An example of Artificial Intelligence (by Sangaletti Federico -rocky.fff@usa.net-)"
ClientHeight = 6420
ClientLeft = 45
ClientTop = 330
ClientWidth = 9780
Icon = "AI.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6420
ScaleWidth = 9780
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command4
Caption = "&Send me a comment"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 8520
Picture = "AI.frx":030A
Style = 1 'Graphical
TabIndex = 3
Top = 5400
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "&Clear"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 4560
Picture = "AI.frx":0614
Style = 1 'Graphical
TabIndex = 2
Top = 5400
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "&Draw obstacles"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 5880
Picture = "AI.frx":0EDE
Style = 1 'Graphical
TabIndex = 1
Top = 5400
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "&Go!"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 7200
Picture = "AI.frx":11E8
Style = 1 'Graphical
TabIndex = 0
Top = 5400
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************
'* This code demostrate how to create an *
'* AI algorithm for going from a start point *
'* to a stop point turning some obstacles *
'* *
'* This code isn't optimized for the speed *
'* and to chose the shortest way!! *
'*********************************************
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim coordX, coordY As Long
Dim destX, destY As Long
Dim startX, startY As Long
Const nObstacles = 64
Dim XArray(nObstacles) As Variant
Dim YArray(nObstacles) As Variant
Dim Again, a As Boolean
Dim startT, stopT As Long
Dim tmpX, tmpY As Long
Private Sub Command1_Click()
If destX = 0 Then
MsgBox "You must specify the stop point coordinates!" & vbCrLf & "Click on the form", vbExclamation
Exit Sub
End If
startT = Timer
Do
Me.PSet (startX, startY), RGB(255, 0, 0)
If startX <> destX Then
If (destX - startX) < 0 Then
For i = 1 To nObstacles
If (startX - 1 >= XArray(i) And startX - 1 <= XArray(i) + 500) And (startY >= YArray(i) And startY <= YArray(i) + 500) Then
Again = True
Do
If (destX - startX) < 0 Then
startY = startY - 1
Else
startY = startY + 1
End If
Me.PSet (startX, startY), RGB(255, 0, 0)
If (startX - 1 >= XArray(i) And startX - 1 <= XArray(i) + 500) And (startY >= YArray(i) And startY <= YArray(i) + 500) Then
Again = True
Else
Again = False
End If
Loop Until Again = False
End If
Next i
startX = startX - 1
Else
For i = 1 To nObstacles
If (startX + 1 >= XArray(i) And startX + 1 <= XArray(i) + 500) And (startY >= YArray(i) And startY <= YArray(i) + 500) Then
Again = True
Do
If (destX - startX) < 0 Then
startY = startY - 1
Else
startY = startY + 1
End If
Me.PSet (startX, startY), RGB(255, 0, 0)
If (startX + 1 >= XArray(i) And startX + 1 <= XArray(i) + 500) And (startY >= YArray(i) And startY <= YArray(i) + 500) Then
Again = True
Else
Again = False
End If
Loop Until Again = False
End If
Next i
startX = startX + 1
End If
End If
If startY <> destY Then
If (destY - startY) < 0 Then
For i = 1 To nObstacles
If (startY - 1 >= YArray(i) And startY - 1 <= YArray(i) + 500) And (startX >= XArray(i) And startX <= XArray(i) + 500) Then
Again = True
Do
If (startY - destY) < 0 Then
startX = startX - 1
Else
startX = startX + 1
End If
Me.PSet (startX, startY), RGB(255, 0, 0)
If (startY - 1 >= YArray(i) And startY - 1 <= YArray(i) + 500) And (startX >= XArray(i) And startX <= XArray(i) + 500) Then
Again = True
Else
Again = False
End If
Loop Until Again = False
End If
Next i
startY = startY - 1
Else
For i = 1 To nObstacles
If (startY + 1 >= YArray(i) And startY + 1 <= YArray(i) + 500) And (startX >= XArray(i) And startX <= XArray(i) + 500) Then
Again = True
Do
If (startY - destY) < 0 Then
startX = startX - 1
Else
startX = startX + 1
End If
Me.PSet (startX, startY), RGB(255, 0, 0)
If (startY + 1 >= YArray(i) And startY + 1 <= YArray(i) + 500) And (startX >= XArray(i) And startX <= XArray(i) + 500) Then
Again = True
Else
Again = False
End If
Loop Until Again = False
End If
Next i
startY = startY + 1
End If
End If
DoEvents
Loop Until startX = destX And startY = destY
stopT = Timer
MsgBox "Done!!" & vbCrLf & "Time elapsed " & stopT - startT & " sec.", vbExclamation
End Sub
Private Sub Command2_Click()
Call Command3_Click
tmpX = 1500
tmpY = 300
a = True
For i = 1 To nObstacles
tmpX = tmpX + 80
tmpY = tmpY + 560
XArray(i) = tmpX
YArray(i) = tmpY
Me.Line (tmpX, tmpY)-(tmpX + 500, tmpY + 500), RGB(0, 0, 255), BF
If i >= 8 Then
If (i / 8) / Int(i / 8) = 1 Then
If a = False Then
tmpY = 300
a = True
Else
tmpY = 0
a = False
End If
End If
End If
Next i
End Sub
Private Sub Command3_Click()
Me.Cls
Erase XArray
Erase YArray
Call Form_Activate
End Sub
Private Sub Command4_Click()
ShellExecute 0, vbNullString, "mailto:rocky.fff@usa.net?subject=-AI example-", vbNullString, "", 1
End Sub
Private Sub Form_Click()
Me.Circle (coordX, coordY), 30, 255
Me.Print " Stop"
destX = coordX
destY = coordY
End Sub
Private Sub Form_Activate()
Randomize
startX = Int((Rnd * 2000) + 1)
startY = Int((Rnd * 2000) + 1)
Me.Circle (startX, startY), 30, RGB(0, 255, 0)
Me.Print " Start"
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
coordX = X
coordY = Y
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -