新建工程：
   添加一个模块，移除窗体。

   关键的难点在于：
1、找到所用到的所有变量。
2、把 goto 命令 改为 DO ... Loop 循环。
3、把 INPUT 改为 InputBox ，把 Print 改为 MsgBox
其它都原样照抄。
这个程序没有优化好。可读性很差。
如果是 Qbasic 代码的话，已支持 sub 子过程及Function子函数了，也建议变量定义，不建议使用 GOTO 命令。
但想不出是什么代码。 GWBASIC 要求全程行号；BASICA ，不支持中文汉字平台。TURBO BASIC 也是要求全程行号。

Option Explicit


Public Sub Main()


'2 Cls
'Color 6
'LOCATE 3, 10
'Print "   欢迎您,让我们来玩猜数字游戏吧!现在我有一个四位数,您可以猜8次。"
'Print "   记住,这个四位数每个数位上的数字是不相同的。"
'Print "   还有，您每猜测一次，我都会给出一个提示的，好好利用提示，"
'Print "   您肯定会胜利的，把脑筋动起来吧！"
'Print "   提示方法：Ａ和Ｂ，Ａ表示您猜的数字中有一个数位上的数字与答案的"
'Print "   数位相同，数字也相同。Ｂ表示您猜的数字中有一个数字与答案中的一个"
'Print "   数字相同,但数位不对。"
'Print "   例子：比如答案是1234,你猜5243,我给出的提示就是1A2B,1A表示有一个数字对了(指百位上的2),"
'Print "   2B表示有两个数字对了(指3和4)，但数位不对，您明白了吗？"
'Color 7
'Print "   那让我们开始吧！"

Dim s As String
Dim s1 As String
Dim s3 As String
Dim s2 As String


Dim a As Integer, b As Integer, c As Integer, d As Integer, k As Integer
Dim e As Integer
Dim z As Integer

Dim a1 As Integer, b1 As Integer, c1 As Integer, d1 As Integer
Dim n As Integer, m As Integer, q As Integer, w As Integer, o As Integer, r As Integer, t As Integer
Dim y As Integer

Dim m1 As Integer, n1 As Integer




s = "欢迎您,让我们来玩猜数字游戏吧!现在我有一个四位数,您可以猜8次。"
s = s & vbCrLf & "记住,这个四位数每个数位上的数字是不相同的。"
s = s & vbCrLf & "还有，您每猜测一次，我都会给出一个提示的，好好利用提示，"
s = s & vbCrLf & "您肯定会胜利的，把脑筋动起来吧！"
s = s & vbCrLf & "提示方法：Ａ和Ｂ，Ａ表示您猜的数字中有一个数位上的数字与答案的"
s = s & vbCrLf & "数位相同，数字也相同。Ｂ表示您猜的数字中有一个数字与答案中的一个"
s = s & vbCrLf & "数字相同,但数位不对。"
s = s & vbCrLf & "例子：比如答案是1234,你猜5243,我给出的提示就是1A2B,1A表示有一个数字对了(指百位上的2),"
s = s & vbCrLf & "2B表示有两个数字对了(指3和4)，但数位不对，您明白了吗？"

MsgBox s, , "提示"

'10 Randomize Timer
Randomize Timer

'a = 0
'b = 0
'c = 0
'd = 0
'k = 0
'a = Int(Rnd * 10)
'b = Int(Rnd * 10)
'c = Int(Rnd * 10)
'd = Int(Rnd * 10)

Do
a = 0
b = 0
c = 0
d = 0
k = 0

Do
a = Int(Rnd * 10)
b = Int(Rnd * 10)
c = Int(Rnd * 10)
d = Int(Rnd * 10)

'If a <> b And a <> c And a <> d And b <> c And b <> d And c <> d Then e = 1000 * a + 100 * b + 10 * c + d Else GoTo 10

Loop Until a <> b And a <> c And a <> d And b <> c And b <> d And c <> d

e = 1000 * a + 100 * b + 10 * c + d

s1 = "现在我有这个四位数了。"

Do
'20 Print "   这是您第"; k; "次猜数，您猜猜是多少？"

'Color 11
'Print "   现在我有这个四位数了。"
'5 k = k + 1

'If k = 9 Then GoTo 100
'Color 11

k = k + 1
s3 = s1 & vbCrLf & "这是您第" & k & "次猜数，您猜猜是多少？"


Do
'INPUT z
'a1 = 0
'b1 = 0
'c1 = 0
'd1 = 0
'a1 = Int(z / 1000)
'b1 = Int((z - a1 * 1000) / 100)
'c1 = Int((z - a1 * 1000 - b1 * 100) / 10)
'd1 = z - a1 * 1000 - b1 * 100 - c1 * 10

'If z < 1000 Or z > 9999 Then Print "   您输入错误了，记住，您要猜的是一个4个数字都不相同的四位数。请重新输入吧！": GoTo 20
    
    s2 = InputBox(s3, "输入")
    
    s2 = Trim(s2)         '去掉空格
    
    If Len(s2) = 0 Then
        End                 '按取消后，返回为空值
    End If
    
    '此节重写，以适应 随便输入
    
    If IsNumeric(s2) Then
    If Len(s2) = 4 Then
    
z = Val(s2)
a1 = Int(z / 1000)
b1 = Int((z - a1 * 1000) / 100)
c1 = Int((z - a1 * 1000 - b1 * 100) / 10)
d1 = z - a1 * 1000 - b1 * 100 - c1 * 10
        
        If a1 <> b1 And a1 <> c1 And a1 <> d1 and b1 <> c1 and b1 <> d1 and c1 <> d1 Then
            Exit Do
        End If
    End If
    End If
    
MsgBox "您输入错误了，记住，您要猜的是一个4个数字都不相同的四位数。请重新输入吧！", vbCritical, "输入错误"

Loop

'If z = e Then Print "   您太聪明能干了，您猜对了，这个数字就是"; e; "。": GoTo 150

If z = e Then
    MsgBox "您太聪明能干了，您猜对了，这个数字就是" & e & "。", vbInformation, "胜利"
    Exit Do
Else

End If

'n = 0
'm = 0
'q = 0
'w = 0
'o = 0
'r = 0
't = 0
'y = 0
'If a1 = a Then m = 1 Else If a1 = b Then n = 1 Else If a1 = c Then n = 1 Else If a1 = d Then n = 1
'If b1 = a Then q = 1 Else If b1 = b Then w = 1 Else If b1 = c Then q = 1 Else If b1 = d Then q = 1
'If c1 = a Then o = 1 Else If c1 = b Then o = 1 Else If c1 = c Then r = 1 Else If c1 = d Then o = 1
'If d1 = a Then t = 1 Else If d1 = b Then t = 1 Else If d1 = c Then t = 1 Else If d1 = d Then y = 1
'm1 = 0
'n1 = 0
'm1 = m + w + r + y
'n1 = n + q + o + t

n = 0
m = 0
q = 0
w = 0
o = 0
r = 0
t = 0
y = 0
If a1 = a Then m = 1 Else If a1 = b Then n = 1 Else If a1 = c Then n = 1 Else If a1 = d Then n = 1
If b1 = a Then q = 1 Else If b1 = b Then w = 1 Else If b1 = c Then q = 1 Else If b1 = d Then q = 1
If c1 = a Then o = 1 Else If c1 = b Then o = 1 Else If c1 = c Then r = 1 Else If c1 = d Then o = 1
If d1 = a Then t = 1 Else If d1 = b Then t = 1 Else If d1 = c Then t = 1 Else If d1 = d Then y = 1
m1 = 0
n1 = 0
m1 = m + w + r + y
n1 = n + q + o + t

'Print "   这是您第"; k; "次猜数，可惜了，不对，这次的提示是"; m1; "A"; n1; "B"
'GoTo 5

s1 = s1 & vbCrLf & "您第" & k & "次猜：" & z & "，可惜错了，提示：" & m1 & "A" & n1 & "B"
's1 = s1 & "可惜了，提示" & m1 & "A" & n1 & "B"

Loop While k < 8

'100 Print "   不好意思，在8次机会里您都没有猜对这个数字，真遗憾！这个数字是"; e; "。"
'150 INPUT "   重玩一次请输入(Y/y)，不想玩了请输入(N/n)"; h$

If k >= 8 Then
    s1 = s1 & vbCrLf & "不好意思，在8次机会里您都没有猜对这个数字，真遗憾！这个数字是" & e & "。"
Else
    s1 = "恭喜您猜对啦！"
End If

s1 = s1 & vbCrLf & vbCrLf & "重玩一次？"

'If h$ = "Y" Or h$ = "y" Then GoTo 2 Else If h$ = "N" Or h$ = "n" Then GoTo 200 Else Print "您输入错误，请重新输入!": GoTo 150


If MsgBox(s1, vbYesNo, "重玩？") = vbNo Then
    Exit Do
End If

Loop

'200 End

End Sub

重写了 对输入判断部分。需要严格限制。否则很容易导致超过 整数范围。

[ 本帖最后由 风吹过b 于 2012-10-19 11:28 编辑 ]

泪奔，虽然是很感激了，可是，兄弟，求给个可执行文件，难道要我去下VB6，安装起来，再去学学导入模块，生成文件？

我是 WIN7环境，为了写这个代码，临时去下个 VB6 ，然后写这个代码，然后发贴，然后不保存本在代码。

更。。。。。。。。。。。。。。。。。。




更新 胜利时的BUG。

[ 本帖最后由 风吹过b 于 2012-10-19 10:53 编辑 ]

相对 前面 发的代码 ，只 改短了 每次 的提示，以便适应  inputbox 的固定宽度。
更新了 胜利时的提示 错误的 BUG

[ 本帖最后由 风吹过b 于 2012-10-19 10:54 编辑 ]

好人啊，所以感激你。谢了，终于完成个小心愿。

恩，刚试了下，有个小bug 在第4次就猜对了，跳出成功提示了，但接着没跳回重玩。还在第五次输入提示下

重下吧。刚更新过了。 前面是直接仿写的，没测试这部分。

输入大于9999的数会出错，跳出

那再改吧。我知道问题所在了。

ok了。兄弟，不错，程序不错，人也不错，但我老了，眼花啊，能把窗体放大点嘛，关键是字要大点啊。