📄 frmcard.frm
字号:
VERSION 5.00
Object = "{F51FD686-FFEF-4FBE-8473-2334DC8AEF12}#1.0#0"; "StoneChess.ocx"
Begin VB.Form frmCard
Caption = "Form2"
ClientHeight = 7365
ClientLeft = 1335
ClientTop = 960
ClientWidth = 8115
LinkTopic = "Form2"
ScaleHeight = 7365
ScaleWidth = 8115
Begin StoneChess.Card Card1
Height = 6315
Left = 60
TabIndex = 29
Top = 0
Width = 5655
_ExtentX = 9975
_ExtentY = 11139
Register = -1 'True
End
Begin VB.CommandButton Command1
Caption = "集合"
Height = 375
Left = 6720
TabIndex = 28
Top = 5220
Width = 915
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 1695
Left = 6060
ScaleHeight = 113
ScaleMode = 3 'Pixel
ScaleWidth = 113
TabIndex = 27
Top = 5760
Width = 1695
End
Begin VB.CheckBox chkAutoTop
Caption = "牌自动置顶"
Height = 180
Left = 6840
TabIndex = 26
Top = 4920
Width = 1275
End
Begin VB.Frame dd
Caption = "网格"
Height = 1395
Left = 5760
TabIndex = 20
Top = 3420
Width = 2295
Begin VB.CheckBox chkGrid
Caption = "对齐到网格"
Height = 180
Left = 540
TabIndex = 25
Top = 1080
Width = 1275
End
Begin VB.TextBox txtGridY
Alignment = 2 'Center
Height = 315
Left = 840
TabIndex = 24
Text = "Text1"
Top = 600
Width = 735
End
Begin VB.TextBox txtGridX
Alignment = 2 'Center
Height = 315
Left = 840
TabIndex = 22
Text = "Text1"
Top = 240
Width = 735
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "高度:"
Height = 180
Index = 1
Left = 300
TabIndex = 23
Top = 720
Width = 540
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "宽度:"
Height = 180
Index = 0
Left = 300
TabIndex = 21
Top = 300
Width = 540
End
End
Begin VB.ListBox List1
Height = 960
Left = 60
TabIndex = 19
Top = 6360
Width = 5595
End
Begin VB.CheckBox cnkDrag
Caption = "允许拖动"
Height = 180
Left = 5760
TabIndex = 18
Top = 4920
Width = 1035
End
Begin VB.CommandButton cmdWash
Caption = "洗牌(&W)"
Height = 375
Left = 5760
TabIndex = 17
Top = 5220
Width = 915
End
Begin VB.Frame Frame1
Caption = "牌属性"
Height = 3315
Left = 5760
TabIndex = 0
Top = 60
Width = 2295
Begin VB.TextBox txtData
Alignment = 2 'Center
Height = 270
Left = 960
TabIndex = 15
Text = "0"
Top = 2220
Width = 1095
End
Begin VB.TextBox txtGroup
Alignment = 2 'Center
Height = 270
Left = 960
TabIndex = 14
Text = "0"
Top = 1920
Width = 1095
End
Begin VB.CheckBox chkSelect
Caption = "选择"
Height = 195
Left = 240
TabIndex = 13
Top = 2640
Width = 1035
End
Begin VB.CheckBox chkVisible
Caption = "可视"
Height = 195
Left = 240
TabIndex = 11
Top = 2940
Width = 1035
End
Begin VB.ComboBox Combo2
Height = 300
ItemData = "frmCard.frx":0000
Left = 960
List = "frmCard.frx":000A
Style = 2 'Dropdown List
TabIndex = 10
Top = 1560
Width = 1095
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "frmCard.frx":001A
Left = 960
List = "frmCard.frx":0024
Style = 2 'Dropdown List
TabIndex = 8
Top = 1200
Width = 1095
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "附加值:"
Height = 180
Index = 5
Left = 240
TabIndex = 16
Top = 2280
Width = 720
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "组:"
Height = 180
Index = 4
Left = 240
TabIndex = 12
Top = 1980
Width = 360
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "牌面:"
Height = 180
Index = 3
Left = 240
TabIndex = 9
Top = 1620
Width = 540
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "方向:"
Height = 180
Index = 2
Left = 240
TabIndex = 7
Top = 1260
Width = 540
End
Begin VB.Label labSuit
AutoSize = -1 'True
Caption = "0"
Height = 180
Left = 960
TabIndex = 6
Top = 960
Width = 90
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "花色:"
Height = 180
Index = 1
Left = 240
TabIndex = 5
Top = 960
Width = 540
End
Begin VB.Label labValue
AutoSize = -1 'True
Caption = "0"
Height = 180
Left = 960
TabIndex = 4
Top = 660
Width = 90
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "牌面值:"
Height = 180
Index = 0
Left = 240
TabIndex = 3
Top = 660
Width = 720
End
Begin VB.Label labIndex
AutoSize = -1 'True
Caption = "0"
Height = 180
Left = 960
TabIndex = 2
Top = 360
Width = 90
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "索引:"
Height = 180
Left = 240
TabIndex = 1
Top = 360
Width = 540
End
End
Begin VB.Menu mnuZorder
Caption = "zorder"
Begin VB.Menu mnuMove
Caption = "移动到最上面"
Index = 1
End
Begin VB.Menu mnuMove
Caption = "移动到最下面"
Index = 2
End
Begin VB.Menu mnuMove
Caption = "向下移移动一层"
Index = 3
End
Begin VB.Menu mnuMove
Caption = "向上移移动一层"
Index = 4
End
End
End
Attribute VB_Name = "frmCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Label6_Click()
End Sub
Private Sub ShowCard()
With Card1
labIndex = .CardIndex
labValue = .CardValue
labSuit = Switch(.CardSuit = 0, "黑桃", .CardSuit = 1, "红心", .CardSuit = 2, "草花", .CardSuit = 3, "方块", .CardSuit = 4, "黑鬼", .CardSuit = 5, "红鬼")
Combo1.ListIndex = .CardOrientation
Combo2.ListIndex = .CardType
txtGroup = .CardGroup
txtData = .CardData
chkSelect.Value = IIf(.CardSelected, 1, 0)
chkVisible.Value = IIf(.CardVisible, 1, 0)
End With
End Sub
Private Sub Card1_CardDragEnd(ByVal cIndex As Long)
List1.AddItem "CardDragEnd -> " + CStr(cIndex)
List1.ListIndex = List1.NewIndex
End Sub
Private Sub Card1_CardDragStart(ByVal cIndex As Long)
List1.AddItem "CardDragStart -> " + CStr(cIndex)
List1.ListIndex = List1.NewIndex
End Sub
Private Sub Card1_MouseDown(ByVal cIndex As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
List1.AddItem "MouseDown -> " + CStr(cIndex)
List1.ListIndex = List1.NewIndex
End Sub
Private Sub Card1_MouseUp(ByVal cIndex As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If cIndex <> -1 Then Card1.CardIndex = cIndex
Call ShowCard
List1.AddItem "MouseUp -> " + CStr(cIndex)
List1.ListIndex = List1.NewIndex
If Button = vbRightButton Then
PopupMenu mnuZorder, , Card1.Left + X * Screen.TwipsPerPixelX, Card1.Top + Y * Screen.TwipsPerPixelY
End If
Picture1.Cls
Card1.DrawCard Picture1.hDC, Card1.CardValue, 1, 1, Card1.CardOrientation, Card1.CardSelected
Picture1.Refresh
End Sub
Private Sub chkAutoTop_Click()
Card1.AutoTop = IIf(chkAutoTop.Value = 1, True, False)
End Sub
Private Sub chkGrid_Click()
Card1.SnapToGrid = IIf(chkGrid.Value = 1, True, False)
End Sub
Private Sub chkSelect_Click()
Card1.CardSelected = IIf(chkSelect.Value = 1, True, False)
End Sub
Private Sub chkVisible_Click()
Card1.CardVisible = IIf(chkVisible.Value = 1, True, False)
End Sub
Private Sub cmdWash_Click()
Card1.Wash
End Sub
Private Sub cnkDrag_Click()
Card1.DragEnable = IIf(cnkDrag.Value = 1, True, False)
End Sub
Private Sub Combo1_Click()
Card1.CardOrientation = Combo1.ListIndex
End Sub
Private Sub Combo2_Click()
Card1.CardType = Combo2.ListIndex
End Sub
Private Sub Command1_Click()
Dim i As Long
For i = 0 To Card1.CardCount - 1
Card1.MoveCard i, 10, 10, 10
Next i
End Sub
Private Sub Form_Load()
On Error Resume Next
mnuZorder.Visible = False
cnkDrag.Value = IIf(Card1.DragEnable, 1, 0)
chkGrid.Value = IIf(Card1.SnapToGrid, 1, 0)
txtGridX.Text = Card1.GridX
txtGridY.Text = Card1.GridY
chkAutoTop.Value = IIf(Card1.AutoTop, 1, 0)
End Sub
Private Sub Text2_Change()
End Sub
Private Sub mnuMove_Click(Index As Integer)
Card1.SetOrder Card1.CardIndex, Index
End Sub
Private Sub txtGridX_Change()
Card1.GridX = CLng(txtGridX)
End Sub
Private Sub txtGridY_Change()
Card1.GridY = CLng(txtGridY)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -