(2010-12-29 00:24:18, Size: 320 KB, Downloads: 116)
[ 本帖最后由 笨巧果 于 2010-12-29 19:21 编辑 ]
10.12.29VBA二十四点游戏素材
笨巧果 发表于: 2010-12-29 00:24 来源: 扑奔PPT网
[ 本帖最后由 笨巧果 于 2010-12-29 19:21 编辑 ]
大家对 10.12.29VBA二十四点游戏素材 的评论
最新PPT模板
最新贴子
PPT热贴
笨巧果 发表于: 2010-12-29 00:24 来源: 扑奔PPT网
(2010-12-29 00:24:18, Size: 320 KB, Downloads: 116)
Dim card(1 To 4)
Dim num(1 To 4)
Dim nu(1 To 4)
Private Sub chenghao_Click()
TextBox1.Text = TextBox1.Text & "×" '添加乘号
jiahao.Enabled = False
jianhao.Enabled = False
chenghao.Enabled = False
chuhao.Enabled = False '运算符号失效
End Sub
Private Sub chuhao_Click()
TextBox1.Text = TextBox1.Text & "÷" '添加除号
jiahao.Enabled = False
jianhao.Enabled = False
chenghao.Enabled = False
chuhao.Enabled = False '运算符号失效
End Sub
Private Sub chuti_Click() '出题
TextBox1.Text = ""
Randomize
card(1) = Int(Rnd * 13) + 1
card(2) = Int(Rnd * 13) + 14
card(3) = Int(Rnd * 13) + 27
card(4) = Int(Rnd * 13) + 40 '随机产生四张牌的文件号
num(1) = card(1) Mod 13
num(2) = card(2) Mod 13
num(3) = card(3) Mod 13
num(4) = card(4) Mod 13
If num(1) = 0 Then num(1) = 13
If num(2) = 0 Then num(2) = 13
If num(3) = 0 Then num(3) = 13
If num(4) = 0 Then num(4) = 13 '生成四张牌的牌面数值
Image1.Enabled = True
Image2.Enabled = True
Image3.Enabled = True
Image4.Enabled = True '使图片框生效
ss = ActivePresentation.Path
Image1.Picture = LoadPicture(ss & "\cards\" & card(1) & ".jpg")
Image2.Picture = LoadPicture(ss & "\cards\" & card(2) & ".jpg")
Image3.Picture = LoadPicture(ss & "\cards\" & card(3) & ".jpg")
Image4.Picture = LoadPicture(ss & "\cards\" & card(4) & ".jpg") '显示四张牌的图像
SlideShowWindows(1).View.First
End Sub
Private Sub kandaan_Click()
zt = "看答案" '记录按钮状态
For i = 1 To 4
nu(i) = num(i)
Next
Call jielun '调用子程序
End Sub
Private Sub queding_Click()
If Image1.Enabled = False And Image2.Enabled = False And Image3.Enabled = False And Image4.Enabled = False Then '判断四张票是否全部使用
s = Replace(Replace(Replace(Replace(TextBox1.Text, "＋", "+"), "－", "-"), "×", "*"), "÷", "/") '将运算符号替换为计算机可以识别的运算符号
jieguo = Val(Arthmetic(s)) '调用计算程序，得到计算结果
If Abs(jieguo - 24) < 0.000000001 Then '判断结果是否是24
MsgBox "正确！"
Call chuti_Click
Else
MsgBox "错误！"
End If
Else
MsgBox "您的牌没有用完！"
End If
End Sub
Private Sub Image1_Click()
TextBox1.Text = TextBox1.Text & num(1) '将牌面数值放入文本框
Image1.Enabled = False
Image1.Picture = LoadPicture(ss & "\cards\cover.jpg") '调用背面图片，使图片框失效，该张牌无法点击
SlideShowWindows(1).View.First '刷新屏幕
jiahao.Enabled = True
jianhao.Enabled = True
chenghao.Enabled = True
chuhao.Enabled = True '运算符号生效
End Sub
Private Sub Image2_Click()
TextBox1.Text = TextBox1.Text & num(2) '将牌面数值放入文本框
Image2.Enabled = False
Image2.Picture = LoadPicture(ss & "\cards\cover.jpg") '调用背面图片，使图片框失效，该张牌无法点击
SlideShowWindows(1).View.First '刷新屏幕
jiahao.Enabled = True
jianhao.Enabled = True
chenghao.Enabled = True
chuhao.Enabled = True '运算符号生效
End Sub
Private Sub Image3_Click()
TextBox1.Text = TextBox1.Text & num(3) '将牌面数值放入文本框
Image3.Enabled = False
Image3.Picture = LoadPicture(ss & "\cards\cover.jpg") '调用背面图片，使图片框失效，该张牌无法点击
SlideShowWindows(1).View.First '刷新屏幕
jiahao.Enabled = True
jianhao.Enabled = True
chenghao.Enabled = True
chuhao.Enabled = True '运算符号生效
End Sub
Private Sub Image4_Click()
TextBox1.Text = TextBox1.Text & num(4) '将牌面数值放入文本框
Image4.Enabled = False
Image4.Picture = LoadPicture(ss & "\cards\cover.jpg") '调用背面图片，使图片框失效，该张牌无法点击
SlideShowWindows(1).View.First
jiahao.Enabled = True
jianhao.Enabled = True
chenghao.Enabled = True
chuhao.Enabled = True '运算符号生效
End Sub
Private Sub jiahao_Click()
TextBox1.Text = TextBox1.Text & "＋" '添加加号
jiahao.Enabled = False
jianhao.Enabled = False
chenghao.Enabled = False
chuhao.Enabled = False '运算符号失效
End Sub
Private Sub jianhao_Click()
TextBox1.Text = TextBox1.Text & "－" '添加减号
jiahao.Enabled = False
jianhao.Enabled = False
chenghao.Enabled = False
chuhao.Enabled = False '运算符号失效
End Sub
Private Sub qingkong_Click()
On Error Resume Next '当发生错误时，跳到下一条语句继续执行
TextBox1.Text = "" '清空文本框
Image1.Enabled = True
Image2.Enabled = True
Image3.Enabled = True
Image4.Enabled = True '使图片框生效
ss = ActivePresentation.Path
Image1.Picture = LoadPicture(ss & "\cards\" & card(1) & ".jpg")
Image2.Picture = LoadPicture(ss & "\cards\" & card(2) & ".jpg")
Image3.Picture = LoadPicture(ss & "\cards\" & card(3) & ".jpg")
Image4.Picture = LoadPicture(ss & "\cards\" & card(4) & ".jpg") '显示四张牌的图像
SlideShowWindows(1).View.First
End Sub
Private Sub wujie_Click()
zt = "无解" '记录按钮状态
For i = 1 To 4
nu(i) = num(i)
Next
Call jielun '调用子程序
End Sub
Private Sub youkuohao_Click()
TextBox1.Text = TextBox1.Text & ")" '添加右括号
End Sub
Private Sub zuokuohao_Click()
TextBox1.Text = TextBox1.Text & "(" '添加左括号
End Sub
Sub jielun() '输出结论
For i = 1 To 3
For j = i + 1 To 4
If nu(i) > nu(j) Then
temp = nu(i)
nu(i) = nu(j)
nu(j) = temp
End If
Next
Next '对四张牌的牌面数值进行排序
str1 = nu(1) & " " & nu(2) & " " & nu(3) & " " & nu(4)
fid = FreeFile
Open ActivePresentation.Path & "\da.dll" For Input As fid
Do While Not EOF(fid)
Line Input #fid, str2
If InStr(str2, str1) <> 0 Then
jl = Trim(Replace(str2, str1 & ":", ""))
If zt = "看答案" Then
MsgBox jl
Call chuti_Click
End If
If zt = "无解" And jl = "无解" Then
MsgBox "正确！"
Call chuti_Click
End If
If zt = "无解" And jl <> "无解" Then MsgBox "错误！"
Exit Sub
End If
Loop '查询24点计算结果
End Sub
Dim m(10) As String '可随意改变数组的上限，这里可执行2位的算术
Dim i, j As Integer '全局申明
Dim add As String
Dim count As Integer
count = 0
Dim v As Integer
'begin
'执行括号域分离
'再次调用本程序,即递归
Dim ch
Do
ch = InStr(s, ")") '查找")"以便识别括号内容
If ch <> 0 Then
For j = ch To 1 Step -1
If Mid(s, j, 1) = "(" Then '找到后在往前识别"("
Dim before As String
before = Mid(s, j + 1, ch - j - 1) '收集括号的内容
Dim after As String
after = "(" & before & ")"
Dim mm As String
mm = Arthmetic(before)
s = Replace(s, after, mm) '收集包括括号的内容
Exit For
End If
Next
Else
If ch = 0 Then '当找不到）是退出循环，不会进入死循环
Exit Do
End If
End If
Loop
'===============过滤了符号下一处理是式子里没有括号=======================================
'=========================将字符和运算符号分离==========================================
For i = 1 To Len(s) '把符号和数字分开呈数组
Dim check As String
check = Mid(s, i, 1)
If check = "*" Or check = "/" Or check = "-" Or check = "+" Then '在四则运算中判断符号
If Mid(add, 1, 1) = "M" Then
add = "-" & Mid(add, 2, Len(add) - 1)
End If
m(count) = add
count = count + 1 '组织数组的项的完整性
m(count) = check
add = ""
check = ""
count = count + 1
End If
add = add + check
If i = Len(s) Then
If Mid(add, 1, 1) = "M" Then
add = "-" & Mid(add, 2, Len(add) - 1)
End If
m(count) = add '累积数字成数字
End If
Next
'===================================乘除运算==============================不算加减保留
Do
Dim fu As Integer '检查是否还有*或/的符号，以便再次调用方法
fu = 0
For i = 1 To count
If m(i) = "*" Or m(i) = "/" Then
fu = i
Exit For
End If
If i = count Then
fu = 0 '没有符号是发出信号该下一句
End If
Next
If fu <> 0 Then
If m(fu) = "*" Then
m(fu - 1) = Val(m(fu - 1)) * Val(m(fu + 1)) '单目乘法
End If
If m(fu) = "/" Then
m(fu - 1) = Val(m(fu - 1)) / Val(m(fu + 1)) '单目除法
End If
For i = fu To count - 2 '把数组空的部位给后面的数组填充
m(i) = m(i + 2)
Next
m(i) = ""
m(i + 1) = ""
count = count - 2 '删除多余的数组
Else
Exit Do '跳出循环
End If
Loop
'最后把一条只有加减法的算式提供给下一子程序
'=====================加减法运算================================子程序
Dim n As Integer
n = 1
Do
If m(n) = "+" Or m(n) = "-" Then
If m(n) = "+" Then
m(n - 1) = Val(m(n - 1)) + Val(m(n + 1)) '执行加法
End If
If m(n) = "-" Then
m(n - 1) = Val(m(n - 1)) - Val(m(n + 1)) '执行减法
End If
For i = n To count - 2
m(i) = m(i + 2) '缩减数组长度，便于答案析出
Next
m(count) = ""
m(count - 1) = "" '剪掉后面无用项
count = count - 2
If m(n) <> "+" And m(n) <> "-" Then '跳出循环
Exit Do '关闭循环
End If
Else
Exit Do
End If
Loop
If Mid(m(0), 1, 1) = "-" Then
m(0) = "M" & Mid(m(0), 2, Len(m(0)) - 1)
End If
Arthmetic = m(0) '显示答案返回给调用的程序
Exit Function
End Function
24点.jpg
799 KB, 下载次数: 83)