VB源码供大家参考
这个程序编起来挺麻烦的,goto都用上了
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 6960
ClientLeft = 165
ClientTop = 735
ClientWidth = 9900
LinkTopic = "Form1"
ScaleHeight = 6960
ScaleWidth = 9900
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text1
Height = 6840
Left = 30
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 0
Top = 60
Width = 9840
End
Begin VB.Menu start
Caption = "start"
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'问题描述:
'有十二个外表相同的球,其中有一个坏球,它的重量和其它十
'一个有轻微的(但是可以测量出来的)差别。现在有一架没有砝码的
'很灵敏的天平,问如何称三次就保证找出那个坏球,并知道它比标准
'球重还是轻。
Option Explicit
'分块穷举法
Dim BallData(3, 2, 5) As Long '各次取球数据,最多取5个
Dim WeightResult(3) As Long '3次称球结果 -1 左轻 0 相等 1 左重
Private Ball(12) As Long ' 小球重 ,值为0 、1 或 -1 ,分别表示正常球 比其它球重 比其它球轻
Private BallValue(12) As Long ' 冲突检测值 第一取球前置1,取球值后左+10,右+100 第二次取值后左+1000 右+10000
Private PartCount As Long '分组数
Private PartArray(12, 12) As Long '各组小球数据
Private PartNum(12) As Long '各组小球个数
Private PartGeted(12) As Long '各组已被取的小球个数
Private PartGeted2(12) As Long '各组已被取的小球个数
Private BallNum As Long, GetedNum As Long
'需要定义3个以避免数据冲突
Private ArrayDataCount(3) As Long
Private ArrayData(3, 10000, 2, 5) As Long
Private Get1 As Long, Get2 As Long
Private ResultArray(3, 3, 3, 2, 5) As Long '存放3次取值结果
'为了减少变量个数,使用多维数组,各维表示次数、WeightResult(1)、WeightResult(2)、L/R、BallData
'有效数据为 (1 1 1)
' (2 1 1) (2 2 1) (2 3 1)
' (311 312 313) (321 322 323) (331 332 333)
Private Sub Form_Resize()
Text1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub
Private Sub start_Click() 'ok
MainProc (0)
End Sub
Public Function MainProc(ByVal iStep As Long) As Boolean
'启动 MainProc(0)
Dim i As Long, j As Long, k As Long
Dim Num As Long, Sum As Long, OK As Boolean
MainProc = False
Num = GetNum(iStep) '基于0
If Num > 3 ^ (3 - iStep) Then Exit Function
iStep = iStep + 1
GetArray iStep
For i = 1 To ArrayDataCount(iStep) '基于1,取1 2 3共3组小球
'合法检测
Call SetArray(iStep, i) '设置取球数据BallData(iStep,,)