global.bas

一个较好的自适应遗传算法

    resx = (plotx - (bkx1 + 12)) * gridx / ((bkx2 - 7) - (bkx1 + 12))
End Function

Function resy(ploty)
    resy = (ploty - (bky1 + 13)) * gridy / ((bky2 - 8) - (bky1 + 13))
End Function

Function fx_resx(plotx)
    fx_resx = (plotx - (bkx1 + 5)) * gridx / ((bkx2 - 5) - (bkx1 + 5))
End Function

Function fx_resy(ploty)
    fx_resy = (ploty - (bky1 + 5)) * gridy / ((bky2 - 5) - (bky1 + 5))
End Function

Function draw_resx(plotx)
    draw_resx = (plotx - forplot_x1) * gridx / (forplot_x2 - forplot_x1)
End Function

Function draw_resy(ploty)
    draw_resy = (ploty - forplot_y1) * gridy / (forplot_y2 - forplot_y1)
End Function

Sub wellpoint(wx, wy, wxp, wyp)
    sx = 0: sy = 0
    For i = 1 To griddxnum
     sx = sx + griddx(i)
     If wx <= sx Then wxp = i: GoTo 20
    Next i
20  For i = 1 To griddynum
     sy = sy + griddy(i)
     If wy <= sy Then wyp = i: Exit Sub
    Next i
End Sub

Sub static_laysta(static_lsdimpoint, a_static, a_layer)
 If static_lsdimpoint = 4 Then
  a_static = 1: a_layer = 1
 Else
  a_static = Int((static_lsdimpoint - 5) / layernum) + 2
  a_layer = static_lsdimpoint - (4 + (a_static - 2) * layernum)
 End If
End Sub

'--------------------------------------------------
' color value
Function Value(n1, n2, hue)
  Static val As Single
 
  If (hue > 360) Then hue = hue - 360
  If (hue < 0) Then hue = hue + 360
  If (hue < 60) Then
   val = n1 + (n2 - n1) * hue / 60
  Else
   If (hue < 180) Then
    val = n2
   Else
    If (hue < 240) Then
     val = n1 + (n2 - n1) * (240 - hue) / 60
    Else
     val = n1
    End If
   End If
  End If
  val = val * 255
  Value = Int(val + 0.5)
End Function
 
'--------------------------------------------------
' color band
Public Sub color()
  Static h, i, j As Integer
  Static l, s, m1, m2 As Single
 
  l = 0.5
  s = 1
  j = 100
  h = -10
  For i = 1 To 100
    If (i >= 47 And i <= 65) Then h = h + 5 Else h = h + 2
    If (i > 5 And i <= 47) Then l = l - 0.006
    If (i > 65 And i <= 95) Then l = l + 0.0084
    If (l <= 0.5) Then m2 = l * (1 + s) Else m2 = l + s - l * s
    m1 = 2 * l - m2
    If (s = 0) Then
      red(j) = l: green(j) = l: blue(j) = l
    Else
      red(j) = Value(m1, m2, h + 120)
      green(j) = Value(m1, m2, h)
      blue(j) = Value(m1, m2, h - 120)
    End If
    j = j - 1
  Next i
  l = 0.3
  s = 1
  j = 200
  h = -10
  For i = 1 To 100
    If (i >= 47 And i <= 65) Then h = h + 5 Else h = h + 2
    If (i > 5 And i <= 40) Then l = l - 0.004
    If (i > 65 And i <= 93) Then l = l + 0.005
    If (l <= 0.5) Then m2 = l * (1 + s) Else m2 = l + s - l * s
    m1 = 2 * l - m2
    If (s = 0) Then
      red(j) = l: green(j) = l: blue(j) = l
    Else
      red(j) = Value(m1, m2, h + 120)
      green(j) = Value(m1, m2, h)
      blue(j) = Value(m1, m2, h - 120)
    End If
    j = j - 1
   Next i
   ' 201 -- 220  used by menu
   ' 221 -- 225  used by cures
   red(0) = 0: green(0) = 0: blue(0) = 0
   red(241) = 0: green(241) = 100: blue(241) = 0     'main title
   red(242) = 0: green(242) = 0: blue(242) = 200     'time axis
   red(243) = 0: green(243) = 150: blue(243) = 150   'parameter window
   red(244) = 0: green(244) = 150: blue(244) = 200   'time window
   red(245) = 0: green(245) = 150: blue(245) = 0     'second window back
   red(246) = 140: green(246) = 0: blue(246) = 255   'instruction band
   red(247) = 160: green(247) = 0: blue(247) = 250   'window back
   red(248) = 140: green(248) = 80: blue(248) = 100  'pfjia
   red(249) = 180: green(249) = 120: blue(249) = 140 'btmjia
   red(250) = 100: green(250) = 100: blue(250) = 100 'color band back
   red(251) = 130: green(251) = 0: blue(251) = 130   'map back
   red(252) = 230: green(252) = 50: blue(252) = 200  'function key
   red(253) = 255: green(253) = 0: blue(253) = 0     'oil well
   red(254) = 0: green(254) = blue(254) = 200        'water well
   red(255) = green(255) = blue(255) = 255           'main frame
End Sub
 
'--------------------------------------------------
' color band
Public Sub color_new()
   red(100) = 255: green(100) = 0: blue(100) = 0
   red(75) = 255: green(75) = 255: blue(75) = 0
   red(50) = 0: green(50) = 255: blue(50) = 0
   red(25) = 0: green(25) = 255: blue(25) = 255
   red(1) = 0: green(1) = 0: blue(1) = 255
   For i = 76 To 99
    red(i) = 255: green(i) = 255 / 25 * (100 - i): blue(i) = 0
   Next i
   For i = 51 To 74
    red(i) = 255 / 25 * (i - 50): green(i) = 255: blue(i) = 0
   Next i
   For i = 26 To 49
    red(i) = 0: green(i) = 255: blue(i) = 255 / 25 * (50 - i)
   Next i
   For i = 2 To 24
    red(i) = 0: green(i) = 255 / 24 * (i - 1): blue(i) = 255
   Next i
   val1 = 60: val2 = 150
   red(200) = val2: green(200) = val1: blue(200) = val1
   red(175) = val2: green(175) = val2: blue(175) = val1
   red(150) = val1: green(150) = val2: blue(150) = val1
   red(125) = val1: green(125) = val2: blue(125) = val2
   red(101) = val1: green(101) = val1: blue(101) = val2
   For i = 176 To 199
    red(i) = val2: green(i) = val2 / 25 * (200 - i): blue(i) = val1
   Next i
   For i = 151 To 174
    red(i) = val2 / 25 * (i - 150): green(i) = val2: blue(i) = val1
   Next i
   For i = 126 To 149
    red(i) = val1: green(i) = val2: blue(i) = val2 / 25 * (150 - i)
   Next i
   For i = 102 To 124
    red(i) = val1: green(i) = val2 / 24 * (i - 101): blue(i) = val2
   Next i
End Sub

Public Sub conduct_useless(current_layer, form1 As Object)
  If uselessgridnum(current_layer) <> 0 Then '无效网格
   For i = 1 To uselessgridnum(current_layer)
    xr = 0#: yr = 0#
    For j = 1 To uselessgridx(i, current_layer) - 1
     xr = xr + griddx(j)
    Next j
    For j = 1 To uselessgridy(i, current_layer) - 1
     yr = yr + griddy(j)
    Next j
    x1 = draw_plotx(xr)
    y1 = draw_ploty(yr)
    x2 = draw_plotx(xr + griddx(uselessgridx(i, current_layer)))
    y2 = draw_ploty(yr + griddy(uselessgridy(i, current_layer)))
    form1.Line (x1, y1)-(x2, y2), uscor, BF          ' &HC0C0C0, BF
   Next i
   
   For i = 1 To useless_zone_num
    x1 = useless_zone(i, 1)
    x2 = useless_zone(i, 3)
    y1 = useless_zone(i, 2)
    y2 = useless_zone(i, 4)
    If Abs(x1 - forplot_x1) > 0.00001 Then form1.Line (x1, y1)-(x1, y2), QBColor(0)
    If Abs(x2 - forplot_x2) > 0.00001 Then form1.Line (x2, y1)-(x2, y2), QBColor(0)
   Next i
   
   For i = 1 To griddxnum
    linebz = 0
    xr = 0#
    For k = 1 To i - 1
     xr = xr + griddx(k)
    Next k
    x1 = draw_plotx(xr)
    x2 = draw_plotx(xr + griddx(i))
    For j = 1 To griddynum
     If useless_use(i, j) = 1 And linebz = 0 Then liney1 = j: linebz = 1
     If useless_use(i, j) = 0 And linebz = 1 Then
      yr = 0#
      If liney1 <> 1 Then
       For k = 1 To liney1 - 1
        yr = yr + griddy(k)
       Next k
       y1 = draw_ploty(yr)
       If Abs(y1 - forplot_y1) > 0.00001 Then form1.Line (x1, y1)-(x2, y1), QBColor(0)
      End If
      For k = liney1 To j - 1
       yr = yr + griddy(k)
      Next k
      y2 = draw_ploty(yr)
      If Abs(y2 - forplot_y2) > 0.00001 Then form1.Line (x1, y2)-(x2, y2), QBColor(0)
      linebz = 0
     End If
    Next j
    If linebz = 1 Then
      yr = 0#
      If liney1 <> 1 Then
       For k = 1 To liney1 - 1
        yr = yr + griddy(k)
       Next k
       y1 = draw_ploty(yr)
       If Abs(y1 - forplot_y1) > 0.00001 Then form1.Line (x1, y1)-(x2, y1), QBColor(0)
      End If
     End If
   Next i
  End If
End Sub

Public Sub uselesszone_js(current_layer)
  If uselessgridnum(current_layer) <> 0 Then '无效网格
   ReDim useless_use(griddxnum, griddynum)
   ReDim useless_zone(griddynum * 5, 4)
   useless_zone_num = 0
   For i = 1 To griddxnum
    For j = 1 To griddynum
     useless_use(i, j) = 0
    Next j
   Next i
   
   For i = 1 To uselessgridnum(current_layer)
    useless_use(uselessgridx(i, current_layer), uselessgridy(i, current_layer)) = 1
   Next i
   
   For j = 1 To griddynum
    linebz = 0
    yr = 0#
    For k = 1 To j - 1
     yr = yr + griddy(k)
    Next k
    y1 = draw_ploty(yr)
    y2 = draw_ploty(yr + griddy(j))
    For i = 1 To griddxnum
     If useless_use(i, j) = 1 And linebz = 0 Then linex1 = i: linebz = 1
     If useless_use(i, j) = 0 And linebz = 1 Then
      xr = 0#
      For k = 1 To linex1 - 1
       xr = xr + griddx(k)
      Next k
      x1 = draw_plotx(xr)
      For k = linex1 To i - 1
       xr = xr + griddx(k)
      Next k
      x2 = draw_plotx(xr)
      useless_zone_num = useless_zone_num + 1
      useless_zone(useless_zone_num, 1) = x1
      useless_zone(useless_zone_num, 2) = y1
      useless_zone(useless_zone_num, 3) = x2
      useless_zone(useless_zone_num, 4) = y2
      linebz = 0
     End If
    Next i
    If linebz = 1 Then
     xr = 0#
     For k = 1 To linex1 - 1
      xr = xr + griddx(k)
     Next k
     x1 = draw_plotx(xr)
     useless_zone_num = useless_zone_num + 1
     useless_zone(useless_zone_num, 1) = x1
     useless_zone(useless_zone_num, 2) = y1
     useless_zone(useless_zone_num, 3) = draw_plotx(gridx)
     useless_zone(useless_zone_num, 4) = y2
    End If
   Next j
  End If
End Sub

Public Sub conduct_jmq(current_layer, form1 As Object)
  If jmq_pointnum(current_layer) <> 0 Then '尖灭网格
   For i = 1 To jmq_pointnum(current_layer)
    xr = 0#: yr = 0#
    For j = 1 To jmq_pointx(i, current_layer) - 1
     xr = xr + griddx(j)
    Next j
    For j = 1 To jmq_pointy(i, current_layer) - 1
     yr = yr + griddy(j)
    Next j
    x1 = draw_plotx(xr)
    y1 = draw_ploty(yr)
    x2 = draw_plotx(xr + griddx(jmq_pointx(i, current_layer)))
    y2 = draw_ploty(yr + griddy(jmq_pointy(i, current_layer)))
    form1.Line (x1, y1)-(x2, y2), &HE0E0E0, BF
   Next i
   
   For i = 1 To jmq_zone_num
    x1 = jmq_zone(i, 1)
    x2 = jmq_zone(i, 3)
    y1 = jmq_zone(i, 2)
    y2 = jmq_zone(i, 4)
    If Abs(x1 - forplot_x1) > 0.00001 Then form1.Line (x1, y1)-(x1, y2), QBColor(0)
    If Abs(x2 - forplot_x2) > 0.00001 Then form1.Line (x2, y1)-(x2, y2), QBColor(0)
   Next i
   
   For i = 1 To griddxnum
    linebz = 0
    xr = 0#
    For k = 1 To i - 1
     xr = xr + griddx(k)
    Next k
    x1 = draw_plotx(xr)
    x2 = draw_plotx(xr + griddx(i))
    For j = 1 To griddynum
     If jmq_use(i, j) = 1 And linebz = 0 Then liney1 = j: linebz = 1
     If jmq_use(i, j) = 0 And linebz = 1 Then
      yr = 0#
      If liney1 <> 1 Then
       For k = 1 To liney1 - 1
        yr = yr + griddy(k)
       Next k
       y1 = draw_ploty(yr)
       If Abs(y1 - forplot_y1) > 0.00001 Then form1.Line (x1, y1)-(x2, y1), QBColor(0)
      End If
      For k = liney1 To j - 1
       yr = yr + griddy(k)
      Next k
      y2 = draw_ploty(yr)
      If Abs(y2 - forplot_y2) > 0.00001 Then form1.Line (x1, y2)-(x2, y2), QBColor(0)
      linebz = 0
     End If
    Next j
    If linebz = 1 Then
      yr = 0#
      If liney1 <> 1 Then
       For k = 1 To liney1 - 1
        yr = yr + griddy(k)
       Next k
       y1 = draw_ploty(yr)
       If Abs(y1 - forplot_y1) > 0.00001 Then form1.Line (x1, y1)-(x2, y1), QBColor(0)
      End If
     End If
   Next i
  End If
End Sub

Public Sub jmqzone_js(current_layer)
  If jmq_pointnum(current_layer) <> 0 Then '无效网格
   ReDim jmq_use(griddxnum, griddynum)
   ReDim jmq_zone(griddynum * 5, 4)
   jmq_zone_num = 0
   For i = 1 To griddxnum
    For j = 1 To griddynum
     jmq_use(i, j) = 0
    Next j
   Next i
   
   For i = 1 To jmq_pointnum(current_layer)
    jmq_use(jmq_pointx(i, current_layer), jmq_pointy(i, current_layer)) = 1
   Next i
   
   For j = 1 To griddynum
    linebz = 0
    yr = 0#
    For k = 1 To j - 1
     yr = yr + griddy(k)
    Next k
    y1 = draw_ploty(yr)
    y2 = draw_ploty(yr + griddy(j))
    For i = 1 To griddxnum
     If jmq_use(i, j) = 1 And linebz = 0 Then linex1 = i: linebz = 1
     If jmq_use(i, j) = 0 And linebz = 1 Then
      xr = 0#