main.frm

the attached file contains artifitial neural network code

    TestSet(0, 0) = 1: TestSet(0, 1) = 0:  TestSetResult(0) = 1
    TestSet(1, 0) = 1: TestSet(1, 1) = 1:  TestSetResult(1) = 0
End Sub

Public Sub InitializePreset(INIFile As String)
    PresetVersion = getINI(INIFile, "preset", "version", "0.9")
    Select Case PresetVersion
    Case "1.0"
        PresetTitle = getINI(INIFile, "preset", "title", "")
        If PresetTitle <> "" Then
            PresetList.Add INIFile
            PresetTitleList.Add PresetTitle
        End If
    Case Else
        ' Unsupported; do not add
    End Select
End Sub

Public Sub AddPreset(OwnerForm As Form)
    PresetName.Show 1, OwnerForm
    Dim PresetTitle As String
    If PresetName.Extract(PresetTitle) Then
        PresetReplace = False
        For X = 1 To PresetTitleList.Count
            If LCase(PresetTitleList(X)) = LCase(PresetTitle) Then
                If MsgBox("Would you like to replace the existing preset """ & PresetTitleList(X) & """?", vbQuestion + vbYesNo) = vbYes Then
                    PresetReplace = True
                    Open PresetList(X) For Output As #1
                        Print #1, ""
                    Close #1
                Else
                    Exit Sub
                End If
                Exit For
            End If
        Next
        Dim INIFile As String, Layer As String
        INIFile = PresetPath & "\" & PresetTitle & ".ini"
        Call writeINI(INIFile, "preset", "version", fileVersion)
        Call writeINI(INIFile, "preset", "title", PresetTitle)
        Call writeINI(INIFile, "preset", "layers", layers - 1)
        For n = 0 To layers - 1
            If n = 0 Then
                Layer = "inputs"
            Else
                Layer = "layer" & (n - 1)
            End If
            Select Case n
            Case 0
                Call writeINI(INIFile, Layer, "count", CStr(UBound(iNodes) + 1))
                For p = 0 To UBound(iNodes)
                    Call writeINI(INIFile, Layer, "l" & p, iNodesCaption(p))
                Next p
            Case 1
                Call writeINI(INIFile, Layer, "count", CStr(UBound(hNodes) + 1))
                For p = 0 To UBound(hNodes)
                    Call writeINI(INIFile, Layer, "t" & p, CStr(hNodes(p)))
                    For q = 0 To UBound(iNodes)
                        Call writeINI(INIFile, Layer, "w" & q & "," & p, CStr(iWeights(q, p)))
                    Next q
                Next p
            Case 2
                Call writeINI(INIFile, Layer, "count", CStr(UBound(oNodes) + 1))
                For p = 0 To UBound(oNodes)
                    Call writeINI(INIFile, Layer, "l" & p, oNodesCaption(p))
                    For q = 0 To UBound(hNodes)
                        Call writeINI(INIFile, Layer, "w" & q & "," & p, CStr(oWeights(q, p)))
                    Next q
                Next p
            End Select
        Next n
        If Not PresetReplace Then
            Call Main.InitializePreset(PresetPath & "\" & PresetTitle & ".ini")
        End If
        Call UpdateToolbarPresets
        Call Presets.Prepare
    End If
End Sub

Public Sub RemovePreset(PresetIndex As Integer)
    PresetList.Remove PresetIndex
    PresetTitleList.Remove PresetIndex
End Sub

Private Function LoadPreset(PresetIndex As Integer) As Boolean
    If MsgBox("Are you sure you would like to replace the current network with the """ & PresetTitleList(PresetIndex) & """ preset?", vbQuestion + vbYesNo) = vbNo Then Exit Function
    Dim INIFile As String
    INIFile = PresetList(PresetIndex)
    LoadPreset = True
    PresetVersion = getINI(INIFile, "preset", "version", "0.9")
    If PresetVersion > fileVersion Then
        LoadPreset = (MsgBox("The preset is configured for a newer version of this application. Attempting to open it may give unexpected results." & vbCrLf & vbCrLf & "Are you sure you would like to try to load this preset?", vbExclamation + vbYesNo) = vbYes)
    ElseIf PresetVersion < fileVersion Then
        LoadPreset = (MsgBox("The preset is configured for a older version of this application. Attempting to open it may give unexpected results." & vbCrLf & vbCrLf & "Are you sure you would like to try to load this preset?", vbExclamation + vbYesNo) = vbYes)
    End If
    If LoadPreset Then
        Dim Layer As String, LayerNodes As Integer, LayerNodesPrev As Integer
        PresetLayers = getINI(INIFile, "preset", "layers", "0")
        variable = Asc("a")
        variableCycle = 0
        If CInt(PresetLayers) = layers - 1 Then
            For n = 0 To CInt(PresetLayers)
                If n = 0 Then
                    Layer = "inputs"
                Else
                    Layer = "layer" & (n - 1)
                End If
                sLayerNodes = getINI(INIFile, Layer, "count", "0")
                LayerNodes = CInt(sLayerNodes) - 1
                If LayerNodes >= 0 Then
                    Select Case n
                    Case 0
                        ReDim iNodes(0 To LayerNodes)
                        ReDim iNodesCaption(0 To LayerNodes)
                        For X = LayerNodes + 1 To iB.UBound
                            Unload iB(X)
                            Unload iL(X)
                            Unload wL1(X)
                            Unload wT1(X)
                        Next X
                    Case 1
                        ReDim hNodes(0 To LayerNodes)
                        ReDim hNodesCaption(0 To LayerNodes)
                        ReDim iWeights(0 To LayerNodesPrev, 0 To LayerNodes)
                        For X = LayerNodes + 1 To hB.UBound
                            Unload hB(X)
                            Unload hL(X)
                            Unload wL2(X)
                            Unload wT2(X)
                        Next X
                    Case 2
                        ReDim oNodes(0 To LayerNodes)
                        ReDim oNodesCaption(0 To LayerNodes)
                        ReDim oWeights(0 To LayerNodesPrev, 0 To LayerNodes)
                        For X = LayerNodes + 1 To oB.UBound
                            Unload oB(X)
                            Unload oL(X)
                        Next X
                    End Select
                    Call SetHiddenNodes
                    For p = 0 To LayerNodes
                        If n = 0 Or n = layers - 1 Then
                            nodeVariable = getINI(INIFile, Layer, "l" & p, "")
                            If nodeVariable = "" Then
                                nodeVariable = NextVariable(variable, variableCycle)
                            End If
                        End If
                        NodeThreshold = getINI(INIFile, Layer, "t" & p, "0")
                        Select Case n
                        Case 0
                            iNodesCaption(p) = nodeVariable
                        Case 1
                            hNodes(p) = CDbl(NodeThreshold)
                            For q = 0 To CInt(LayerNodesPrev)
                                NodeWeight = getINI(INIFile, Layer, "w" & q & "," & p, "0")
                                iWeights(q, p) = CDbl(NodeWeight)
                            Next q
                        Case 2
                            oNodesCaption(p) = nodeVariable
                            For q = 0 To LayerNodesPrev
                                NodeWeight = getINI(INIFile, Layer, "w" & q & "," & p, "0")
                                oWeights(q, p) = CDbl(NodeWeight)
                            Next q
                        Case Else
                            MsgBox "Layer #" & n & " cannot be set, as this application is not designed to support that layer.", vbCritical
                            Exit For
                        End Select
                    Next p
                End If
                LayerNodesPrev = LayerNodes
                If LayerNodesPrev < 0 Then LayerNodesPrev = 0
            Next n
            LoadPreset = True
            Call Redraw
        Else
            MsgBox "The preset is configured for a different number of layers than this application is designed to support.", vbCritical
        End If
    End If
End Function

Public Sub UpdateToolbarPresets()
    Call Toolbar.Buttons(5).ButtonMenus.Clear
    For X = 1 To PresetTitleList.Count
        Call Toolbar.Buttons(5).ButtonMenus.Add(X, , PresetTitleList(X))
        Toolbar.Buttons(5).ButtonMenus(X).Tag = ""
    Next X
    If PresetTitleList.Count > 0 Then
        Call Toolbar.Buttons(5).ButtonMenus.Add(, , "-")
        Toolbar.Buttons(5).ButtonMenus(Toolbar.Buttons(5).ButtonMenus.Count).Tag = "sep"
    End If
    Call Toolbar.Buttons(5).ButtonMenus.Add(, , "&Add...")
    Toolbar.Buttons(5).ButtonMenus(Toolbar.Buttons(5).ButtonMenus.Count).Tag = "add"
End Sub

Private Sub DefaultVariables()
    variable = Asc("a")
    variableCycle = 0
    
    For i = LBound(iNodesCaption) To UBound(iNodesCaption)
        iNodesCaption(i) = NextVariable(variable, variableCycle)
    Next i
    For i = LBound(oNodesCaption) To UBound(oNodesCaption)
        oNodesCaption(i) = NextVariable(variable, variableCycle)
    Next i
End Sub

Private Sub SetHiddenNodes()
    ReDim hNodesCaption(LBound(hNodes) To UBound(hNodes))
    For X = LBound(hNodesCaption) To UBound(hNodesCaption)
        hNodesCaption(X) = "h[" & X & "]"
    Next X
End Sub

Private Sub Redraw()
    StatusBar.Panels(1).Text = "Drawing..."
    BodyHeight = Me.ScaleHeight - Toolbar.Height - Label(0).Height - PaneResize.Height - StatusBar.Height - 120
    Pane.Width = Me.ScaleWidth
    If BodyHeight * paneRatio < 1080 Then paneRatio = 1080 / BodyHeight
    If BodyHeight * (1 - paneRatio) < 1080 Then paneRatio = 1 - (1080 / BodyHeight)
    Pane.Height = BodyHeight * paneRatio
    PaneResize.Top = Pane.Top + Pane.Height
    PaneResize.Width = Me.ScaleWidth
    WeightsBox.Top = PaneResize.Top + PaneResize.Height
    WeightsBox.Width = Me.ScaleWidth
    WeightsBox.Height = BodyHeight * (1 - paneRatio)
    Dim BoxLeft As Single
    BoxLeft = (Pane.Width - 60 - 240 - iB(0).Width) / 2
    Call MakeInstances(iNodes, Label(0), Me.iB, Me.iL, 0, iNodesCaption, True)
    Call MakeInstances(hNodes, Label(1), Me.hB, Me.hL, BoxLeft, hNodesCaption)
    Call MakeInstances(oNodes, Label(2), Me.oB, Me.oL, BoxLeft * 2, oNodesCaption, True)
    Pane.Picture = Nothing
    Pane.Cls
    Dim RowHeight As Single
    RowHeight = (WeightsBox.Height - 60 - 120) / 2
    If RowHeight < 600 Then RowHeight = 600
    Call MakeAssociations(Me.iB, Me.hB, Me.wT1, Me.wL1, iWeights, iNodesCaption, hNodesCaption, RowHeight, 1)
    Call MakeAssociations(Me.hB, Me.oB, Me.wT2, Me.wL2, oWeights, hNodesCaption, oNodesCaption, RowHeight, 2)
    Pane.Picture = Me.Pane.Image
    Pane.Cls
    WeightsBox.Cls
    StatusBar.Panels(1).Text = "Ready"
    StatusBar.Panels(2).Text = layers & " layers"
    StatusBar.Panels(3).Text = UBound(iNodes) + 1 & " input node(s), " & UBound(hNodes) + 1 & " hidden node(s) and " & UBound(oNodes) + 1 & " output node(s)"
End Sub

Private Sub MakeInstances(Nodes() As Double, Title As Label, Boxes As Object, Labels As Object, BoxLeft As Single, NodesCaption() As String, Optional IsVariable As Boolean = False)
    If UBound(Nodes) > 0 Then
        BoxStep = (Me.Pane.Height - Boxes(0).Height - 270) / UBound(Nodes)
        Boxes(0).Top = 120
    Else
        BoxStep = Me.Pane.Height - Boxes(0).Height - 30
        Boxes(0).Top = BoxStep / 2
    End If
    Labels(0).Top = Boxes(X).Top + 120
    For X = 0 To UBound(Nodes)
        If Boxes.UBound < X Then
            Load Boxes(X)
            Load Labels(X)
        End If
        If X > 0 Then
            Boxes(X).Top = BoxStep * X + 120
            Labels(X).Top = Boxes(X).Top + 120
        End If
        If IsVariable Then
            Labels(X).Caption = NodesCaption(X)
        Else
            Labels(X).Caption = Nodes(X)
        End If
        Boxes(X).Left = BoxLeft + 120
        Title.Left = BoxLeft + 30
        Boxes(X).Visible = True
        Labels(X).Left = Boxes(X).Left
        Labels(X).Visible = True
        Labels(X).ZOrder (0)
    Next X
End Sub

Private Sub MakeAssociations(Boxes1 As Object, Boxes2 As Object, Lists As Object, Labels As Object, Weights() As Double, Type1() As String, Type2() As String, RowHeight As Single, RowNumber As Integer)
    ListStep = (WeightsBox.Width - 60 - 120) / (Boxes1.UBound + 1)
    For X = Boxes1.LBound To Boxes1.UBound
        If Lists.UBound < X Then
            Load Lists(X)
            Load Labels(X)
        End If
        Labels(X).Top = RowHeight * (RowNumber - 1) + 120
        Lists(X).Top = Labels(X).Top + Labels(X).Height + 60
        Lists(X).Left = ListStep * X + 120
        Lists(X).Width = ListStep - 90
        Lists(X).Height = RowHeight - Labels(X).Height - 60 - 120
        Labels(X).Left = Lists(X).Left
        Labels(X).Caption = Type1(X)
        Lists(X).Visible = True
        Labels(X).Visible = True
        Lists(X).Clear
        For Y = Boxes2.LBound To Boxes2.UBound
            Me.Pane.ForeColor = IIf(Weights(X, Y) = 0, RGB(192, 192, 192), vbBlack)
            Me.Pane.Line (Boxes1(X).Left + Boxes1(X).Width, Boxes1(X).Top + Boxes1(X).Height / 2)-(Boxes2(Y).Left, Boxes2(Y).Top + Boxes2(Y).Height / 2)
            Lists(X).AddItem Type2(Y) & " = " & Weights(X, Y)
        Next Y
    Next X
End Sub

Private Sub Highlight(Boxes1 As Object, Boxes2 As Object, X As Integer, Y As Integer)
    Me.Pane.ForeColor = vbRed
    Me.Pane.Line (Boxes1(X).Left + Boxes1(X).Width, Boxes1(X).Top + Boxes1(X).Height / 2)-(Boxes2(Y).Left, Boxes2(Y).Top + Boxes2(Y).Height / 2)
End Sub

Private Function InputValue(Prompt, Title, Default, NewValue, Optional MustBeNumber As Boolean = True) As Boolean
    Do
        InputError = False
        NewValue = InputBox(Prompt, Title, Default)
        If NewValue = "" Then
            InputValue = False
            Exit Function
        End If
        If MustBeNumber And Not IsNumeric(NewValue) Then
            InputError = True
            MsgBox "The specified weight is not numeric. Please only insert a number.", vbExclamation
        End If
    Loop While (InputError)
    InputValue = True
End Function

Public Function NextVariable(ByRef var As Integer, ByRef cycle As Integer) As String
    If var > Asc("z") Then
        var = Asc("a")
        cycle = cycle + 1
    End If
    NextVariable = Chr(var) & IIf(cycle > 0, cycle, "")
    var = var + 1
End Function