frmtest.frm

一个用于实现BP神经网络算法的程序

            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   0
         Left            =   3240
         TabIndex        =   23
         Top             =   120
         Width           =   375
      End
      Begin VB.Label Label2 
         Caption         =   "Qk"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   11.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   6
         Left            =   4320
         TabIndex        =   22
         Top             =   2520
         Width           =   375
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "测试"
      Height          =   495
      Left            =   4920
      TabIndex        =   0
      Top             =   5160
      Width           =   1215
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   240
      Top             =   4560
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DefaultExt      =   ".txt"
   End
   Begin VB.Menu File 
      Caption         =   "文件"
      Begin VB.Menu Open 
         Caption         =   "打开"
         Begin VB.Menu OpenData 
            Caption         =   "打开数据文件"
         End
         Begin VB.Menu OpenWeight 
            Caption         =   "打开权值文件"
         End
      End
      Begin VB.Menu Save 
         Caption         =   "保存"
         Begin VB.Menu SaveData 
            Caption         =   "保存数据文件"
            Begin VB.Menu SaveData1 
               Caption         =   "仅保存数据"
            End
            Begin VB.Menu SaveData3 
               Caption         =   "保存数据与结果"
            End
            Begin VB.Menu SaveData2 
               Caption         =   "保存输出结果"
            End
         End
         Begin VB.Menu SaveOtherData 
            Caption         =   "另存权值文件"
         End
      End
   End
   Begin VB.Menu 操作 
      Caption         =   "操作"
      Begin VB.Menu TestData 
         Caption         =   "测试单个数据"
      End
      Begin VB.Menu 刷新 
         Caption         =   "刷新"
      End
      Begin VB.Menu Back 
         Caption         =   "退出"
      End
      Begin VB.Menu Close 
         Caption         =   "关闭"
      End
   End
End
Attribute VB_Name = "FrmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Back_Click()
Unload Me
End Sub

Private Sub Close_Click()
End
End Sub


Private Sub Command1_Click()
Call Pic3Redraw
Call Text2Load
Call StudyMain1
Call Write_o
End Sub

Private Sub OpenData_Click() '打开数据文件
Dim s, c, i, j, k As Integer
On Error GoTo note
CommonDialog1.DialogTitle = "打开测试数据"
CommonDialog1.InitDir = "C:\Documents and Settings\qjd1314\桌面\新建文件夹\周夏杰\可验证数据"
CommonDialog1.Filter = "文本文件(*.txt)|*.txt|"
CommonDialog1.FilterIndex = 1
CommonDialog1.Action = 1
Open CommonDialog1.FileName For Input As #1
If Err.Number = 0 Then
Input #1, N1
Input #1, I1
Input #1, J1
Input #1, K1
ReDim z(N1, I1)
ReDim y(N1, J1)
ReDim o(N1, K1)
ReDim d(N1, K1)
For i = 1 To N1
For j = 1 To I1 '+ KK
Input #1, s
'If s = 0 Then
'Input #1, d(i, j - II)
'Else
Input #1, z(i, j)
'End If
Next j
Next i
Close #1
End If
NN = N1
II = I1
JJ = J1
KK = K1
Call Pic1Redraw
Call Text1Load
Call Write_z_d
note: MsgBox "打开文件错误"
End Sub

Private Sub OpenWeight_Click() '打开权重文件
Dim i, j, k As Integer
On Error GoTo note
CommonDialog1.DialogTitle = "打开权重"
CommonDialog1.InitDir = "C:\Documents and Settings\qjd1314\桌面\新建文件夹\周夏杰\可验证数据"
CommonDialog1.Filter = "文本文件(*.txt)|*.txt|"
CommonDialog1.FilterIndex = 1
CommonDialog1.Action = 1
Open CommonDialog1.FileName For Input As #1
If Err.Number = 0 Then
Input #1, NN
Input #1, II
Input #1, JJ
Input #1, KK
'If Mark2 = 1 And JJ = J1 Then
ReDim V(JJ, II)
ReDim W(KK, JJ)
ReDim R(JJ)
ReDim Q(KK)
For j = 1 To JJ
 For i = 1 To II
  Input #1, V(j, i) '写入输入层到中间层的权值
 Next i
Next j
For k = 1 To KK
 For j = 1 To JJ
  Input #1, W(k, j) '写入中间层到输出层的权值
 Next j
Next k
For j = 1 To JJ
   Input #1, R(j) '写入输入层到中间层的阀值
Next j
For k = 1 To KK
   Input #1, Q(k) '写入中间层到输出层的阀值
Next k
Close #1
End If
Call Pic7Redraw
Call text4Load
Call Pic9Redraw
Call text5Load
Call Pic11Redraw
Call text9Load
Call Pic13Redraw
Call Text10Load
Call Write_Key
Call Write_Weight
'Mark1 = 1
'End If
note:                       '标记
End Sub
Private Sub Write_Key() '阀值显示到该文本上
Dim i, j, k As Integer
For j = 1 To JJ
   Text9(j).Text = R(j) '输入层到中间层的阀值显示到该文本上
Next j
For k = 1 To KK
   Text10(k).Text = Q(k) '中间层到输出层的阀值显示到该文本上
Next k
End Sub
Private Sub Write_Weight() '权值显示到该文本上
Dim i, j, k As Integer
For j = 1 To JJ
 For i = 1 To II
  Text5((j - 1) * II + i).Text = V(j, i) '输入层到中间层的权值显示到该文本上
 Next i
Next j
For k = 1 To KK
 For j = 1 To JJ
  Text4((k - 1) * JJ + j).Text = W(k, j) '中间层到输出层的权值显示到该文本上
 Next j
Next k
End Sub



Private Sub SaveData1_Click() '仅保存数据
Dim i, j, s, k As Integer
CommonDialog1.DialogTitle = "另存为对话框"
CommonDialog1.InitDir = "c:\"
CommonDialog1.Filter = "文本文件(*.txt)|*.txt|"
CommonDialog1.FilterIndex = 1
CommonDialog1.DefaultExt = "*.txt"
CommonDialog1.Action = 2
Open CommonDialog1.FileName For Output As #1
Print #1, NN
Print #1, II
Print #1, JJ
Print #1, KK
For i = 1 To NN
For j = 1 To II
Write #1, j;
If j = II Then
Write #1, z(i, j)
Else
Write #1, z(i, j);
End If
Next j
Next i
Close #1
End Sub

Private Sub SaveData2_Click() '保存输出
CommonDialog1.DialogTitle = "另存为对话框"
CommonDialog1.InitDir = "c:\"
CommonDialog1.Filter = "文本文件(*.txt)|*.txt|"
CommonDialog1.FilterIndex = 1
CommonDialog1.DefaultExt = "*.txt"
CommonDialog1.Action = 2
Open CommonDialog1.FileName For Output As #1
For i = 1 To NN
For j = 1 To KK
If j = KK Then
Print #1, o(i, j)
Else
Print #1, o(i, j);
End If
Close #1
Next j
Next i
End Sub

Private Sub SaveData3_Click() '保存数据与结果
Dim i, j, s, k As Integer
CommonDialog1.DialogTitle = "另存为对话框"
CommonDialog1.InitDir = "c:\"
CommonDialog1.Filter = "文本文件(*.txt)|*.txt|"
CommonDialog1.FilterIndex = 1
CommonDialog1.DefaultExt = "*.txt"
CommonDialog1.Action = 2
Open CommonDialog1.FileName For Output As #1
Print #1, NN
Print #1, II
Print #1, JJ
Print #1, KK
For i = 1 To NN
For j = 1 To II + KK
If j < II + 1 Then
Write #1, j;
Write #1, z(i, j);
Else
Write #1, 0;
Write #1, d(i, j - II)
End If
Next j
Next i
Close #1
End Sub

Private Sub SaveOtherData_Click() '另存权值文件
Dim i, j, k As Integer
CommonDialog1.DialogTitle = "另存为对话框"
CommonDialog1.InitDir = "c:\"
CommonDialog1.Filter = "文本文件(*.txt)|*.txt|"
CommonDialog1.FilterIndex = 1
CommonDialog1.DefaultExt = "*.txt"
CommonDialog1.Action = 2
Open CommonDialog1.FileName For Output As #2
If Err.Number = 0 Then
Print #2, NN
Print #2, II
Print #2, JJ
Print #2, KK
For j = 1 To JJ
 For i = 1 To II
  Print #2, V(j, i), '写入输入层到中间层的权值
 Next i
Next j
For k = 1 To KK
 For j = 1 To JJ
  Print #2, W(k, j), '写入中间层到输出层的权值
 Next j
Next k
For j = 1 To JJ
   Print #2, R(j) '写入输入层到中间层的阀值
Next j
For k = 1 To KK
   Print #2, Q(k) '写入中间层到输出层的阀值
Next k
Close #2
End If
End Sub
Private Sub Pic1Redraw() '视窗图片重绘子程序
'设置表格载体图片控件的属性
Picture2.Width = I1 * Text1(0).Width + 50
Picture2.Height = N1 * Text1(0).Height + 50
'判断滚动条出现的不同情况
If Picture1.Width < Picture2.Width + Picture2.Left * 2 _
   And Picture1.Height < Picture2.Height + Picture2.Top * 2 Then
'水平、垂直滚动条都出现
   HScroll1.Left = 0
   HScroll1.Top = Picture1.Height - HScroll1.Height
   HScroll1.Width = Picture1.Width
   HScroll1.Max = Picture2.Width + 2 * Picture2.Left - Picture1.Width
   HScroll1.Min = 0
   
   VScroll1.Top = 0
   VScroll1.Left = Picture1.Width - VScroll1.Width
   VScroll1.Height = Picture1.Height - HScroll1.Height
   VScroll1.Max = Picture2.Height + 2 * Picture2.Top - Picture1.Height
   VScroll1.Min = 0
   HScroll1.Visible = True
   VScroll1.Visible = True
ElseIf Picture1.Width < Picture2.Width + Picture2.Left * 2 Then
      '只出现水平滚动条
      HScroll1.Left = 0
      HScroll1.Top = Picture1.Height - HScroll1.Height
      HScroll1.Width = Picture1.Width
      HScroll1.Max = Picture2.Width + 2 * Picture2.Left - Picture1.Width
      HScroll1.Min = 0
      HScroll1.Visible = True
      VScroll1.Visible = False
   ElseIf Picture1.Height < Picture2.Height + Picture2.Top * 2 Then
         '只出现垂直滚动条
         VScroll1.Top = 0
         VScroll1.Left = Picture1.Width - VScroll1.Width
         VScroll1.Height = Picture1.Height
         VScroll1.Max = Picture2.Height + 2 * Picture2.Top - Picture1.Height
         VScroll1.Min = 0
         HScroll1.Visible = False
         VScroll1.Visible = True
      Else
        HScroll1.Visible = False
        VScroll1.Visible = False
End If
HScroll1.SmallChange = 20
HScroll1.LargeChange = (HScroll1.Max - HScroll1.Min) / 10
HScroll1.Value = 0
VScroll1.SmallChange = 20
VScroll1.LargeChange = (VScroll1.Max - VScroll1.Min) / 10
VScroll1.Value = 0
End Sub

Private Sub HScroll1_Change()  '水平滚动条变化
Picture2.Left = 0 - HScroll1.Value
End Sub

Private Sub Text1Load() '调入文本框控件
Dim i, j As Integer
For i = 0 To N1 - 1 '调入水平表格中的各个文本框
  For j = 1 To I1 '调入垂直表格中的各个文本框