[人工智能]3层bp神经网络

Option Explicit
Public V(), W() As Double '连接权
Public R(), Q() As Double '阈值
Public z() As Double '输入层输出
Public y() As Double '中间层输出
Public o() As Double '输出层输出
Public d() As Double '教师信号
Public N As Integer   '学习次数
Public NN As Integer  '教师信号数
Public Count As Integer '第Count个教师信号数
Public II As Integer '输入层节点数
Public JJ As Integer  '中间层节点数
Public KK As Integer '输出层节点
Public Er1() As Double '输出层各单元一般化误差
Public Er2() As Double '中间层各单元一般化误差
Public L1 As Double '权调节系数
Public L2 As Double '阈调节系数

Public Sub StudyMain() '学习过程
Dim i, j, k As Integer

 For Count = 1 To NN
  Call MidLayer '计算中间层各单元的输入/输出
  Call OutLayer '计算输出层各单元的输入/输出
  Call OutError '计算输出层各单元的一般化误差
  Call MidError '计算中间层各单元的一般化误差
  Call Modify_Mid_Out '调节中间层至输出层之间的连接权及输出层节点的阈值
  Call Modify_In_Mid '调节输入层至中间层的连接权及中间层节点的阈值
 Next Count

End Sub


Public Sub Initial() '连接权、阈值初始化
Dim i, j, k As Integer
Randomize
For j = 1 To JJ
  For i = 1 To II
    V(j, i) = 2 * Rnd - 1
  Next i
Next j
For k = 1 To KK
  For j = 1 To JJ
  W(k, j) = 2 * Rnd - 1
  Next j
Next k
For j = 1 To JJ
  R(j) = 2 * Rnd - 1
Next j
For k = 1 To KK
  Q(k) = 2 * Rnd - 1
Next k
End Sub
Public Sub Teacher()   '提供教师信号
Dim i, j, k As Integer
Dim Max As Double
For j = 1 To NN
 For k = 1 To KK
  For i = 1 To II
   z(j, i) = i / 2 + k / 3 + j / 4
   d(j, k) = d(j, k) + z(j, i) ^ 2
  Next i
 Next k
Next j
For j = 1 To NN
 For k = 1 To KK
 If Max < d(j, k) Then
   Max = d(j, k)
 End If
 Next k
Next j
For j = 1 To NN
 For k = 1 To KK
 d(j, k) = d(j, k) / Max
 Next k
Next j
End Sub

Public Sub MidLayer() '计算中间层各单元的输入/输出
Dim i, j As Integer
Dim net() As Double
ReDim net(JJ)
For j = 1 To JJ
  For i = 1 To II
    net(j) = net(j) + V(j, i) * z(Count, i)
  Next i
  y(Count, j) = f(net(j) - R(j))
Next j
End Sub
Public Sub OutLayer() '计算输出层各单元的输入/输出
Dim j, k As Integer
Dim net() As Double
ReDim net(KK)
For k = 1 To KK
  For j = 1 To JJ
    net(k) = net(k) + W(k, j) * y(Count, j)
  Next j
  o(Count, k) = f(net(k) - Q(k))
Next k
End Sub
Public Sub OutError() '计算输出层各单元的一般化误差
Dim k As Integer
For k = 1 To KK
Er1(k) = (d(Count, k) - o(Count, k)) * o(Count, k) * (1 - o(Count, k))
Next k
End Sub
Public Sub MidError() '计算中间层各单元的一般化误差
Dim j, k As Integer
For j = 1 To JJ
  For k = 1 To KK
    Er2(j) = Er2(j) + Er1(k) * W(k, j)
  Next k
  Er2(j) = Er2(j) * y(Count, j) * (1 - y(Count, j))
Next j
End Sub
Public Sub Modify_Mid_Out() '调节中间层至输出层之间的连接权及输出层节点的阈值
Dim k, j As Integer
For k = 1 To KK
  For j = 1 To JJ
  W(k, j) = W(k, j) + L1 * Er1(k) * y(Count, j)
  Next j
  Q(k) = Q(k) - L2 * Er1(k)
Next k
End Sub
Public Sub Modify_In_Mid() '调节输入层至中间层的连接权及中间层节点的阈值
Dim i, j As Integer
For j = 1 To JJ
  For i = 1 To II
  V(j, i) = V(j, i) + L1 * Er2(j) * z(Count, i)
  Next i
  R(j) = R(j) - L2 * Er2(j)
Next j
End Sub
Public Function f(x As Double) As Double
f = 1 / (1 + Exp(-x))
End Function



Option Explicit
Dim Memory, CmdMark As Integer
Dim OY As Double
Private Sub Command1_Click()
Dim i, j, k As Integer
N = Val(Text6.Text)
L1 = Val(Text7.Text)
L2 = Val(Text8.Text)
Call Read_z_d
For j = 1 To NN
For i = 1 To KK
Err = Err + (d(j, i) - o(j, i)) ^ 2
Next i
Next j
Line3(0).X1 = 0
If CmdMark = 0 Then
Line3(0).Y1 = Picture15.Height / 2 - Err * 500
Line3(0).Y2 = Picture15.Height / 2 - Err * 500
Else
Line3(0).Y1 = OY
Line3(0).Y2 = OY
End If
Line3(0).X2 = 0

Call Erase_e
For k = 1 To N
Call StudyMain
Call Draw_e(k)
Call Write_o
Next k
OY = Line3(N).Y2
Call Write_Weight
Call Write_Key
Memory = N
CmdMark = 1
End Sub

Private Sub Command2_Click()
Unload Me
End Sub



Private Sub Form_Load()
Memory = 0
CmdMark = 0
ReDim V(JJ, II)
ReDim W(KK, JJ)
ReDim R(JJ)
ReDim Q(KK)
ReDim z(NN, II)
ReDim y(NN, JJ)
ReDim o(NN, KK)
ReDim d(NN, KK)
ReDim Er1(KK)
ReDim Er2(JJ)
Call Pic1Redraw
Call Text1Load
Call Pic3Redraw
Call Text2Load
Call Pic5Redraw
Call text3Load
Call Pic7Redraw
Call text4Load
Call Pic9Redraw
Call text5Load
Call Pic11Redraw
Call text9Load
Call Pic13Redraw
Call Text10Load
Line4.X1 = 0
Line4.Y1 = Picture15.Height / 2
Line4.X2 = Picture15.Width
Line4.Y2 = Picture15.Height / 2
Call Teacher
Call Write_z_d
Call Initial
Call Write_Weight
Call Write_Key
End Sub

Private Sub Write_z_d()
Dim i, j, k As Integer
For j = 1 To NN
 For i = 1 To II
  Text1((j - 1) * II + i).Text = z(j, i)
 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
      VScroll5.Visible = False
   ElseIf Picture9.Height < Picture10.Height + Picture10.Top * 2 Then
         '只出现垂直滚动条
         VScroll5.Top = 0
         VScroll5.Left = Picture9.Width - VScroll5.Width
         VScroll5.Height = Picture9.Height
         VScroll5.Max = Picture10.Height + 2 * Picture10.Top - Picture9.Height
         VScroll5.Min = 0
         HScroll5.Visible = False
         VScroll5.Visible = True
      Else
        HScroll5.Visible = False
        VScroll5.Visible = False
End If
HScroll5.SmallChange = 20
HScroll5.LargeChange = (HScroll5.Max - HScroll5.Min) / 10
HScroll5.Value = 0
VScroll5.SmallChange = 20
VScroll5.LargeChange = (VScroll5.Max - VScroll5.Min) / 10
VScroll5.Value = 0
End Sub

Private Sub hscroll5_Change()  '水平滚动条变化
Picture10.Left = 0 - HScroll5.Value
End Sub

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

Private Sub vscroll5_Change() '垂直滚动条
Picture10.Top = 0 - VScroll5.Value
End Sub

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

Private Sub HScroll6_Change()  '水平滚动条变化
Picture12.Left = 0 - HScroll6.Value
End Sub


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



Private Sub VScroll6_Change() '垂直滚动条
Picture12.Top = 0 - VScroll6.Value
End Sub

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

Private Sub HScroll7_Change()  '水平滚动条变化
Picture14.Left = 0 - HScroll7.Value
End Sub

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


Private Sub vscroll7_Change() '垂直滚动条
Picture14.Top = 0 - VScroll7.Value
End Sub