ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
EH云课堂-专业的职场技能充电站 限时送,魔方网表将Excel变在线系统 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 7378|回复: 21

[Excel 程序开发] [第15期]斗地主(已结题)

[复制链接]

TA的精华主题

TA的得分主题

发表于 2006-9-7 11:05 | 显示全部楼层 |阅读模式

本期题目比较简单:

三个玩家斗地主,每人17张牌,留3张底。

试设置一个按钮,每点击一次,在A2:C18(甲乙丙),D2:D4(底)随机生成一副斗地主牌局,如上图所示。

要求一定是花色和点数准确,随机排列。(花色符号可在字体 Arial Unicode MS中寻找)

1. 完成以上功能得2分

2 如果能动态演示发牌过程(间隔0.2秒),加1分

3 优秀代码还可获1分奖励

附:

符号字体  Arial Unicode MS

UNICODE 编码:

王的符号:  265B

黑桃:         2660

红桃:         2665

草花:         2663

方块:         2666

总结:

本期题目确实比较简单。

动态发牌过程,统计了一下,大致有WAIT方法,API SLEEP方法,API SETTIMER,KILLTIMER方法,TIMER方法。WAIT方法精度不够。

花色设置有的网友先予存后复制的方法,这不是题目的初衷,怪我没说清楚。

最近比较忙,今天才总结评分,请大家谅解。

附我的代码:

Sub doudizhu()
Dim i As Byte, N As Byte, K As Byte, CARD As New Collection, t As Single
[A2:D18].Clear
[A2:D18].Font.Name = "Arial Unicode MS"
[A2:D18].Font.Size = 16
CARD.Add "3[&王"
CARD.Add "0U&王"
For i = 0 To 51
CARD.Add 3 * (i \ 26) & Mid("`cef", i \ 13 + 1, 1) & "&" & Replace(Mid("0A23456789JQK", 1 + i Mod 13, 1), "0", "10")
Next
Randomize
For i = 0 To 50
        t = Timer
        Do While Timer - t < 0.2
        Loop
K = Int(CARD.Count * Rnd) + 1
[a2].Offset(i \ 3, i Mod 3) = StrConv(Mid(CARD(K), 2, 2), vbFromUnicode) & Mid(CARD(K), 4)
[a2].Offset(i \ 3, i Mod 3).Font.ColorIndex = Left(CARD(K), 1)
CARD.Remove K
Next
For i = 1 To 3
[D1].Offset(i, 0) = StrConv(Mid(CARD(i), 2, 2), vbFromUnicode) & Mid(CARD(i), 4)
[D1].Offset(i, 0).Font.ColorIndex = Left(CARD(i), 1)
Next
End Sub

[此贴子已经被作者于2006-10-11 14:44:02编辑过]

TA的精华主题

TA的得分主题

发表于 2006-9-7 13:56 | 显示全部楼层

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2006-9-7 23:58 | 显示全部楼层

我先发一个。


Timer 用的巧妙。下面的部分用赋值语句就可以了,不必专门设一个函数

Function F2(n As Integer) As Integer
    Randomize
    F2 = Int(Rnd() * n) + 1
End Function

[此贴子已经被northwolves于2006-10-10 22:40:43编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?免费注册

x

评分

参与人数 1鲜花 +1 收起 理由
EXCEL20022002 + 1 太强大了

查看全部评分

TA的精华主题

TA的得分主题

发表于 2006-9-8 14:10 | 显示全部楼层

凑个热闹,简化处理了一下,做了一个列表,然后复制过去。我不是很清楚动态发牌是一个什么效果,所以也没往下做了,不过我给随机数在每组里排了一下序,这样牌看起来才舒服一点。

Private Sub CommandButton1_Click()
    Dim i%, m%, n%
    Dim h As New Collection
    Const iMax% = 54
    Dim rng As Range

    On Error Resume Next
    Do
        i = Int(Rnd() * iMax) + 1
        h.Add CStr(i), CStr(i)
    Loop Until h.Count = iMax    '产生1~54的不重复的随机值的集合
    Err.Clear
    On Error GoTo 0

    n = 1: m = 1
    For i = 1 To iMax    ' 在集合里循环,取17、17、17、3这四个区域,然后复制对应的内容过去
        If rng Is Nothing Then
            Set rng = Cells(h(i), "h")
        Else
            Set rng = Union(rng, Cells(h(i), "h"))
        End If

        m = m + 1
        If m > 17 Or i = iMax Then
            rng.Copy Cells(2, n)
            '如果要逐个发过去的话,在这里可以对rng进行循环,一个一个××过去
            n = n + 1: m = 1
            Set rng = Nothing
        End If
    Next
End Sub
说句题外话,最近酷爱斗地主,在联众里混了一个小“佃户”,呵呵

同一张牌发给了两个人,龙三兄检查一下代码:

29
221◆9
◆21◆18
1KK
◆KKQ

[sorry,在设置54张牌时出错,没有设置黑桃(都成梅花了),代码没有问题]

[此贴子已经被作者于2006-10-12 16:03:10编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2006-9-9 18:12 | 显示全部楼层

交卷


花兄代码很简练

Private Sub Fapai_Click()
    Dim h%, l%, r%, i%
    Range("a2:d18").ClearContents
    Sheet2.Range("a1:a54").Copy Sheet2.Range("b1:b54")
    Randomize
    For i = 0 To 53
        h = IIf(i < 51, i \ 3 + 2, i - 49)
        l = IIf(i < 51, (i Mod 3) + 1, 4)
        r = Int(Rnd * (54 - i) + 1)
        With Sheet2.Range("b" & r)
            .Copy Cells(h, l)
            .Delete Shift:=xlUp
        End With
        t = Timer
        Do While Timer - t < 0.2
        Loop
    Next
End Sub

[此贴子已经被northwolves于2006-10-10 22:55:27编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?免费注册

x

评分

参与人数 1鲜花 +1 收起 理由
EXCEL20022002 + 1 太强大了,10年了一直把花胸当女的 ^_^

查看全部评分

TA的精华主题

TA的得分主题

发表于 2006-9-11 15:23 | 显示全部楼层

先做个函数版本,有时间再做VBA版本^^


数组函数+条件格式,思路清晰,鼓励一下

=IF(DATA>0,IF(DATA>52,IF(DATA=53,"小王","大王"),INDEX({"红桃","黑桃","方块","草花"},0,ROUNDUP(DATA/13,0)) & INDEX({"A","2","3","4","5","6","7","8","9","10","J","Q","K"},0,MOD(DATA,13)+1)),"")

[此贴子已经被northwolves于2006-10-10 23:01:22编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2006-9-15 21:22 | 显示全部楼层

题目既然如狼版主说的比较简单,就想着变点花样出来,做了两种发牌效果(其实第二种是第一种的进一步发挥),本人VBA菜鸟,现学现做的,献丑了:


说点题外话,这个题目让我回忆起了高一时候学Basic时的一些事情。那时学校里有一丁点电脑课程,其中Basic大约有个7、8个课时。初学了一点编程的入门,最想做的项目就是牌类游戏。当时就自己编了一个21点(BlackJack)的游戏程序,由于上机条件在当时几乎为零,所以所有的编程工作都是在纸上完成的,整个程序大约有3、400行语句(记不清了),所有的修改调试就是在脑子里和纸上完成的。最后,有个休息天借了邻居的中华学习机来,里面有QBasic(跟Basic差不多)的编程环境,把纸上的代码全部输入,结果几乎没有再修改调试就基本测试成功了。当时真的挺开心的。

所以感觉学编程,做游戏,总还是牌类游戏比较容易上手。可惜的是,到现在年纪奔三了却还没真正的学过一门完整的编程语言。[em04]

 

chrisfang兄弟对于任何问题都分析透彻,奇思妙想,这种态度很令人钦佩。发牌过程做得很不错。

[em07][em07][em07][em07][em07]
[此贴子已经被northwolves于2006-10-11 9:17:56编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2006-9-16 00:12 | 显示全部楼层

没找到符号,用中文代替了


lg_cai兄的代码组织得很好,学习。

[此贴子已经被northwolves于2006-10-11 9:23:55编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2006-9-17 19:43 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2006-9-20 20:30 | 显示全部楼层

不知道这么快就公布答案了,刚做完的,发上来,未实现大小王颜色区分,请指教!

[此贴子已经被作者于2006-9-21 8:19:49编辑过]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?免费注册

x
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-3-21 01:45 , Processed in 1.213135 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表