请教算法

lzf83616 2004-04-08 07:37:03

...全文
9 点赞 收藏 9

9 条回复

daisy8675 2004-04-24

lzf83616 2004-04-24

KiteGirl 2004-04-09

<如果当前点是雷，则爆炸……>

For XIndex=X-1 To X+1
For YIndex=Y-1 To Y+1
MCount=MCount+(有雷判断(X,Y) And 1)
Next
Nexy

pigpag 2004-04-09

KiteGirl 2004-04-09

Private priFold() As Long '羊圈

Private Sub Command1_Click()
If CBool(SheepCount(priFold())) Then '如果羊圈里还有羊的话
Text2.Text = SheepNabByFold(priFold()) '羊圈存栏数量
Text1.Text = SheepCount(priFold()) '被抓住的小羊羔编号
For tIndex = 0 To SheepCount(priFold()) - 1 '显示羊圈里的小羊。
Text1.Text = Text1.Text & " " & priFold(tIndex)
Next
Else
Text1.Text = "没有羊了！你还乱抓什么？"
End If
End Sub

Private Sub Form_Load()
Randomize Timer
ReDim priFold(100)
For tIndex = 0 To 100
priFold(tIndex) = tIndex
Next
End Sub

Function SheepCount(ByRef pFold() As Long) As Long
Dim tOutCount As Long

Dim tSheepIndex_Start As Long
Dim tSheepIndex_End As Long
Dim tSheepIndex_Rnd As Long

Err.Clear
On Error Resume Next

tSheepIndex_End = UBound(pFold): tSheepIndex_Start = LBound(pFold)
If Not CBool(Err.Number) Then
tOutCount = Abs(tSheepIndex_End - tSheepIndex_Start) + 1
End If

SheepCount = tOutCount
End Function

Function SheepNabByFold(ByRef pFold() As Long) As Long
Dim tOutSheep As Long
Dim tSheepIndex As Long
Dim tSheepCount As Long
Dim tSheepIndex_Start As Long
Dim tSheepIndex_End As Long
Dim tSheepIndex_Rnd As Long
Dim tFoldSpace() As Long

tSheepIndex_End = UBound(pFold()): tSheepIndex_Start = LBound(pFold())
tSheepCount = SheepCount(pFold()) '计算当前数组编号。
tSheepIndex_Rnd = Int(Rnd * tSheepCount) + tSheepIndex_Start
'取合法随机编号。

SheepSwap pFold(tSheepIndex_End), pFold(tSheepIndex_Rnd)
'将末尾的元素与第随机个元素交换（注意，随机元素必须在目前存在的编号范围内）。

tOutSheep = pFold(tSheepIndex_End)

If tSheepCount < 2 Then
pFold() = tFoldSpace()
Else
ReDim Preserve pFold(tSheepIndex_End - 1) '缩小数组，保留数值。
End If

SheepNabByFold = tOutSheep
End Function

Sub SheepSwap(ByRef pSheepA As Long, ByRef pSheepB As Long)
Dim tSheep As Long
tSheep = pSheepA: pSheepA = pSheepB: pSheepB = tSheep
End Sub

lzf83616 2004-04-09

pigpag 2004-04-08

supergreenbean 2004-04-08

daisy8675 2004-04-08

VB基础类

7476

VB 基础类

2004-04-08 07:37