1. 业奇农业网 > 百科 >

VB高手进

如果只是编个程序还可以,

VB高手进

还需要那么多附加的东西,很麻烦.

将下面所有的文字,复制到 记事本 里,

把文件保存为 csz.txt,再把扩展名改为 .frm

即最终文件全名为: csz.frm

然后,在装有VB6.0的机器上双击就可以了.

VERSION 5.00

Begin VB.Form Form1

BorderStyle = 1 'Fixed Single

Caption = "猜数字"

ClientHeight = 3480

ClientLeft = 45

ClientTop = 330

ClientWidth = 5970

linkTopic = "Form1"

MaxButton = 0 'False

MinButton = 0 'False

ScaleHeight = 3480

ScaleWidth = 5970

StartUpPosition = 2 '屏幕中心

Begin VB.CommandButton Command1

Caption = "帮 助"

Height = 375

Left = 4140

TabIndex = 12

Top = 2700

Width = 795

End

Begin VB.OptionButton opbDH

Caption = "显示代号"

Height = 255

Left = 4200

TabIndex = 6

Top = 2280

Width = 1455

End

Begin VB.OptionButton opbWZ

Caption = "显示文字"

Height = 255

Left = 4200

TabIndex = 5

Top = 1980

Value = -1 'True

Width = 1455

End

Begin VB.CommandButton cmdTC

Caption = "退 出"

Height = 375

Left = 4980

TabIndex = 8

Top = 2700

Width = 795

End

Begin VB.TextBox txtGC

BackColor = &H00C0C0C0&

Height = 2955

Left = 120

MultiLine = -1 'True

ScrollBars = 2 'Vertical

TabIndex = 7

Top = 120

Width = 3735

End

Begin VB.CommandButton cmdCS

Caption = "猜数"

Height = 375

Left = 5040

TabIndex = 4

Top = 1440

Width = 675

End

Begin VB.CommandButton cmdNEW

Caption = "新 题 目"

Height = 375

Left = 4080

TabIndex = 1

Top = 120

Width = 1635

End

Begin VB.TextBox txtCS

Alignment = 2 'Center

BeginProperty Font

Name = "宋体"

Size = 18

Charset = 134

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 435

Left = 4080

MaxLength = 4

TabIndex = 0

Top = 1380

Width = 855

End

Begin VB.CommandButton cmdCK

Caption = "查看"

Height = 375

Left = 5040

TabIndex = 3

Top = 780

Width = 675

End

Begin VB.Label lblCS

Alignment = 2 'Center

Caption = "0"

Height = 195

Left = 1200

TabIndex = 10

Top = 3180

Width = 495

End

Begin VB.Label Label2

Caption = "469876252@qq.COM"

Height = 195

Left = 4200

TabIndex = 9

Top = 3180

Width = 1515

End

Begin VB.Label lblSWS

Alignment = 2 'Center

BorderStyle = 1 'Fixed Single

BeginProperty Font

Name = "宋体"

Size = 18

Charset = 134

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 435

Left = 4080

TabIndex = 2

Top = 720

Width = 855

End

Begin VB.Label Label1

Caption = "猜数次数:"

Height = 195

Left = 180

TabIndex = 11

Top = 3180

Width = 915

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 sws As String '储存 四位数 的字符串

Dim cs As Long '猜数的 次数

Private Sub cmdCK_Click()

lblSWS.Caption = sws

End Sub

Private Sub cmdCS_Click()

Dim ts As String, txt As String, txtW(4) As Integer

Dim n As Integer, zqs As Integer, zqsw As Integer

ts = "请输入四位不重复的数字"

txt = txtCS.Text

'判断是否是四个字符

If Len(txt) <> 4 Then MsgBox ts: Exit Sub

For n = 1 To 4

txtW(n) = Mid(txt, n, 1)

Next n

'判断是否是四个数字

If Asc(txtW(1)) < 48 Or Asc(txtW(1)) > 57 Or Asc(txtW(2)) < 48 Or Asc(txtW(2)) > 57 Or Asc(txtW(3)) < 48 Or Asc(txtW(3)) > 57 Or Asc(txtW(4)) < 48 Or Asc(txtW(4)) > 57 Then MsgBox ts: Exit Sub

'判断是否有重复数字

If txtW(1) = txtW(2) Or txtW(1) = txtW(3) Or txtW(1) = txtW(4) Or txtW(2) = txtW(3) Or txtW(2) = txtW(4) Or txtW(3) = txtW(4) Then MsgBox ts: Exit Sub

For n = 1 To 4

If InStr(sws, txtW(n)) <> 0 Then zqs = zqs + 1

If Mid(sws, n, 1) = txtW(n) Then zqsw = zqsw + 1

Next n

If cs = 0 Then txtGC.Text = ""

cs = cs + 1

lblCS.Caption = CStr(cs)

If opbWZ.Value Then

txtGC.Text = txtGC.Text + txt + vbTab + CStr(zqs) + "个数字正确,其中" + CStr(zqsw) + "个位置也正确" + vbCrLf

Else

txtGC.Text = txtGC.Text + txt + vbTab + CStr(zqs) + "A" + CStr(zqsw) + "B" + vbCrLf

End If

If zqsw = 4 Then lblSWS.Caption = sws: MsgBox "恭喜你!你部猜中!" + vbCrLf + "猜测次数:" + CStr(cs) + vbCrLf + vbCrLf + "开始新题目!": cmdNEW_Click

End Sub

Private Sub cmdNEW_Click()

'生成新的四位数,并设置各控件的显示值

Dim sz As String

Dim n As Integer, sjs As Integer

sz = "1234567890"

Randomize Timer

sws = ""

For n = 1 To 4

sjs = Int(Rnd * Len(sz)) + 1

sws = sws + Mid(sz, sjs, 1)

sz = Left(sz, sjs - 1) + Right(sz, Len(sz) - sjs)

Next n

cs = 0

lblSWS.Caption = ""

txtGC.Text = ""

lblCS.Caption = CStr(cs)

End Sub

Private Sub cmdTC_Click()

Unload Me

End Sub

Private Sub Form_Load()

cmdNEW_Click

txtGC.Text = "查看 按钮,可以先查看数字" + vbCrLf + "用于在游戏过程中 做弊" + vbCrLf + "如果不需要这个功能,可以将按钮的" + vbCrLf + "Visible 属性设置为 False"

End Sub

Private Sub txtCS_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

cmdCS_Click

txtCS.SelStart = 0

txtCS.SelLength = 4

End If

End Sub

就是猜数字游戏嘛,您上面没写清,四位数字都是0-9的吧 不超过10

Private Sub form_Click()

Dim a(3), b(3), i, j, k, tmp, tmp1 As String, p As Boolean, A1, B1

Randomize

For i = 0 To 3

a(i) = Int(Rnd * 10)

For k = 0 To i - 1

If a(i) = a(k) Then i = i - 1

Next k

Debug.Print a(i),

Next i

For i = 1 To 8

tmp = InputBox("请输入四位不同的数字(0-9)" & vbnewline & "输入为空或取消则中止运行。", "这是第" & i & "次猜题")

If tmp = "" Then Exit Sub

p = False

If Len(Trim(tmp)) = 4 Then

For j = 1 To 4

tmp1 = Mid(tmp, j, 1)

If tmp1 >= "0" And tmp1 <= "9" Then

b(j - 1) = Val(tmp1)

For k = 1 To j - 1

If b(j - 1) = b(k - 1) Then

p = True

Exit For

End If

Next k

Else

p = True: Exit For

End If

Next j

Else

p = True

End If

If p Then

MsgBox "输入数据相同或非法!请再试一次!", , "猜数字"

i = i - 1

Else

A1 = 0: B1 = 0

For k = 0 To 3

If a(k) = b(k) Then

A1 = A1 + 1

Else

For j = 0 To 3

If a(k) = b(j) Then B1 = B1 + 1

Next j

End If

Next k

Print i, tmp, A1 & "A" & B1 & "B"

If A1 = 4 Then

MsgBox tmp & "恭喜你!你猜得完全正确!", , "猜数字"

Exit Sub

End If

End If

Next i

End Sub

本文由用户上传,如有侵权请联系删除!转转请注明出处:https://nongye.s666.cn/bk/6_6572056605.html