frm21.frm

来自「本人自己做的21点游戏！」· FRM 代码 · 共 1,014 行 · 第 1/2 页

FRM
1,014 行
字号
12
f(2) = 0
f(3) = 0
f(4) = 0
hh(4) = 0
hh(3) = 0
hh(2) = 0
hh(1) = 0
Label1.Caption = 0
Text2.Text = 0
Label2.Caption = 0
Label3.Caption = 0
Label4.Caption = 0
End Sub

'第一处
Private Sub Click1()
If Text1.Text < num Then
 If hh(1) + Val(Text2.Text) <= 21 Then
  Text1.Text = Val(Text1.Text) + 1
  Cardsel = 1
  movx(1) = 60
  Call Form_Paint
  Label1.Caption = hh(1)
   If Label1.Caption = 21 Then
      fen = fen + Val(Text5.Text)
      Text5.Text = 600
      Label7.Caption = fen
      Call dele1
   End If
 End If
End If
Cardsel = 0
End Sub
'第二处
Private Sub Click2()
If Text1.Text <= num Then
 If hh(2) + Val(Text2.Text) <= 21 Then
  Text1.Text = Val(Text1.Text) + 1
  movx(2) = 160
  Cardsel = 2
  Call Form_Paint
  Label2.Caption = hh(2)
   If Label2.Caption = 21 Then
      fen = fen + Val(Text5.Text)
      Text5.Text = 600
      Label7.Caption = fen
      Call dele2
   End If
 End If
End If
Cardsel = 0
End Sub

Private Sub reset()
Text1.Text = 0
Call clear
n = 13
'对四组不同的扑克进行始化
Call rndcard1
Call rndcard2
Call rndcard3
Call rndcard
Cardsel = 0
m = 0
Img1(0).Visible = True
Img1(1).Visible = True
Img1(2).Visible = True
'画扑克
Call Form_Paint
Timer1.Enabled = True
End Sub

Private Sub Command11_Click()
If fensu > 0 Then
fensu = fensu - 1
Label5.Caption = fensu
Call reset
Else
Unload Me
End If
End Sub

Private Sub Command12_Click()
End
End Sub

Private Sub Command2_Click()
Call clear
End Sub

Private Sub Command3_Click()
Call Click2
End Sub

Private Sub Click3()
If Text1.Text <= num Then
 If hh(3) + Val(Text2.Text) <= 21 Then
  Text1.Text = Val(Text1.Text) + 1
  movx(3) = 260
  Cardsel = 3
  Call Form_Paint
  Label3.Caption = hh(3)
   If Label3.Caption = 21 Then
      fen = fen + Val(Text5.Text)
      Text5.Text = 600
      Label7.Caption = fen
      Call dele3
   End If
 End If
End If
Cardsel = 0
End Sub

Private Sub Command4_Click()
Call Click3
End Sub
'删除2扑克轨迹
Private Sub dele2()
Do While (f(2) > 0)
RemoveCard frm21.hwnd, fcard(2, f(2))
Cardsel = 0
For i = 1 To 52
If card(i) = fcard(2, f(2)) Then
card(i) = 0
Exit For
End If
Next

f(2) = f(2) - 1
Loop
movx(2) = 0
movy(2) = 0
hh(2) = 0
f(2) = 0
Label2.Caption = 0
Text2.Text = 0
frm21.Refresh
End Sub

'删除1扑克轨迹
Private Sub dele1()
Do While (f(1) > 0)
RemoveCard frm21.hwnd, fcard(1, f(1))
Cardsel = 0
For i = 1 To 52
If card(i) = fcard(1, f(1)) Then
card(i) = 0
Exit For
End If
Next

f(1) = f(1) - 1
Loop
movx(1) = 0
movy(1) = 0
hh(1) = 0
f(1) = 0
Label1.Caption = 0
Text2.Text = 0
frm21.Refresh
End Sub

'删除3扑克轨迹
Private Sub dele3()
Do While (f(3) > 0)
RemoveCard frm21.hwnd, fcard(3, f(3))
Cardsel = 0
For i = 1 To 52
If card(i) = fcard(3, f(3)) Then
card(i) = 0
Exit For
End If
Next

f(3) = f(3) - 1
Loop
movy(3) = 0
movx(3) = 0
hh(3) = 0
f(3) = 0
Label3.Caption = 0
Text2.Text = 0
frm21.Refresh
End Sub

Private Sub Click4()
If Val(Text1.Text) <= num Then
 If hh(4) + Val(Text2.Text) <= 21 Then
  Text1.Text = Val(Text1.Text) + 1
  movx(4) = 360
  Cardsel = 4
  Call Form_Paint
  Label4.Caption = hh(4)
   If Label4.Caption = 21 Then
      fen = fen + Val(Text5.Text)
      Text5.Text = 600
      Label7.Caption = fen
      Call dele4
   End If
 End If
 Cardsel = 0
End If
End Sub



Private Sub Command8_Click()
Call Click4
End Sub
'删除4扑克轨迹
Private Sub dele4()
Do While (f(4) > 0)
RemoveCard frm21.hwnd, fcard(4, f(4))
Cardsel = 0
For i = 1 To 52
If card(i) = fcard(4, f(4)) Then
card(i) = 0
Exit For
End If
Next

f(4) = f(4) - 1
Loop
movy(4) = 0
movx(4) = 0
hh(4) = 0
f(4) = 0
Label4.Caption = 0
Text2.Text = 0
frm21.Refresh
End Sub
'ppp画扑克
Private Sub Form_Paint()
Dim x, y As Integer
Select Case Cardsel
Case 0
DealCard frm21.hwnd, card(Val(Text1.Text)), 20, 30
Call panduan
Case 1
If f(1) < 5 Then
DealCard frm21.hwnd, card(Val(Text1.Text)), movx(1), movy(1) + 160
movy(1) = movy(1) + 20
f(1) = f(1) + 1
fcard(1, f(1)) = card(Val(Text1.Text))
Call panduan
End If
Case 2
If f(2) < 5 Then
DealCard frm21.hwnd, card(Val(Text1.Text)), movx(2), movy(2) + 160
movy(2) = movy(2) + 20
f(2) = f(2) + 1
fcard(2, f(2)) = card(Val(Text1.Text)) '记出牌号
Call panduan
End If
Case 3
If f(3) < 5 Then
DealCard frm21.hwnd, card(Val(Text1.Text)), movx(3), movy(3) + 160
movy(3) = movy(3) + 20
f(3) = f(3) + 1
fcard(3, f(3)) = card(Val(Text1.Text))
Call panduan
End If
Case 4
If f(4) < 5 Then
DealCard frm21.hwnd, card(Val(Text1.Text)), movx(4), movy(4) + 160
movy(4) = movy(4) + 20
f(4) = f(4) + 1
fcard(4, f(4)) = card(Val(Text1.Text))
Call panduan
End If
End Select
'显示前张牌
For i = 1 To 52
If card(i) <> 0 Then
x = GetCardX(card(i))
y = GetCardY(card(i))
DealCard frm21.hwnd, card(i), x, y
End If
Next
x = 0
y = 0
If Val(Text1.Text) + 1 <= 52 Then
DealCard frm21.hwnd, card(Val(Text1.Text) + 1), 20, 30

End If
End Sub
Private Sub MenuDrawBack_Click()
'画扑克牌背面
nDrawSelection = 3
frm21.Cls
Dim xLoc As Single
xLoc = (frm21.ScaleWidth - (6 * CARDWIDTH)) / 7
For i = 1 To 6
    For j = 1 To 4
        DrawBack frm21.hwnd, i, ((i - 1) * CARDWIDTH) + i * xLoc + ((j - 1) * 2), 50 - ((j - 1) * 2)
    Next j
Next i
End Sub
Private Sub Form_Load()
'这一段是必须放在这儿的
Dim nReturn As Integer
nReturn = InitializeDeck(frm21.hwnd)
If nReturn = False Then
    MsgBox "Problem loading QCards32.DLL"
    End
End If
'初始化分数
fensu = 10
Label5.Caption = fensu
num = 0

n = 13
'对四组不同的扑克进行始化
Call rndcard1
Call rndcard2
Call rndcard3
Call rndcard
Cardsel = 0
'画扑克
Call Form_Paint
End Sub

'bbb取前扑克值-52
Private Sub num1(n As Integer)
If card(n) >= 1 And card(n) <= 10 Then
   cad = card(n)
   Text2.Text = cad
ElseIf card(n) >= 14 And card(n) <= 23 Then
   cad = card(n) - 20 + 7
   Text2.Text = cad
ElseIf card(n) >= 27 And card(n) <= 36 Then
   cad = card(n) - 30 + 4
   Text2.Text = cad
ElseIf card(n) >= 40 And card(n) <= 49 Then
   cad = card(n) - 40 + 1
   Text2.Text = cad
Else
   Text2.Text = 10
   cad = 10
End If
End Sub
'得到前一张扑克值相应信息-52
Private Sub num2(n As Integer)
If card(n) >= 1 And card(n) <= 10 Then
   cad1 = card(n)
ElseIf card(n) >= 14 And card(n) <= 23 Then
   cad1 = card(n) - 20 + 7
ElseIf card(n) >= 27 And card(n) <= 36 Then
   cad1 = card(n) - 30 + 4
ElseIf card(n) >= 40 And card(n) <= 49 Then
   cad1 = card(n) - 40 + 1
Else
   cad1 = 10
End If
End Sub
'21点计算
Private Sub panduan()
'取前一张牌
If Val(Text1.Text) + 1 <= num Then
num1 (Val(Text1.Text) + 1)
End If
'取前牌值
num2 (Val(Text1.Text))
Select Case Cardsel
Case 1
     movy(1) = movy(1) + 20
     If cad1 = 1 Then
       If 11 + hh(1) <= 21 Then
        hh(1) = hh(1) + 11
       Else
        hh(1) = hh(1) + cad1
       End If
     Else
        hh(1) = hh(1) + cad1
     End If
Case 2
     movy(2) = movy(2) + 20
     If cad1 = 1 Then
       If 11 + hh(2) <= 21 Then
        hh(2) = hh(2) + 11
       Else
        hh(2) = hh(2) + cad1
       End If
     Else
       hh(2) = hh(2) + cad1
     End If
Case 3
     movy(3) = movy(3) + 20
     If cad1 = 1 Then
       If 11 + hh(3) <= 21 Then
        hh(3) = hh(3) + 11
       Else
        hh(3) = hh(3) + cad1
       End If
     Else
      hh(3) = hh(3) + cad1
     End If
Case 4
     movy(4) = movy(4) + 20
     If cad1 = 1 Then
       If 11 + hh(4) <= 21 Then
        hh(4) = hh(4) + 11
       Else
        hh(4) = hh(4) + cad1
       End If
     Else
      hh(4) = hh(4) + cad1
     End If
End Select

End Sub


Private Sub Image1_Click()
Call Click1
End Sub

Private Sub Image2_Click()
Call Click2
End Sub

Private Sub Image3_Click()
Call Click3
End Sub

Private Sub Image4_Click()
Call Click4
End Sub

Private Sub Label10_Click()
If fensu > 0 Then
fensu = fensu - 1
Label5.Caption = fensu
Text3.Text = 60
Frame1.Visible = False
Timer4.Enabled = False
Else
Unload Me
End If
End Sub

Private Sub Label11_Click()
Unload Me
End Sub

Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKey1 Then
fensu = fensu + 10
Label5.Caption = fensu
ElseIf KeyCode = vbKey2 Then
fensu = 0
Label5.Caption = fensu
ElseIf KeyCode = vbKey3 Then
fensu = fensu + 1
Label5.Caption = fensu
End If
End Sub

Private Sub Timer1_Timer()
If num = 52 Then
   If Val(Text1.Text) >= 52 Then
   'MsgBox ("load......!")
    For i = 0 To 2
      If Img1(i).Visible = True Then
      Label7.Caption = Val(Label7.Caption) + 1000
      End If
    Next
   Call reset
   End If
Else
 If num - Val(Text1.Text) < 0 Then
  'MsgBox ("load......!")
  Timer1.Enabled = False
      For i = 0 To 2
      If Img1(i).Visible = True Then
      Label7.Caption = Val(Label7.Caption) + 1000
      End If
    Next
  Call reset
 End If
End If
End Sub

Private Sub Timer2_Timer()
If Val(Text5.Text) > 100 Then
Text5.Text = Val(Text5.Text) - 5
End If
End Sub

Private Sub Timer3_Timer()
If Val(Text3.Text) <= 0 Then
Frame1.Visible = True
Timer4.Enabled = True
Else
Text3.Text = Val(Text3.Text) - 1
End If

End Sub

Private Sub Timer4_Timer()
If Val(Label8.Caption) >= 0 Then
Label8 = Val(Label8.Caption) - 1
Else
Unload Me
End If
End Sub
12

frm21.frm - 源码说明

本页面展示了「本人自己做的21点游戏！」中的 frm21.frm 源码文件，采用 FRM 编程语言编写，共 1,014 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?