📄 frm21.frm
字号:
VERSION 5.00
Begin VB.Form frm21
Appearance = 0 'Flat
BackColor = &H00808000&
BorderStyle = 0 'None
ClientHeight = 6795
ClientLeft = 1275
ClientTop = 1440
ClientWidth = 9480
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
LinkMode = 1 'Source
LinkTopic = "Form1"
PaletteMode = 1 'UseZOrder
ScaleHeight = 453
ScaleMode = 3 'Pixel
ScaleWidth = 632
ShowInTaskbar = 0 'False
WindowState = 2 'Maximized
Begin VB.Frame Frame1
BackColor = &H80000012&
BorderStyle = 0 'None
Height = 375
Left = 4560
TabIndex = 20
Top = 1440
Visible = 0 'False
Width = 2415
Begin VB.Timer Timer4
Enabled = 0 'False
Interval = 1000
Left = 600
Top = 0
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "9"
ForeColor = &H0000FF00&
Height = 255
Left = 120
TabIndex = 24
Top = 120
Width = 375
End
Begin VB.Label Label10
BackStyle = 0 'Transparent
Caption = "继续"
ForeColor = &H000000FF&
Height = 255
Left = 1440
TabIndex = 23
Top = 120
Width = 375
End
Begin VB.Label Label11
BackStyle = 0 'Transparent
Caption = "退出"
ForeColor = &H000000FF&
Height = 255
Left = 1920
TabIndex = 22
Top = 120
Width = 375
End
Begin VB.Label Label9
BackStyle = 0 'Transparent
Caption = "时间到!"
ForeColor = &H0000FF00&
Height = 255
Left = 720
TabIndex = 21
Top = 120
Width = 735
End
End
Begin VB.CommandButton Command12
Caption = "exit"
Height = 375
Left = 7080
TabIndex = 19
Top = 5160
Width = 855
End
Begin VB.TextBox Text3
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8400
TabIndex = 18
Text = "60"
Top = 2040
Width = 495
End
Begin VB.PictureBox Picture1
Height = 615
Left = 8520
ScaleHeight = 555
ScaleWidth = 555
TabIndex = 15
Top = 4200
Width = 615
End
Begin VB.Timer Timer3
Interval = 1000
Left = 7560
Top = 360
End
Begin VB.TextBox Text5
Enabled = 0 'False
Height = 375
Left = 8400
TabIndex = 13
Text = "600"
Top = 3480
Width = 975
End
Begin VB.Timer Timer2
Interval = 60
Left = 7080
Top = 960
End
Begin VB.CommandButton Command11
Caption = "reset"
Height = 375
Left = 7080
TabIndex = 12
Top = 4320
Width = 855
End
Begin VB.CommandButton Command10
Caption = "past"
Height = 375
Left = 2760
TabIndex = 11
Top = 360
Width = 735
End
Begin VB.CommandButton Command8
Caption = "4"
Height = 375
Left = 5400
TabIndex = 6
Top = 6120
Width = 855
End
Begin VB.CommandButton Command4
Caption = "3"
Height = 375
Left = 3960
TabIndex = 5
Top = 6120
Width = 855
End
Begin VB.CommandButton Command3
Caption = "2"
Height = 375
Left = 2400
TabIndex = 4
Top = 6120
Width = 855
End
Begin VB.CommandButton Command2
Caption = "clear"
Height = 375
Left = 7800
TabIndex = 3
Top = 5880
Width = 735
End
Begin VB.TextBox Text2
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8400
TabIndex = 2
Top = 2760
Width = 495
End
Begin VB.CommandButton Command1
Caption = "1"
Height = 375
Left = 960
TabIndex = 1
Top = 6120
Width = 855
End
Begin VB.TextBox Text1
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 7080
TabIndex = 0
Text = "1"
Top = 2760
Width = 495
End
Begin VB.Timer Timer1
Interval = 10
Left = 7080
Top = 360
End
Begin VB.Image Image4
Height = 4095
Left = 5160
Top = 2400
Width = 1215
End
Begin VB.Image Image3
Height = 4095
Left = 3720
Top = 2400
Width = 1215
End
Begin VB.Image Image2
Height = 4095
Left = 2160
Top = 2400
Width = 1335
End
Begin VB.Image Image1
Height = 4095
Left = 720
Top = 2400
Width = 1215
End
Begin VB.Image Img1
Height = 720
Index = 2
Left = 3600
Picture = "frm21.frx":0000
Top = 960
Width = 450
End
Begin VB.Image Img1
Height = 720
Index = 1
Left = 2880
Picture = "frm21.frx":2F67
Top = 960
Width = 450
End
Begin VB.Image Img1
Height = 720
Index = 0
Left = 2160
Picture = "frm21.frx":5ECE
Top = 960
Width = 450
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Height = 375
Left = 7080
TabIndex = 17
Top = 3480
Width = 1095
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Height = 375
Left = 7080
TabIndex = 16
Top = 2040
Width = 495
End
Begin VB.Label Label5
Height = 255
Left = 8640
TabIndex = 14
Top = 5160
Width = 375
End
Begin VB.Label Label4
Height = 255
Left = 5280
TabIndex = 10
Top = 2040
Width = 855
End
Begin VB.Label Label3
Height = 255
Left = 3840
TabIndex = 9
Top = 2040
Width = 855
End
Begin VB.Label Label2
Height = 255
Left = 2400
TabIndex = 8
Top = 2040
Width = 855
End
Begin VB.Label Label1
Height = 255
Left = 840
TabIndex = 7
Top = 2040
Width = 915
End
End
Attribute VB_Name = "frm21"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'初始化DLL，必须放在Form-Load事件中
Private Declare Function InitializeDeck Lib "qcard32.dll" (ByVal hwnd As Long) As Long
' 将所有扑克牌的属性设为默认值
Private Declare Sub SetDefaultValues Lib "qcard32.dll" ()
' 画扑克牌的函数
Private Declare Function GetCardX Lib "qcard32.dll" (ByVal nCard As Long) As Long
Private Declare Function GetCardY Lib "qcard32.dll" (ByVal nCard As Long) As Long
Private Declare Sub DrawCard Lib "qcard32.dll" (ByVal hwnd As Long, ByVal nCard As Long, ByVal x As Long, ByVal y As Long)
Private Declare Sub DrawBack Lib "qcard32.dll" (ByVal hwnd As Long, ByVal nValue As Long, ByVal x As Long, ByVal y As Long)
Private Declare Sub DealCard Lib "qcard32.dll" (ByVal hwnd As Long, ByVal nCard As Long, ByVal x As Long, ByVal y As Long)
Private Declare Sub RemoveCard Lib "qcard32.dll" (ByVal hwnd As Long, ByVal nCard As Long)
'远程传输分数
Public fensu As Long
Dim hh(4) As Integer
'放三处图片区域的坐标
Dim movx(4), movy(4) As Integer
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim m As Integer '跳牌
'统计牌数
Dim num As Integer
'处理取出扑克值
Dim cad As Integer '下一值
Dim cad1 As Integer
'存选中扑克的位子
Dim Cardsel As Integer
'存放三处扑克信息
Dim fcard(1 To 4, 1 To 5) As Integer
Dim f(1 To 4) As Integer
'分数
Dim fen As Integer
' 扑克牌号信息
Dim card(52) As Integer
Dim card1(48) As Integer
Dim card2(44) As Integer
Dim card3(40) As Integer
'给每一堆扑克牌设置一个计数器
Dim Counter(1 To 4) As Integer
'随机产生扑克
Private Sub rndcard()
Dim cardid As Integer
Dim recard(52) As Integer
Dim n As Integer
frm21.Cls
Randomize Timer
' 获得随机画一张扑克牌的值
Randomize
n = Int(4 * Rnd + 1)
'n = 4
Select Case n
Case Is = 1
num = 52
For j = 1 To 52
Do
Randomize
cardid = Int(52 * Rnd + 1)
Loop Until recard(cardid) < 1
recard(cardid) = recard(cardid) + 1
card(j) = cardid
Next
'随机出52张牌
'For i = 1 To 52
'xLoc = 11 + xLoc
'DealCard frm21.hwnd, card(i), xLoc, yLoc
'Next
'222
Case Is = 2
num = 48
'MsgBox ("48")
For j = 1 To 48
Do
Randomize
cardid = Int(48 * Rnd + 1)
Loop Until recard(cardid) < 1
recard(cardid) = recard(cardid) + 1
card(j) = card1(cardid)
Next
'333
Case Is = 3
num = 44
'MsgBox ("44")
For j = 1 To 44
Do
Randomize
cardid = Int(44 * Rnd + 1)
Loop Until recard(cardid) < 1
recard(cardid) = recard(cardid) + 1
card(j) = card2(cardid)
Next
Case Is = 4
num = 40
'MsgBox ("40")
For j = 1 To 40
Do
Randomize
cardid = Int(40 * Rnd + 1)
Loop Until recard(cardid) < 1
recard(cardid) = recard(cardid) + 1
card(j) = card3(cardid)
Next
End Select
Label6 = num
End Sub
'48张牌
Private Sub rndcard1()
i = 1
For j = 1 To 52
If j Mod 13 <> 0 Then
card1(i) = j
i = i + 1
End If
Next
'Label2.Caption = i - 1
End Sub
'44张牌
Private Sub rndcard2()
i = 1
For j = 1 To 52
If j <> 12 And j <> 13 And j <> 25 And j <> 26 And j <> 38 And j <> 39 And j <> 51 And j <> 52 And i <= 44 Then
card2(i) = j
i = i + 1
End If
Next
'Label3.Caption = i - 1
End Sub
'40张牌
Private Sub rndcard3()
i = 1
For j = 1 To 52
If j <> 11 And j <> 12 And j <> 13 And j <> 24 And j <> 25 And j <> 26 And j <> 37 And j <> 38 And j <> 39 And j <> 50 And j <> 51 And j <> 52 And i <= 40 Then
card3(i) = j
i = i + 1
'Label5.Caption = Label5.Caption + "*" + Trim(Str(j))
End If
Next
'Label4.Caption = i - 1
End Sub
Private Sub Command1_Click()
Call Click1
End Sub
'跳牌
Private Sub Command10_Click()
Dim swap As Integer
If m < 3 Then
swap = card(Val(Text1.Text + 2))
DealCard frm21.hwnd, swap, 20, 30
num1 (Val(Text1.Text) + 2)
Text1.Text = Val(Text1.Text) + 1
Img1(m).Visible = False
m = m + 1
End If
End Sub
Private Sub clear()
Me.Cls
movx(1) = 0
movy(1) = 0
movx(2) = 0
movy(2) = 0
movy(3) = 0
movx(3) = 0
movy(4) = 0
movx(4) = 0
f(1) = 0
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -