⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmcard.frm

📁 StoneChess棋牌类游戏开发控件,供初学者研究使用
💻 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 + -