如何用visual basic 寫一個2048？

02-03

具體功能實現的語句是什麼？

以下是實現的的具體代碼。

Option Explicit

Dim BoxValue(3, 3) As Integer 格子的數值

Dim Score As Long 得分

Dim fWidth As Single

Dim mLeft As Integer, mTop As Integer

Dim mSize As Integer

按鍵

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

Select Case KeyCode

Case vbKeyLeft

Call MoveBox(1)

Case vbKeyRight

Call MoveBox(2)

Case vbKeyUp

Call MoveBox(3)

Case vbKeyDown

Call MoveBox(4)

Case vbKeySpace

Call NewGame

End Select

End Sub

Private Sub Form_Load()

Me.Width = 8000

Me.Height = 9000

Me.Caption = "2048"

Me.KeyPreview = True

Me.AutoRedraw = True

Me.ScaleMode = 3

Me.FontSize = 32

fWidth = TextWidth("0")

mSize = 450

mLeft = (Me.ScaleWidth - mSize) / 2

mTop = (Me.ScaleHeight - mSize - mLeft)

Call NewGame

End Sub

開始遊戲

Private Sub NewGame()

Dim R As Integer, C As Integer

Line (mLeft, mTop)-(mLeft + 450, mTop + 450), RGB(128, 128, 128), BF

Line (mLeft + 1, mTop + 1)-(Me.ScaleWidth - mLeft, Me.ScaleHeight - mLeft - 1), RGB(40, 40, 40), B

For R = 0 To 3

For C = 0 To 3

DrawBox 0, R, C

Score = 0

Call PrintScore

Call NewBox

End Sub

畫格子

Private Sub DrawBox(ByVal N As Integer, ByVal R As Integer, ByVal C As Integer)

Dim L As Integer, T As Integer

Dim tmpStr As String

L = C * 110 + 10 + mLeft

T = R * 110 + 10 + mTop

If N = 0 Then

Line (L + 1, T + 1)-(L + 102, T + 102), RGB(100, 100, 100), BF

Line (L, T)-(L + 100, T + 100), RGB(200, 200, 200), BF

Else

Line (L, T)-(L + 100, T + 100), BoxColor(N), BF

Line (L + 2, T + 2)-(L + 99, T + 99), RGB(100, 100, 100), B

Line (L + 1, T + 1)-(L + 98, T + 98), RGB(255, 255, 255), B

tmpStr = Trim(Str(N))

CurrentX = L + (100 - TextWidth(tmpStr)) / 2 - fWidth

CurrentY = T + (100 - TextHeight(tmpStr)) / 2

Print N

End If

BoxValue(R, C) = N

End Sub

移動格子

Private Sub MoveBox(ByVal Fx As Integer)

Dim B As Integer, N As Integer, S As Integer

Dim R As Integer, C As Integer, K As Integer

Dim bMove As Boolean

If Fx &< 3 Then 左右移動

If Fx = 1 Then

B = 1: N = 3: S = 1

Else

B = 2: N = 0: S = -1

End If

For R = 0 To 3

K = IIf(Fx = 1, 0, 3)

For C = B To N Step S

If BoxValue(R, C) &> 0 Then

If (BoxValue(R, C) = BoxValue(R, K)) Then

DrawBox BoxValue(R, C) * 2, R, K

DrawBox 0, R, C

Score = Score + BoxValue(R, K)

If BoxValue(R, K) = 2048 Then

MsgBox "哇塞！太厲害了！佩服佩服~", vbInformation

End If

bMove = True

Else

If BoxValue(R, K) &> 0 Then

K = K + S

If K &<&> C Then

DrawBox BoxValue(R, C), R, K

DrawBox 0, R, C

bMove = True

End If

Else

DrawBox BoxValue(R, C), R, K

DrawBox 0, R, C

bMove = True

End If

Next C

Next R

Else 上下移動

If Fx = 3 Then

B = 1: N = 3: S = 1

Else

B = 2: N = 0: S = -1

End If

For C = 0 To 3

K = IIf(Fx = 3, 0, 3)

For R = B To N Step S

If BoxValue(R, C) &> 0 Then

If BoxValue(R, C) = BoxValue(K, C) Then

DrawBox BoxValue(R, C) * 2, K, C

DrawBox 0, R, C

Score = Score + BoxValue(K, C)

If BoxValue(R, K) = 2048 Then

MsgBox "哇塞！太厲害了！佩服佩服~", vbInformation

End If

bMove = True

Else

If BoxValue(K, C) &> 0 Then

K = K + S

If K &<&> R Then

DrawBox BoxValue(R, C), K, C

DrawBox 0, R, C

bMove = True

End If

Else

DrawBox BoxValue(R, C), K, C

DrawBox 0, R, C

bMove = True

End If

Next R

Next C

End If

If bMove Then

Call PrintScore

Call NewBox

檢查死局

For R = 0 To 3

For C = 0 To 3

If BoxValue(R, C) = 0 Then Exit Sub

If R &< 3 Then If BoxValue(R, C) = BoxValue(R + 1, C) Then Exit Sub

If C &< 3 Then If BoxValue(R, C) = BoxValue(R, C + 1) Then Exit Sub

MsgBox "無路可走了~~~下次好運！", vbInformation

Call NewGame

End If

End Sub

產生新方格

Private Sub NewBox()

Dim R As Integer, C As Integer

Randomize

R = Int(Rnd * 4)

C = Int(Rnd * 4)

Do While BoxValue(R, C) &> 0

R = Int(Rnd * 4)

C = Int(Rnd * 4)

Loop

BoxValue(R, C) = 2

DrawBox 2, R, C

End Sub

方格顏色

Private Function BoxColor(ByVal N As Integer) As Long

Select Case N

Case 2

BoxColor = HC0E0FF

Case 4

BoxColor = H80C0FF

Case 8

BoxColor = H80FFFF

Case 16

BoxColor = HC0FFC0

Case 32

BoxColor = HFFFF80

Case 64

BoxColor = HFFC0C0

Case 128

BoxColor = HFF8080

Case 256

BoxColor = HFFC0FF

Case 512

BoxColor = HFF80FF

Case 1024

BoxColor = HC0C0FF

Case 2048

BoxColor = H8080FF

End Select

End Function

列印得分

Private Sub PrintScore()

Me.FontSize = 24

Line (mLeft, mLeft)-(Me.ScaleWidth, mTop), BackColor, BF

CurrentX = mLeft

CurrentY = mLeft

Print "得分：" Score

Me.FontSize = 32

End Sub

excelhome裡面有代碼