真个比较难!
Private lngH&, lngW&
Private Sub Command1_Click()
lngH = Val(Text1.Text)
lngW = Val(Text2.Text)
Dim i&, j&
For j = 0 To lngH - 1
For i = 0 To lngW - 1
Print Format(getNum(i, j), "@@@@");
Next
Print
Next
End Sub
Private Function getNum&(x&, y&)
If x < 0 Or x >= lngW Or y < 0 Or y >= lngH Then
getNum = -1
Exit Function
End If
Dim startN&, startX&, startY&, endX&, endY&, c&, n&
startN = 1
startX = 0: endX = lngW - 1
startY = 0: endY = lngH - 1
c = calcCircleIndex(startX, endX, startY, endY, x, y)
startN = startN + calcCircleSum(c, endX - startX + 1, endY - startY + 1)
startX = startX + c
endX = endX - c
startY = startY + c
endY = endY - c
n = startN
If y = startY Then
n = n + x - startX
getNum = n
Exit Function
End If
n = n + endX - startX
If x = endX Then
n = n + y - startY
getNum = n
Exit Function
End If
n = n + endY - startY
If y = endY Then
n = n + endX - x
getNum = n
Exit Function
End If
n = n + endX - startX
If x = startX Then
n = n + endY - y
getNum = n
Exit Function
End If
getNum = -1
End Function
Private Function calcCircleIndex&(startX&, endX&, startY&, endY&, x&, y&)
Dim c&
c = y - startY
If c > endY - y Then c = endY - y
If c > x - startX Then c = x - startX
If c > endX - x Then c = endX - x
calcCircleIndex = c
End Function
Private Function calcCircleSum&(c&, w&, h&)
If c < 1 Then
calcCircleSum = 0
Else
calcCircleSum = (w + w + h + h - 4) * c - 8 * calcNumberSum(c - 1)
End If
End Function
Private Function calcNumberSum&(n&)
If n < 1 Then
calcNumberSum = 0
ElseIf (n And 1) = 1 Then
calcNumberSum = n * (n - 1) \ 2 + n
Else
calcNumberSum = (n + 1) * n \ 2
End If
End Function
你用这个改改了
