frmbp.frm

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

 Next i
Next j
For j = 1 To NN
 For k = 1 To KK
  Text3((j - 1) * KK + k).Text = d(j, k)
 Next k
Next j
End Sub

Private Sub Read_z_d()
Dim i, j, k As Integer
For j = 1 To NN
 For i = 1 To II
  z(j, i) = Val(Text1((j - 1) * II + i).Text)
 Next i
Next j
For j = 1 To NN
 For k = 1 To KK
  d(j, k) = Val(Text3((j - 1) * KK + k).Text)
 Next k
Next j
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 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_o()
Dim j, k As Integer
For j = 1 To NN
 For k = 1 To KK
  Text2((j - 1) * KK + k).Text = o(j, k)
 Next k
Next j
End Sub
Private Sub Draw_e(l As Integer) '画线
Dim Err As Double
Err = 0
Dim i, j, k As Integer
For j = 1 To NN
For k = 1 To KK
Err = Err + (d(j, k) - o(j, k)) ^ 2
Next k
Next j
Err = Err / 2
Load Line3(l)
Line3(l).Visible = True
Line3(l).X1 = Line3(l - 1).X2
Line3(l).Y1 = Line3(l - 1).Y2
Line3(l).X2 = Line3(l - 1).X2 + Picture15.Width / N * l
Line3(l).Y2 = Picture15.Height / 2 - 500 * Err
End Sub

Private Sub Erase_e() '擦除画线
Dim i As Integer
For i = 1 To Memory
Unload Line3(i)
Next
End Sub

Private Sub Pic1Redraw() '视窗图片重绘子程序
'设置表格载体图片控件的属性
Picture2.Width = II * Text1(0).Width + 50
Picture2.Height = NN * 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 NN - 1 '调入水平表格中的各个文本框
  For j = 1 To II '调入垂直表格中的各个文本框
    Load Text1(i * II + j)
    Text1(i * II + j).Visible = True
    Text1(i * II + j).Left = Text1(0).Width * (j - 1)
    Text1(i * II + j).Top = Text1(0).Height * i
    Text1(i * II + j).Text = ""
  Next j
Next i
End Sub


Private Sub VScroll1_Change() '垂直滚动条
Picture2.Top = 0 - VScroll1.Value
End Sub

Private Sub Pic3Redraw() '视窗图片重绘子程序
'设置表格载体图片控件的属性
Picture4.Width = KK * Text2(0).Width + 50
Picture4.Height = NN * Text2(0).Height + 50
'判断滚动条出现的不同情况
If Picture3.Width < Picture4.Width + Picture4.Left * 2 _
   And Picture3.Height < Picture4.Height + Picture4.Top * 2 Then
'水平、垂直滚动条都出现
   HScroll2.Left = 0
   HScroll2.Top = Picture3.Height - HScroll2.Height
   HScroll2.Width = Picture3.Width
   HScroll2.Max = Picture4.Width + 2 * Picture4.Left - Picture3.Width
   HScroll2.Min = 0
   
   VScroll2.Top = 0
   VScroll2.Left = Picture3.Width - VScroll2.Width
   VScroll2.Height = Picture3.Height - HScroll2.Height
   VScroll2.Max = Picture4.Height + 2 * Picture4.Top - Picture3.Height
   VScroll2.Min = 0
   HScroll2.Visible = True
   VScroll2.Visible = True
ElseIf Picture3.Width < Picture4.Width + Picture4.Left * 2 Then
      '只出现水平滚动条
      HScroll2.Left = 0
      HScroll2.Top = Picture3.Height - HScroll2.Height
      HScroll2.Width = Picture3.Width
      HScroll2.Max = Picture4.Width + 2 * Picture4.Left - Picture3.Width
      HScroll2.Min = 0
      HScroll2.Visible = True
      VScroll2.Visible = False
   ElseIf Picture3.Height < Picture4.Height + Picture4.Top * 2 Then
         '只出现垂直滚动条
         VScroll2.Top = 0
         VScroll2.Left = Picture3.Width - VScroll2.Width
         VScroll2.Height = Picture3.Height
         VScroll2.Max = Picture4.Height + 2 * Picture4.Top - Picture3.Height
         VScroll2.Min = 0
         HScroll2.Visible = False
         VScroll2.Visible = True
      Else
        HScroll2.Visible = False
        VScroll2.Visible = False
End If
HScroll2.SmallChange = 20
HScroll2.LargeChange = (HScroll2.Max - HScroll2.Min) / 10
HScroll2.Value = 0
VScroll2.SmallChange = 20
VScroll2.LargeChange = (VScroll2.Max - VScroll2.Min) / 10
VScroll2.Value = 0
End Sub

Private Sub HScroll2_Change()  '水平滚动条变化
Picture4.Left = 0 - HScroll2.Value
End Sub

Private Sub Text2Load() '调入文本框控件
Dim i, j As Integer
For i = 0 To NN - 1 '调入水平表格中的各个文本框
  For j = 1 To KK '调入垂直表格中的各个文本框
    Load Text2(i * KK + j)
    Text2(i * KK + j).Visible = True
    Text2(i * KK + j).Left = Text2(0).Width * (j - 1)
    Text2(i * KK + j).Top = Text2(0).Height * i
    Text2(i * KK + j).Text = ""
  Next j
Next i
End Sub

Private Sub VScroll2_Change() '垂直滚动条
Picture4.Top = 0 - VScroll2.Value
End Sub

Private Sub Pic5Redraw() '视窗图片重绘子程序
'设置表格载体图片控件的属性
Picture6.Width = KK * Text3(0).Width + 50
Picture6.Height = NN * Text3(0).Height + 50
'判断滚动条出现的不同情况
If Picture5.Width < Picture6.Width + Picture6.Left * 2 _
   And Picture5.Height < Picture6.Height + Picture6.Top * 2 Then
'水平、垂直滚动条都出现
   HScroll3.Left = 0
   HScroll3.Top = Picture5.Height - HScroll3.Height
   HScroll3.Width = Picture5.Width
   HScroll3.Max = Picture6.Width + 2 * Picture6.Left - Picture5.Width
   HScroll3.Min = 0
   
   VScroll3.Top = 0
   VScroll3.Left = Picture5.Width - VScroll3.Width
   VScroll3.Height = Picture5.Height - HScroll3.Height
   VScroll3.Max = Picture6.Height + 2 * Picture6.Top - Picture5.Height
   VScroll3.Min = 0
   HScroll3.Visible = True
   VScroll3.Visible = True
ElseIf Picture5.Width < Picture6.Width + Picture6.Left * 2 Then
      '只出现水平滚动条
      HScroll3.Left = 0
      HScroll3.Top = Picture5.Height - HScroll3.Height
      HScroll3.Width = Picture5.Width
      HScroll3.Max = Picture6.Width + 2 * Picture6.Left - Picture5.Width
      HScroll3.Min = 0
      HScroll3.Visible = True
      VScroll3.Visible = False
   ElseIf Picture5.Height < Picture6.Height + Picture6.Top * 2 Then
         '只出现垂直滚动条
         VScroll3.Top = 0
         VScroll3.Left = Picture5.Width - VScroll3.Width
         VScroll3.Height = Picture5.Height
         VScroll3.Max = Picture6.Height + 2 * Picture6.Top - Picture5.Height
         VScroll3.Min = 0
         HScroll3.Visible = False
         VScroll3.Visible = True
      Else
        HScroll3.Visible = False
        VScroll3.Visible = False
End If
HScroll3.SmallChange = 20
HScroll3.LargeChange = (HScroll3.Max - HScroll3.Min) / 10
HScroll3.Value = 0
VScroll3.SmallChange = 20
VScroll3.LargeChange = (VScroll3.Max - VScroll3.Min) / 10
VScroll3.Value = 0
End Sub

Private Sub hscroll3_Change()  '水平滚动条变化
Picture6.Left = 0 - HScroll3.Value
End Sub

Private Sub text3Load() '调入文本框控件
Dim i, j As Integer
For i = 0 To NN - 1 '调入水平表格中的各个文本框
  For j = 1 To KK '调入垂直表格中的各个文本框
    Load Text3(i * KK + j)
    Text3(i * KK + j).Visible = True
    Text3(i * KK + j).Left = Text3(0).Width * (j - 1)
    Text3(i * KK + j).Top = Text3(0).Height * i
    Text3(i * KK + j).Text = ""
  Next j
Next i
End Sub

Private Sub vscroll3_Change() '垂直滚动条
Picture6.Top = 0 - VScroll3.Value
End Sub

Private Sub Pic7Redraw() '视窗图片重绘子程序
'设置表格载体图片控件的属性
Picture8.Width = JJ * Text4(0).Width + 50
Picture8.Height = KK * Text4(0).Height + 50
'判断滚动条出现的不同情况
If Picture7.Width < Picture8.Width + Picture8.Left * 2 _
   And Picture7.Height < Picture8.Height + Picture8.Top * 2 Then
'水平、垂直滚动条都出现
   HScroll4.Left = 0
   HScroll4.Top = Picture7.Height - HScroll4.Height
   HScroll4.Width = Picture7.Width
   HScroll4.Max = Picture8.Width + 2 * Picture8.Left - Picture7.Width
   HScroll4.Min = 0
   
   VScroll4.Top = 0
   VScroll4.Left = Picture7.Width - VScroll4.Width
   VScroll4.Height = Picture7.Height - HScroll4.Height
   VScroll4.Max = Picture8.Height + 2 * Picture8.Top - Picture7.Height
   VScroll4.Min = 0
   HScroll4.Visible = True
   VScroll4.Visible = True
ElseIf Picture7.Width < Picture8.Width + Picture8.Left * 2 Then
      '只出现水平滚动条
      HScroll4.Left = 0
      HScroll4.Top = Picture7.Height - HScroll4.Height
      HScroll4.Width = Picture7.Width
      HScroll4.Max = Picture8.Width + 2 * Picture8.Left - Picture7.Width
      HScroll4.Min = 0
      HScroll4.Visible = True
      VScroll4.Visible = False
   ElseIf Picture7.Height < Picture8.Height + Picture8.Top * 2 Then
         '只出现垂直滚动条
         VScroll4.Top = 0
         VScroll4.Left = Picture7.Width - VScroll4.Width
         VScroll4.Height = Picture7.Height
         VScroll4.Max = Picture8.Height + 2 * Picture8.Top - Picture7.Height
         VScroll4.Min = 0
         HScroll4.Visible = False
         VScroll4.Visible = True
      Else
        HScroll4.Visible = False
        VScroll4.Visible = False
End If
HScroll4.SmallChange = 20
HScroll4.LargeChange = (HScroll4.Max - HScroll4.Min) / 10
HScroll4.Value = 0
VScroll4.SmallChange = 20
VScroll4.LargeChange = (VScroll4.Max - VScroll4.Min) / 10
VScroll4.Value = 0
End Sub

Private Sub hscroll4_Change()  '水平滚动条变化
Picture8.Left = 0 - HScroll4.Value
End Sub

Private Sub text4Load() '调入文本框控件
Dim i, j As Integer
For i = 0 To KK - 1 '调入水平表格中的各个文本框
  For j = 1 To JJ '调入垂直表格中的各个文本框
    Load Text4(i * JJ + j)
    Text4(i * JJ + j).Visible = True
    Text4(i * JJ + j).Left = Text4(0).Width * (j - 1)
    Text4(i * JJ + j).Top = Text4(0).Height * i
    Text4(i * JJ + j).Text = ""
  Next j
Next i
End Sub

Private Sub vscroll4_Change() '垂直滚动条
Picture8.Top = 0 - VScroll4.Value
End Sub

Private Sub Pic9Redraw() '视窗图片重绘子程序
'设置表格载体图片控件的属性
Picture10.Width = II * Text5(0).Width + 50
Picture10.Height = JJ * Text5(0).Height + 50
'判断滚动条出现的不同情况
If Picture9.Width < Picture10.Width + Picture10.Left * 2 _
   And Picture9.Height < Picture10.Height + Picture10.Top * 2 Then
'水平、垂直滚动条都出现
   HScroll5.Left = 0
   HScroll5.Top = Picture9.Height - HScroll5.Height
   HScroll5.Width = Picture9.Width
   HScroll5.Max = Picture10.Width + 2 * Picture10.Left - Picture9.Width
   HScroll5.Min = 0
   
   VScroll5.Top = 0
   VScroll5.Left = Picture9.Width - VScroll5.Width
   VScroll5.Height = Picture9.Height - HScroll5.Height
   VScroll5.Max = Picture10.Height + 2 * Picture10.Top - Picture9.Height
   VScroll5.Min = 0
   HScroll5.Visible = True
   VScroll5.Visible = True
ElseIf Picture9.Width < Picture10.Width + Picture10.Left * 2 Then
      '只出现水平滚动条
      HScroll5.Left = 0
      HScroll5.Top = Picture9.Height - HScroll5.Height
      HScroll5.Width = Picture9.Width
      HScroll5.Max = Picture10.Width + 2 * Picture10.Left - Picture9.Width
      HScroll5.Min = 0
      HScroll5.Visible = True