exe版麻将游戏，人机对战！！

HHAAMM

更新了，看一楼说明

veryseller

太厉害了

detergent181

怎么看不到代码呢？

HHAAMM

错误找到，等下改

HHAAMM

解决了听牌时出错牌的问题

HHAAMM

哈哈，有时还赢不过机器那

彭希仁

麻将用机器来算,比人会陪明很多

china047

先做个记号，今天没带U盘，明天再下载！！！

HHAAMM

全部代码
'透明
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'播放
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Private Declare Function sndPlaySoundFromMemory Lib "winmm.dll" Alias "sndPlaySoundA" (lpszSoundName As Any, ByVal uFlags As Long) As Long
Const SND_SYNC = &H0 '同步调用,声音播放完毕,程序才能继续
Const SND_ASYNC = &H1 '非同步调用,不必等声音播放完毕,程序即可继续
Const SND_LOOP = &H8 '声音播放完毕后,从头重复播放,与SND_ASYNC(=&H1)使用
Const SND_NOSTOP = &H10 '如果其他声音正在播放,则不终止该声音的播放，而返回False
Const SND_MEMORY = &H4 '播放内存中的声音
Dim bArr() As Byte
'暂停
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'给动态添加的控件添加事件
Private WithEvents btnObj As CommandButton
'记录已经使用的个数
Dim GeSu()
'窗体移动
Dim CTYD As Boolean
'听牌限制
Dim TPAIXIANZICANSU As Boolean
'窗体加载
Private Sub Form_Load()
    Dim rtn As Long, A As Integer
    Me.BackColor = &HFF0000
    BorderStyler = 0
    rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
    rtn = rtn Or WS_EX_LAYERED
    SetWindowLong hwnd, GWL_EXSTYLE, rtn
    SetLayeredWindowAttributes hwnd, &HFF0000, 0, LWA_COLORKEY
    A = 1111
    For i = 0 To Image3.Count - 1
        Image3(i).Left = A
        Image3(i).Top = 7300
        Image4(i).Left = A
        Image4(i).Top = 500
        A = A + 367
    Next
End Sub
'单击头像
Private Sub Image1_Click()
    Dim i%, j%, t%, b As Boolean
    Dim A(13) As Integer
    If Label7 = "点击听牌" Then MsgBox "  要先听牌", , "系统提示！！": Exit Sub
        For i = 0 To Text1.Count - 1
            A(i) = Val(Text1(i).Text)
            If A(i) < 28 Then
                A(i) = Int(A(i) / 9.001) * 100 + A(i)
            Else
                A(i) = Int(A(i) / 9.001) * 100 + A(i) * 6
            End If
        Next i
        HUPAI A, b
        If b Then
            Label4.Caption = "开"
            bArr = LoadResData(137, "CUSTOM")
            sndPlaySoundFromMemory bArr(0), SND_ASYNC Or SND_MEMORY
        End If
End Sub

'单击牌
Private Sub Image3_Click(Index As Integer)
    Dim A As String
    If Text1(13).Text = "" Or Label4.Caption = "开" Then Exit Sub
    If TPAIXIANZICANSU = True Then
        CHUANGJIAN Val(Text1(13).Text)
        Text1(13).Text = ""
    Else
        If Label7 = "已经听牌" Then TPAIXIANZICANSU = True
        A = Text1(Index).Text
        Text1(Index).Text = Text1(13).Text
        Text1(13).Text = ""
        PAIXU "Text1"
        CHUANGJIAN Val(A) '创建
    End If
    Timer1.Interval = 1
End Sub
'单击网址
Private Sub Label1_Click()
    Shell "C:\Program Files\Internet Explorer\IEXPLORE.EXE " & "http://club.excelhome.net/index.php"
End Sub
'单击退
Private Sub Label3_Click()
    End
End Sub
'单击开
Private Sub Label4_Click()
    Dim i As Integer, lngCount As Integer
    If Label4.Caption = "！" Then Exit Sub
    lngCount = Image5.UBound
    For i = 1 To lngCount
        Unload Image5(i)
    Next
    Text4 = 1111: Text5 = 1600: Text6.Text = "": Text7.Text = ""
    ReDim GeSu(1 To 34)
    Label4.Caption = "！"
    Label7 = "点击听牌"
    TPAIXIANZICANSU = False
    Image3(13).Picture = LoadPicture("")
    Image4(13).Picture = LoadPicture("")
    For i = 0 To 34
        m = m & i & ","
    Next
    Text3.Text = Mid(m, 1, Len(m) - 1)
    For i = 0 To Image3.Count - 2
        Text1(i).Text = SUIJISHU
        Text2(i).Text = SUIJISHU
    Next
    PAIXU "Text1"
    PAIXU "Text2"
    Timer1.Interval = 10
End Sub

'文本框1
Private Sub Text1_Change(Index As Integer)
    If Text1(Index).Text <> "" Then
        Image3(Index).Picture = ImageList1.ListImages(Val(Text1(Index).Text)).Picture
    Else
        Image3(Index).Picture = LoadPicture("")
    End If
End Sub

HHAAMM

'文本框2
Private Sub Text2_Change(Index As Integer)
    Dim i%, j%, k%, t%, b As Boolean, m%, m1$, m2$, n%, g%, TTEEXXTT As String, MM$, tt%
    Dim A() As Integer, A34() As String, JA(13) As Integer, c() As Integer, BM1() As String, BM2() As String, BCF() As String, GDS() As Integer, SULIANG() As Integer
    ReDim A(13)
        If Text2(Index).Text <> "" Then
            Image4(Index).Picture = ImageList1.ListImages(Val(Text2(Index).Text)).Picture
            If Index = 13 Then
                DoEvents
                Sleep (266)
                For i = 0 To Text2.Count - 1
                    A(i) = Val(Text2(i).Text)
                    If A(i) < 28 Then
                        A(i) = Int(A(i) / 9.001) * 100 + A(i)
                    Else
                        A(i) = Int(A(i) / 9.001) * 100 + A(i) * 6
                    End If
                Next i
                HUPAI A, b
                If b Then
                    Label4.Caption = "开"
                    bArr = LoadResData(137, "CUSTOM")
                    sndPlaySoundFromMemory bArr(0), SND_ASYNC Or SND_MEMORY
                    DoEvents
                    Sleep (1200)
                    Exit Sub
                End If
                If Text6.Text = "听牌" Then
                    CHUANGJIAN Val(Text2(13).Text)
                    Text2(13).Text = ""
                End If
                If Len(Text3.Text) < 3 Then Exit Sub
                If Text6.Text <> "听牌" Then
                    A34 = Split(Text3.Text, ",") '调用胡牌函数，找出所有能胡的牌，再在已经打掉的牌中查找剩余最多的，然后听牌
                    For i = 0 To 13
                        If A(i) <> t Then
                            t = A(i)
                            For j = 1 To UBound(A34)
                                m = Val(A34(j))
                                If m < 28 Then
                                    m = Int(m / 9.001) * 100 + m
                                Else
                                    m = Int(m / 9.001) * 100 + m * 6
                                End If
                                For g = 0 To 13
                                    JA(g) = A(g)
                                Next
                                JA(i) = m
                                HUPAI JA, b
                                If b Then
                                    m1 = m1 & "," & i
                                    m2 = m2 & "," & j
                                    b = False
                                End If
                            Next j
                        End If
                    Next i
                    
                    If m1 <> "" Then
                           
                            BM1 = Split(0 & m1, ",")
                            BM2 = Split(0 & m2, ",")
                           
                            For i = 1 To UBound(BM1) '提取不重复
                                If BM1(i) <> MM Then
                                   tt = tt + 1
                                   ReDim Preserve BCF(tt)
                                   BCF(tt) = BM1(i)
                                   MM = BM1(i)
                                End If
                            Next i
                           
                            ReDim GDS(UBound(BM2))
                            For i = 1 To UBound(BM2) '获得剩余牌的数量
                                GDS(i) = 4 - GeSu(A34(BM2(1)))
                            Next i
                           
                            ReDim SULIANG(UBound(BCF))
                            For i = 1 To UBound(BCF) '相同的合计
                                For j = 1 To UBound(BM1)
                                    If BCF(i) = BM1(j) Then SULIANG(i) = GDS(j)
                                Next j
                            Next i
                           
                            For i = 2 To UBound(BCF)
                                If SULIANG(i - 1) > SULIANG(i) Then
                                    SULIANG(i) = SULIANG(i - 1)
                                    BCF(i) = BCF(i - 1)
                                End If
                            Next i
                            'MsgBox A(BCF(UBound(BCF)))
                           
                            If SULIANG(UBound(SULIANG)) > 1 Then
                                For i = 0 To 13
                                    m = Text2(i).Text
                                    If m < 28 Then
                                        m = Int(m / 9.001) * 100 + m
                                    Else
                                        m = Int(m / 9.001) * 100 + m * 6
                                    End If
                                    If m = A(BCF(UBound(BCF))) Then
                                        CHUANGJIAN Val(Text2(i).Text)
                                        Text2(i).Text = Text2(13).Text
                                        Text2(13).Text = ""
                                        Text6.Text = "听牌"
                                        PAIXU "Text2"
                                        bArr = LoadResData(136, "CUSTOM")
                                        sndPlaySoundFromMemory bArr(0), SND_ASYNC Or SND_MEMORY
                                        DoEvents
                                        Sleep (1200)
                                        Exit For
                                    End If
                                Next i
                                'Exit Sub代''''''码待补充
                            End If
                        Else
                        '调用筛选函数，得到一个数组，打出最不好的一张
                        ReDim c(0)
                        SAIXUAN A, c, 3, 3
                        ZAOZUIBUHAODEPAI c, n
                        For i = 0 To Text2.Count - 1
                            m = Val(Text2(i).Text)
                            If m < 28 Then
                                m = Int(m / 9.001) * 100 + m
                            Else
                                m = Int(m / 9.001) * 100 + m * 6
                            End If
                            If m = n Then
                                CHUANGJIAN Val(Val(Text2(i).Text)) '创建
                                Text2(i).Text = Text2(13).Text
                                Text2(13).Text = ""
                                PAIXU "Text2"
                                Exit For
                            End If
                        Next i
                    End If
                End If
            End If
        Else
            Image4(Index).Picture = LoadPicture("")
        End If
        Timer1.Interval = 1
End Sub
'文本框4
Private Sub Text4_Change()
    If Text4.Text = "5623" Then
        Text5.Text = Val(Text5.Text) + 500
        Text4.Text = 1111
    End If
End Sub
'时钟
Private Sub Timer1_Timer()
    Static t As Boolean
    If Timer1.Interval = 10 Then Timer1.Interval = 1: t = False
    DoEvents
    If Command3.Visible = False Then Command3.Visible = True
    Command3.Top = Command3.Top + 1000 * (IIf(t, -1, 1))
    If Command3.Top > 7270 Or Command3.Top < 530 Then
        bArr = LoadResData(135, "CUSTOM")
        sndPlaySoundFromMemory bArr(0), SND_ASYNC Or SND_MEMORY
        Timer1.Interval = 0
        Command3.Visible = False
        Command3.Top = 3720
        If t Then
            t = False
            If Len(Text3.Text) > 2 Then Text2(13).Text = SUIJISHU Else MsgBox "没牌了": Label4.Caption = "开": Exit Sub
            'Timer2.Interval = 1
        Else
            t = True
            If Len(Text3.Text) > 2 Then Text1(13).Text = SUIJISHU Else MsgBox "没牌了": Label4.Caption = "开": Exit Sub
        End If
    End If
End Sub

''''''随机数
Public Function SUIJISHU() As Integer
    Dim A() As String, i As Integer, d As Integer, m$, n$
    A = Split(Text3.Text, ",")
    Randomize
    i = Int(Rnd() * UBound(A)) + 1
    d = Val(A(i))
    GeSu(d) = GeSu(d) + 1
    If GeSu(d) = 4 Then
        m = d & ","
        n = Text3.Text & ","
        n = Replace(n, m, "", 1, 1, vbBinaryCompare)
        Text3.Text = Mid(n, 1, Len(n) - 1)
    End If
    SUIJISHU = d
End Function