📄 frmflyers.frm
字号:
VERSION 5.00
Begin VB.Form frmFLYERS
Caption = "Neural Net TRAINED BY Genetic Algotihm (flying objects)"
ClientHeight = 9150
ClientLeft = 60
ClientTop = 450
ClientWidth = 10860
LinkTopic = "Form1"
ScaleHeight = 610
ScaleMode = 3 'Pixel
ScaleWidth = 724
StartUpPosition = 1 'CenterOwner
Begin VB.CheckBox chMOVEt
Caption = "Moving Target"
Height = 195
Left = 9480
TabIndex = 23
Top = 4560
Value = 1 'Checked
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "EXIT"
Height = 495
Left = 9600
TabIndex = 22
Top = 3840
Width = 1215
End
Begin VB.Frame Frame1
Caption = "Before Training, Load:"
Height = 1455
Left = 8040
TabIndex = 18
Top = 2280
Width = 2295
Begin VB.OptionButton oAT
Caption = "Already Trained"
Height = 255
Left = 120
TabIndex = 21
Top = 960
Width = 1575
End
Begin VB.OptionButton oNEW
Caption = "New Dumb Population"
Height = 255
Left = 120
TabIndex = 20
Top = 240
Width = 1935
End
Begin VB.OptionButton oPP
Caption = "Last Trained Population"
Height = 255
Left = 120
TabIndex = 19
Top = 600
Value = -1 'True
Width = 2055
End
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
BackColor = &H8000000F&
Height = 3975
Left = 7800
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 17
Text = "frmFLYERS.frx":0000
Top = 5040
Width = 3015
End
Begin VB.CheckBox chCOLLISION
Caption = "Objects Collide?"
Height = 375
Left = 8040
TabIndex = 16
Top = 4680
Width = 1455
End
Begin VB.CheckBox chDRAW
Caption = "DRAW"
Height = 375
Left = 8040
TabIndex = 15
Top = 4440
Value = 1 'Checked
Width = 1335
End
Begin VB.CommandButton cmdTRAIN
Caption = "TRAIN"
Height = 495
Left = 8040
TabIndex = 14
Top = 3840
Width = 1455
End
Begin VB.TextBox GEN
Height = 285
Left = 9502
TabIndex = 7
Text = "G"
Top = 120
Width = 1095
End
Begin VB.TextBox ACC
Height = 285
Left = 9502
TabIndex = 6
Text = "Acc"
Top = 480
Width = 1095
End
Begin VB.TextBox MUT
Height = 285
Left = 9502
TabIndex = 5
Text = "mut"
Top = 840
Width = 1095
End
Begin VB.TextBox NEWr
Height = 285
Left = 9502
TabIndex = 4
Text = "NEWrandom"
Top = 1200
Width = 1095
End
Begin VB.TextBox BFIT
BackColor = &H0000FF00&
Height = 285
Left = 9502
TabIndex = 3
Text = "Gen Bestift"
Top = 1920
Width = 1095
End
Begin VB.TextBox gAVG
BackColor = &H00C0C000&
Height = 285
Left = 9502
Locked = -1 'True
TabIndex = 2
Text = "Gen AVG"
Top = 1560
Width = 1095
End
Begin VB.TextBox INFO
Height = 615
Left = 360
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Top = 7920
Width = 7095
End
Begin VB.PictureBox PIC
Appearance = 0 'Flat
BackColor = &H00000000&
FillColor = &H0000C000&
FillStyle = 0 'Solid
ForeColor = &H0000FF00&
Height = 7575
Left = 120
ScaleHeight = 503
ScaleMode = 3 'Pixel
ScaleWidth = 503
TabIndex = 0
Top = 120
Width = 7575
End
Begin VB.Label Label7
Caption = "Generation"
Height = 255
Left = 8415
TabIndex = 13
Top = 120
Width = 975
End
Begin VB.Label Label5
Caption = "G Avg Fit"
Height = 255
Left = 8415
TabIndex = 12
Top = 1560
Width = 1095
End
Begin VB.Label Label1
Caption = "Reproductions"
Height = 255
Left = 8415
TabIndex = 11
Top = 480
Width = 975
End
Begin VB.Label Label2
Caption = "Mutations"
Height = 255
Left = 8415
TabIndex = 10
Top = 840
Width = 975
End
Begin VB.Label Label3
Caption = "New Random"
Height = 255
Left = 8415
TabIndex = 9
Top = 1200
Width = 975
End
Begin VB.Label Label4
Caption = "G Best Fit"
Height = 255
Left = 8415
TabIndex = 8
Top = 1920
Width = 975
End
End
Attribute VB_Name = "frmFLYERS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Author : Creator Roberto Mior
' reexre@gmail.com
'
'If you use source code or part of it please cite the author
'You can use this code however you like providing the above credits remain intact
'
'
'
'------------------------------------------------------------------------
Option Base 1
Dim GA As New SimplyGA
Dim BPOP As New simplyBrainsPOP
Dim NumberofFlyers As Long
Dim I As Long
Private Sub Command1_Click()
End
End Sub
Private Sub Form_Load()
Randomize Timer
PI = Atn(1) * 4
PI2 = Atn(1) * 8
PolyColor = -1
If Dir(App.Path & "\POP.txt") = "POP.txt" Then oPP = True Else oNEW = True
'ReDim RoadP(4)
'RoadP(1).x = 5
'RoadP(1).y = 5
'RoadP(2).x = 495
'RoadP(2).y = 5
'RoadP(3).x = 495
'RoadP(3).y = 495
'RoadP(4).x = 5
'RoadP(4).y = 495
'ReDim RoadL(4)
'RoadL(1).P1 = 1
'RoadL(1).P2 = 2
'RoadL(2).P1 = 2
'RoadL(2).P2 = 3
'RoadL(3).P1 = 3
'RoadL(3).P2 = 4
'RoadL(4).P1 = 4
'RoadL(4).P2 = 1
End Sub
Sub DrawRoad()
Dim P1 As Integer
Dim P2 As Integer
For I = 1 To UBound(RoadL)
P1 = RoadL(I).P1
P2 = RoadL(I).P2
PIC.Line (RoadP(P1).x, RoadP(P1).y)- _
(RoadP(P2).x, RoadP(P2).y), RGB(0, 200, 0)
Next
End Sub
Sub DrawFlyers()
Dim X1 As Integer
Dim Y1 As Integer
Dim X2 As Integer
Dim Y2 As Integer
Dim X3 As Integer
Dim Y3 As Integer
Dim C As Long
For I = 1 To NumberofFlyers
If chCOLLISION.Value = Checked Then
PIC.Circle (Flyer(I).POS.x, Flyer(I).POS.y), B(I).RADIUS, IIf(I <> BEST, RGB(0, 150, 0), RGB(255, 255, 255))
Else
DrawPoly PIC, I
End If
Next
End Sub
Private Sub cmdTRAIN_Click()
Dim NNoutputs As Variant
Dim TargetX As Single
Dim TargetY As Single
Dim TTT
Dim tmpFlyer As tFlyer
Dim CICLO
Dim Trainer
Dim Dleft As Single
Dim Dright As Single
Dim xr As Single
Dim Yr As Single
Dim RR As PointAPI
Dim TvX As Single
Dim TvY As Single
TTT = 280
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -