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

HHAAMM

''''''排序
Public Function PAIXU(r As String)
    Dim i As Integer, j As Integer, n As String
    Dim A(13)
    For i = 1 To 13
        For j = 1 To 13 - i
            If Val(Controls(r)(j - 1).Text) > Val(Controls(r)(j).Text) Then
                n = Controls(r)(j - 1).Text
                Controls(r)(j - 1).Text = Controls(r)(j).Text
                Controls(r)(j).Text = n
            End If
        Next j
    Next i
End Function
''''''创建
Public Function CHUANGJIAN(n As Integer)
    Dim i As Integer, lngIndex As Long
    lngIndex = Image5.UBound + 1
    Load Image5(lngIndex)
        With Image5(lngIndex)
            .Stretch = True
            .ZOrder 0
            .Width = 375
            .Top = Text5.Text
            .Left = Text4.Text
            .Visible = True
            .Picture = ImageList1.ListImages(n).Picture
        End With
        bArr = LoadResData(100 + n, "CUSTOM")
        sndPlaySoundFromMemory bArr(0), SND_ASYNC Or SND_MEMORY
        DoEvents
        Sleep (600)
        Text4.Text = Val(Text4.Text) + 376
        'Timer2.Interval = 1
End Function

''''''胡牌
Public Function HUPAI(L() As Integer, A As Boolean)
        Dim i%, j%, k%, m%, t%
        Dim RL(13) As Integer, c(3) As Integer
        
        For i = 1 To 13
            For j = 1 To 14 - i
                If L(j - 1) > L(j) Then
                    t = L(j - 1)
                    L(j - 1) = L(j)
                    L(j) = t
                End If
            Next j
        Next i
        
        For i = 0 To 13 Step 2
            If L(i) = L(i + 1) Then c(0) = c(0) + 1
        Next i
        If c(0) = 7 Then A = True: Exit Function
        
        For i = 0 To 12
            If c(2) <> L(i) Then
                If L(i) = L(i + 1) Then
                    c(2) = L(i)
                    For j = 0 To 13
                        RL(j) = L(j)
                    Next j
                    RL(i) = 0: RL(i + 1) = 0
                    
                    For j = 0 To 11
                        If RL(j) Then
                            c(0) = j: c(1) = 0: m = RL(j)
                            For k = j + 1 To 13
                                If RL(k) - m = 1 Then
                                    If c(1) > 0 Then
                                        RL(c(0)) = 0: RL(c(1)) = 0: RL(k) = 0
                                        Exit For
                                    End If
                                    c(1) = k
                                    m = RL(k)
                                ElseIf RL(k) - m > 1 Then
                                     Exit For
                                End If
                            Next k
                        End If
                    Next j
                    
                    For j = 0 To 11
                        If RL(j) Then
                            c(0) = j: c(1) = 0
                            For k = j + 1 To 13
                                If RL(k) = RL(j) Then
                                    If c(1) > 0 Then
                                        RL(c(0)) = 0: RL(c(1)) = 0: RL(k) = 0
                                        Exit For
                                    End If
                                    c(1) = k
                                ElseIf RL(k) - RL(j) > 1 Then
                                     Exit For
                                End If
                            Next k
                        End If
                    Next j
                    '待补充。不完整，特定牌型找不到，应该反过来再运行一次
                    k = 0
                    For j = 0 To 13
                       If RL(j) Then k = k + 1
                    Next j
                    If k = 0 Then A = True: Exit Function
                    k = 0
                End If
            End If
        Next i
End Function

'找牌出

Public Function SAIXUAN(A() As Integer, c() As Integer, tj1 As Integer, tj2 As Integer)
    Dim i%, j%, k%, t%, n%, m%
    Dim JA() As Integer, b() As Integer
    If tj2 = -1 Then Exit Function
    If UBound(c) = 0 Then
        ReDim JA(0)
        For i = 0 To UBound(A) - 1
            t = 0
            If A(i) Then
                n = A(i)
                ReDim b(t)
                b(t) = i
                For j = i + 1 To UBound(A)
                    If A(j) Then
                        If A(j) - n < tj1 And A(j) - n <> tj2 Then
                            n = A(j)
                            t = t + 1
                            ReDim Preserve b(t)
                            b(t) = j
                        ElseIf A(j) - n > tj1 - 1 Then
                            Exit For
                        End If
                    End If
                Next j
            End If
            If t > 1 Then
                For k = 0 To t
                    ReDim Preserve JA(UBound(JA) + m)
                    JA(UBound(JA)) = A(b(k))
                    A(b(k)) = 0
                    m = 1
                Next k
            End If
        Next i
        m = 0
        For i = 0 To UBound(A)
            If A(i) > 0 Then
                m = m + 1
                ReDim Preserve c(m)
                c(m) = A(i)
            End If
        Next i
        tj2 = tj2 - 1
        If tj2 = 1 Then tj2 = 0
        SAIXUAN JA, c, 2, tj2
    End If
End Function

Public Function ZAOZUIBUHAODEPAI(L() As Integer, A As Integer)
    Dim i%, j%, t%, k%, n%
    Dim RL() As Integer, g() As Integer
    ReDim RL(0)
    ReDim g(UBound(L()))
    For i = 2 To UBound(L())
        If L(i) - L(i - 1) < 2 Then g(i) = 1: g(i - 1) = 1
    Next i
    For i = 1 To UBound(L())
        If g(i) = 0 Then g(i) = 20
    Next i
    For i = 1 To UBound(L)
        n = L(i)
        If n = 1 Or n = 9 Or n = 110 Or n = 118 Or n = 219 Or n = 227 Then
            k = t
            t = t + 10 * g(i)
            ReDim Preserve RL(t)
            For j = 1 To 10 * g(i)
                RL(k + j) = n
            Next j
        ElseIf n > 227 Then
            k = t
            t = t + 20 * g(i)
            ReDim Preserve RL(t)
            For j = 1 To 20 * g(i)
                RL(k + j) = n
            Next j
        Else
            k = t
            t = t + 1 * g(i)
            ReDim Preserve RL(t)
            For j = 1 To 1 * g(i)
                RL(k + j) = n
            Next j
        End If
    Next i
    Randomize
    A = RL(Int(Rnd() * UBound(RL)) + 1)
End Function

'窗体移动
Private Sub Label5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    CTYD = True
End Sub

Private Sub Label5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If CTYD Then
        Text8.Text = Val(Text8.Text) + X
        Text9.Text = Val(Text9.Text) + Y
    End If
End Sub

Private Sub Label5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    CTYD = False
End Sub

Private Sub Text8_Change()
    Form1.Left = Text8.Text
End Sub

Private Sub Text9_Change()
    Form1.Top = Text9.Text
End Sub

Private Sub Label6_Click()
    Me.WindowState = 1
End Sub

Private Sub Label7_Click()
    Label7 = "已经听牌"
    bArr = LoadResData(136, "CUSTOM")
    sndPlaySoundFromMemory bArr(0), SND_ASYNC Or SND_MEMORY
End Sub

leolee82

学学麻将，我不会玩，有说明书没

hhzjxss

怎么不是VBA呀，封装了呀！

jrllchuan

学习了，支持！

Elliott_love

找個位置  好好研究  辛苦

secowu

一年了，可以吃碰杠了

secowu

---------------------------
工程1
---------------------------
Class not registered.
You need the following file to be installed on your machine. MSSTDFMT.DLL.
---------------------------
确定   
---------------------------

HHAAMM

操作步骤：
双击文件后，点击“开”字，点击不需要的牌就可将其打出。出现能听牌的牌后，先点击左侧“点击听牌”，再打出不要的牌，之后如果来了可以胡牌的牌后，点击头像和牌

ziyerain

赞一个，收下了。

ghzs

厉害，可惜窗口不能移动，而且背景还透明，看得不是很清楚，最后就是不能自动判断是否有胡，自己点胡也没有什么提示，只有声音。