frmbpmain.frm

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

VERSION 5.00
Begin VB.MDIForm FrmBpMain 
   BackColor       =   &H8000000C&
   Caption         =   "bp算法"
   ClientHeight    =   9210
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   12975
   LinkTopic       =   "MDIForm1"
   StartUpPosition =   3  'Windows Default
   Begin VB.Menu MenuFile 
      Caption         =   "文件"
      Begin VB.Menu MenuOpen 
         Caption         =   "打开数据文件"
      End
   End
   Begin VB.Menu MenuBp 
      Caption         =   "Bp算法"
   End
   Begin VB.Menu MenuWindow 
      Caption         =   "窗口"
      Begin VB.Menu MenuData 
         Caption         =   "数据窗口"
      End
      Begin VB.Menu MenuRun 
         Caption         =   "运行窗口"
      End
      Begin VB.Menu Menutext 
         Caption         =   "文本窗口"
      End
      Begin VB.Menu MenuGraphic 
         Caption         =   "图形窗口"
      End
   End
   Begin VB.Menu MenuExit 
      Caption         =   "退出"
   End
End
Attribute VB_Name = "FrmBpMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim occupiedRows As Long
Dim DefaultDeci As String
Dim ColSel1 As Long, ColSel2 As Long  '''Note they are begin and end cols selected in frmData.DataTab
Dim RowSel1 As Long, RowSel2 As Long  '''Not
Dim CommaSeparator0 As Integer ''逗号分割符，用于读文本文件
Dim SpaceSeparator0 As Integer ''空格分割符，用于读文本文件
Dim SimeSeparator0 As Integer ''分号分割符，用于读文本文件
Dim QuotaSeparator0 As Integer ''引号分割符，用于读文本文件
 Const APPENDRows = 5
 Sub FormIni()
    '''***DefaultNarNum = 1 '''全局变量初始化(缺省变量个数)
    ''APPENDRows = 5
    occupiedRows = 1
    FrmData.DataTab.Rows = 1 ''清空frmData.DataTab
    FrmData.DataTab1.Rows = 1
    FrmData.DataTab.Rows = APPENDRows + occupiedRows + 1
    FrmData.DataTab.Cols = 2
    FrmData.DataTab.TextMatrix(1, 0) = Str(1)
    FrmData.DataTab1.Rows = APPENDRows + occupiedRows + 1
    FrmData.DataTab1.Cols = 2
    FrmData.DataTab1.TextMatrix(1, 0) = Str(1)
    
    FrmData.DataTab.AllowUserResizing = flexResizeColumns
   
    ReDim FSvar(FrmData.DataTab.Cols - 1)
    FrmData.DataTab.ColAlignment(1) = flexAlignRightCenter
    FSvar(1).name = DefaultVarName() '''wml变量缺省赋名
    FrmData.DataTab.TextMatrix(0, 1) = FSvar(1).name
    FrmData.DataTab1.TextMatrix(0, 1) = FSvar(1).name
    FSvar(1).Type = "n" '''变量类型默认为Numeric型
    FSvar(1).Deci = DefaultDeci
    
    FrmData.DataTab.TextMatrix(0, 0) = "ObsNo"
    FrmData.DataTab1.TextMatrix(0, 0) = "ObsNo"
    FSvar(0).Type = "n"
    FSvar(0).name = "OBSNO"

''    Call subSetVarPosition(1, 1)
    FrmData.DataTab.row = 1 '''wml焦点
    FrmData.DataTab.Col = 1 '''wml焦点
    'location.Caption = "1,1-1,1"
    FrmData.DataTab.FocusRect = flexFocusNone
    
    RowSel1 = 1 '''数据区域全局变量初始化
    ColSel1 = 1
    RowSel2 = 1
    ColSel2 = 1
    Call subSetVarPosition(0, 1)
 '   Me.txtGroup.Text = "不分组"
 '   Me.txtGroupVar.Visible = False
    
End Sub



Private Sub MDIForm_Load()
  Call FormIni
End Sub

Private Sub MenuBp_Click()
FrmBp.SetFocus
End Sub

Private Sub MenuData_Click()
FrmData.SetFocus
End Sub

Private Sub MenuExit_Click()
Unload FrmBpMain
End Sub

Private Sub MenuGraphic_Click()
Frmpicture.SetFocus
End Sub

'''Public tempVar() As VariableDef
Sub MenuOpen_Click()
FrmData.CommonDlg.Filter = "Text Files(*.txt)|*.txt"
' Formula.Text = frmData.DataTab1.Text
FrmData.CommonDlg.ShowOpen
FrmData.DataTab1.Cols = 1
    FSvar(1).name = ""
    FSvar(1).Type = "w"
    FSvar(1).Deci = ""
    FrmData.DataTab1.Cols = 2
    FrmData.CommonDlg.CancelError = True
    occupiedRows = 1
    FrmData.DataTab1.Rows = occupiedRows + APPENDRows + 1
    
 If FrmData.CommonDlg.FileName = "" Then
   Exit Sub
End If
 
  Call ReadData(FrmData.CommonDlg.FileName)
  FrmData.DataTab.RowSel = FrmData.DataTab.row
   FrmData.DataTab.ColSel = FrmData.DataTab.Col
' Formula.Text = frmData.DataTab1.Text
End Sub
Sub ReadData(FileName As String)

Dim i As Long, j As Long, k As Long
    Dim ss As String, SelectedText As String
         
    SelectedText = ""
    Open FileName For Input As #1
    
    Do While Not EOF(1)
       Line Input #1, ss
            ss = TextToGrid(ss)
          SelectedText = SelectedText + ss + Chr(13)
    Loop
    Close #1
    
    If Right(SelectedText, 1) = Chr(10) Then
        SelectedText = Mid(SelectedText, 1, Len(SelectedText) - 1)
    End If
    If Right(SelectedText, 1) = Chr(13) Then
        SelectedText = Mid(SelectedText, 1, Len(SelectedText) - 1)
    End If
    
    ss = Clipboard.GetText  ''OldContents
    Clipboard.Clear
    Clipboard.SetText SelectedText
    Call D_paste(True)
    Clipboard.SetText ss
     
    FrmData.MousePointer = vbDefault
 '   Call subUnloadForms
    Call subInitialFormVar
        
         Call DispfrmData(0, FrmData.DataTab.Cols - 1, 0, FrmData.DataTab.Rows - APPENDRows - 1)
 
End Sub
Function TextToGrid(ss As String)

    Dim i As Long, j As Long, k As Long
    Dim mark As Boolean, isSpace As String * 1
    Dim W As String, ss1 As String
    Dim SeparSymbs As String, isText As Boolean
    
    isText = False
    
    SeparSymbs = Chr(9) + Chr(10)
    If CommaSeparator0 = 1 Then
        SeparSymbs = SeparSymbs + ","
        i = InStr(ss, ",")
        If i > 0 Then isText = True
    End If
    If SimeSeparator0 = 1 Then
        SeparSymbs = SeparSymbs + ";"
        i = InStr(ss, ";")
        If i > 0 Then isText = True
    End If
        
    If QuotaSeparator0 = 1 Then
        SeparSymbs = SeparSymbs + Chr(34)
        i = InStr(ss, Chr(34))
        If i > 0 Then isText = True
    End If
    If SpaceSeparator0 = 1 Then
        isSpace = Chr(32)
        mark = True
        i = InStr(ss, Chr(32))
        If i > 0 Then isText = True
    Else
        isSpace = Chr(0)
    End If
    
    If Not isText Then
        TextToGrid = ss
        Exit Function
    End If
    
    TextToGrid = ""
       mark = True ''1=separator, 2=chr(13), 0=word
       For k = 1 To Len(ss)
            W = Mid(ss, k, 1)
            If InStr(SeparSymbs, W) > 0 Then
                If W <> Chr(10) Then
                    TextToGrid = TextToGrid + Chr(9)
                    mark = True ''' chr(32) will be igone after separator
                End If
            Else
                If W = isSpace Then
                    If Not mark Then
                        mark = True ''chr(32) will be igone after chr(32)
                        TextToGrid = TextToGrid + Chr(9)
                    End If
                Else
                    If W = Chr(13) Then
                    mark = True
                    TextToGrid = TextToGrid + W
                    Else
                    mark = False
                    TextToGrid = TextToGrid + W
                    End If
                    
                End If