frmbpmain.frm

人工智能bp算法程序以及实验报告

            End If
       Next k

         
End Function



Sub subInitialFormVar()
''''对窗体变量初始化
'''每加一个统计程序 加相应的交互变量，这里初始化
    ReDim m_strNonlinOpt(0) '''非线性回归选项
    ReDim m_strParameter(0)
    ReDim m_strLinearOpt(0) '''线性回归选项
    ReDim m_strLinearVar(0) '''线性回归选项
    ReDim m_transformOrient(0)
   ' Me.txtGroup = "不分组"
  '  Me.txtGroupVar = ""
   ' Me.txtGroupVar.Visible = False

End Sub
Function DefaultVarName(Optional mainVarName As String = "Var_") As String
''''缺省变量命名
    Dim i As Long, j As Long, vLen As Integer
    Dim VarName As String, Digi As String
    Dim judge As Boolean
    
    For i = 1 To FrmData.DataTab1.Cols
        judge = True
        For j = 1 To FrmData.DataTab1.Cols - 1
            vLen = InStr(FSvar(j).name, mainVarName + Trim(Str(i)))
            If vLen > 0 Then
                judge = False
                Exit For
            End If
        Next j
        If judge Then
            DefaultVarName = mainVarName + Trim(Str(i))
            Exit Function
        End If
    Next i
        MsgBox ("DefaultVarName Err")

End Function
Sub subSetVarPosition(lngCol1 As Long, lngCol2 As Long, Optional No As Boolean = False)
'''设置0行变量名居中，从 lngCol1 列到 lngCol1 列

    Dim i As Long
    Dim row0 As Long, col0 As Long
''If No Then
        row0 = FrmData.DataTab1.row
        col0 = FrmData.DataTab1.Col
    For i = lngCol1 To lngCol2
        FrmData.DataTab1.row = 0
        FrmData.DataTab1.Col = i
        FrmData.DataTab1.CellAlignment = flexAlignCenterCenter
    Next i
    FrmData.DataTab1.row = row0
    FrmData.DataTab1.Col = col0
''Else
        row0 = FrmData.DataTab.row
        col0 = FrmData.DataTab.Col
    For i = lngCol1 To lngCol2
        FrmData.DataTab.row = 0
        FrmData.DataTab.Col = i
        FrmData.DataTab.CellAlignment = flexAlignCenterCenter
    Next i
    FrmData.DataTab.row = row0
    FrmData.DataTab.Col = col0
''End If

End Sub
Sub D_paste(Optional isReadText As Boolean = False)    '''Note this == Paste
''''Note put clip context into activete cells
''''将选择的数据置于数据窗口(数据粘贴)
    Dim i As Long, j As Long, k As Long, TextLen As Long
    Dim s1 As String, ss1 As String
    Dim cols0 As Long, maxUseCol As Long
    Dim StartCol As Long, StartRow As Long, EndCol As Long, endRow As Long
    Dim SelectedText As String
    
        SelectedText = Clipboard.GetText
    If Not isReadText Then
        SelectedText = TextToGrid(SelectedText)
    End If
    
        
'    If CommaSeparator0 And InStr(selectedText, ",") > 0 Then selectedText = TextToGrid(selectedText)
'    If SpaceSeparator0 And InStr(selectedText, " ") > 0 Then selectedText = TextToGrid(selectedText)
'    If SimeSeparator0 And InStr(selectedText, ";") > 0 Then selectedText = TextToGrid(selectedText)
'    If QuotaSeparator0 And InStr(selectedText, Chr(34)) > 0 Then selectedText = TextToGrid(selectedText)
    
    i = FrmData.DataTab.row '''当前焦点坐标
    j = FrmData.DataTab.Col
    StartRow = i   ''用于计算粘贴区域
    endRow = i
    StartCol = j
    EndCol = j
    cols0 = FrmData.DataTab.Cols

    ss1 = ""

    FrmData.DataTab1.Rows = FrmData.DataTab.Rows
    TextLen = Len(SelectedText)
    
    For k = 1 To TextLen
        s1 = Mid(SelectedText, k, 1)

        If i > occupiedRows Then
               occupiedRows = occupiedRows + 1
               FrmData.DataTab1.TextMatrix(occupiedRows, 0) = Str(occupiedRows)
               FrmData.DataTab1.Rows = occupiedRows + 1 + APPENDRows
       End If

        If Asc(s1) <> 9 And Asc(s1) <> 13 And Asc(s1) <> 10 Then
           ss1 = ss1 + s1
        ElseIf Asc(s1) = 9 Or Asc(s1) = 13 Then
        '''Ascii=9(vbKeyTab)列(变量)间隔,'''行间隔Ascii=13(vbKeyReturn)
           If j >= FrmData.DataTab1.Cols Then
              FrmData.DataTab1.Cols = FrmData.DataTab1.Cols + 1
           End If
           
           FrmData.DataTab1.TextMatrix(i, j) = ss1
           
           ss1 = ""
           If Asc(s1) = 9 Then
              j = j + 1 '''列右移
              EndCol = j '''
           ElseIf Asc(s1) = 13 Then
              i = i + 1 '''行下移
              ''EndCol = j
              j = FrmData.DataTab1.Col
              If k < TextLen Then endRow = endRow + 1
           End If
    '''''''''''''''''''''''''''*
        End If

    Next k
    If s1 <> Chr(10) And s1 <> Chr(13) Then
           If j >= FrmData.DataTab1.Cols Then
              FrmData.DataTab1.Cols = FrmData.DataTab1.Cols + 1
           End If
    
        FrmData.DataTab1.TextMatrix(i, j) = ss1
    End If
        FrmData.DataTab1.Rows = occupiedRows + APPENDRows + 1
        FrmData.DataTab.Rows = occupiedRows + APPENDRows + 1
    FrmData.DataTab.Cols = FrmData.DataTab1.Cols
    If FrmData.DataTab1.Cols > cols0 Then
        '''(可能)加入新列后变量定义的处理
       ReDim Preserve FSvar(FrmData.DataTab.Cols)

If isReadText Then cols0 = 1
       For i = cols0 To FrmData.DataTab1.Cols - 1
           '''***DefaultNarNum = '''***DefaultNarNum + 1
           FSvar(i).name = DefaultVarName()

        '''判断变量类型'''???
        If FrmData.DataTab1.ColAlignment(i) <> flexAlignRightCenter Then
           FrmData.DataTab1.ColAlignment(i) = flexAlignLeftCenter
           FrmData.DataTab.ColAlignment(i) = flexAlignLeftCenter
           FSvar(i).Type = "w"
        Else
           FSvar(i).Type = "n"
        End If
'''           FSvar(i).Type = "w" '''变量类型默认为Word型
           FrmData.DataTab1.TextMatrix(0, i) = FSvar(i).name
           FrmData.DataTab.TextMatrix(0, i) = FSvar(i).name

       Next i
       Call subSetVarPosition(cols0, FrmData.DataTab1.Cols - 1)
    End If
'        Call DispfrmData.DataTab(frmData.DataTab.col, frmData.DataTab.col + ColSel2 - ColSel1 + 1, 0, occupiedRows)
        ''occupiedRows = frmData.DataTab.rows - APPENDRows - 1
        Call DispfrmData(StartCol, EndCol, StartRow, endRow)
        For i = StartRow To endRow
        FrmData.DataTab1.TextMatrix(i, 0) = Trim(Str(i))
        FrmData.DataTab.TextMatrix(i, 0) = Trim(Str(i))
        Next i
        FrmData.DataTab.ColSel = EndCol
        FrmData.DataTab.RowSel = endRow
        ''Call frmData.DataTab_EnterCell
End Sub
 
Sub DispfrmData(StartCol As Long, EndCol As Long, StartRow As Long, endRow As Long)
    '''Call clearErr
    Dim i As Long, j As Long
    Dim k As Long
    Dim strForm As String
FrmData.DataTab.Rows = FrmData.DataTab1.Rows
FrmData.DataTab.Cols = FrmData.DataTab1.Cols
For j = 1 To FrmData.DataTab.Cols - 1
    FrmData.DataTab.TextMatrix(0, j) = FSvar(j).name
Next j


For i = StartCol To EndCol
    If FSvar(i).Type = "w" Then
        For j = StartRow To endRow
            FrmData.DataTab.TextMatrix(j, i) = FrmData.DataTab1.TextMatrix(j, i)
        Next j
    Else
        strForm = ""
        If FSvar(i).Deci <> "" Then
            If FSvar(i).Deci = "0" Then
                strForm = "0"
            Else
                strForm = "0."
            End If
        End If
        For k = 1 To Val(FSvar(i).Deci)
              strForm = strForm + "0"
        Next k
    
        For j = StartRow To endRow
            If j = 0 Then
            FrmData.DataTab.TextMatrix(j, i) = FrmData.DataTab1.TextMatrix(j, i)
            Else
            FrmData.DataTab.TextMatrix(j, i) = Format(Val(FrmData.DataTab1.TextMatrix(j, i)), strForm)
            End If
        Next j
    End If
Next i
'    frmData.DataTab.col = frmData.DataTab1.col
'    frmData.DataTab.Row = frmData.DataTab1.Row
'    frmData.DataTab.ColSel = frmData.DataTab1.ColSel
'    frmData.DataTab.RowSel = frmData.DataTab1.RowSel
    FrmData.DataTab1.Col = FrmData.DataTab.Col '''关于显示，取frmData.DataTab值
    FrmData.DataTab1.row = FrmData.DataTab.row
    FrmData.DataTab1.ColSel = FrmData.DataTab.ColSel
    FrmData.DataTab1.RowSel = FrmData.DataTab.RowSel
    
    
End Sub

Private Sub MenuRun_Click()
FrmBp.SetFocus
End Sub

Private Sub Menutext_Click()
FrmInputtext.SetFocus
End Sub