VB.NET 版蜘蛛纸牌游戏
4.93/5 (9投票s)
在本文中，我将描述我为实现 VB.NET 版蜘蛛纸牌游戏所采取的方法。
引言
该程序实现了标准的双牌蜘蛛纸牌游戏。此版本称为 Redback。表示牌、牌堆和移动历史的类可以重用于其他基于纸牌的纸牌游戏，因为特定游戏逻辑在桌面窗体上。
背景
RedBack 以我妻子喜爱玩的 Windows 3.1 共享软件游戏 Arachnid 为模型。这款游戏在 Windows 95 下无法正常运行 - 它会加载但牌不会显示 - 所以我将其作为学习 Visual Basic 面向对象编程的练习而编写了自己的版本。
2004 年，我将游戏从 VB6 移植到 VB.NET，使用了 1.1 .NET 框架。我添加了更多的蜘蛛图形，以及一个隐藏图片的选项，以适应恐蛛症患者。
为了沿用原名，我将我的版本命名为 RedBack，以一种臭名昭著的澳大利亚蜘蛛命名。它是黑寡妇的近亲。
我最近重做了图形并整理了本文的代码。
Redback 根据我妻子的要求添加了一些不规则的功能
- 您可以撤销移动和发牌，一直回到游戏开始时。
- 您可以通过单击要移动的牌来轻松地移动牌。
创建图形
第一个版本使用了早期 Windows 3.1 纸牌游戏附带的牌面图形。以今天的标准来看，它们太小了，放大它们会降低图像质量。我通过扫描一副旧牌来创建牌面。然后使用 Paint.Net 处理图像。我添加了一个两像素宽的黑色边框，带有圆角。最初，边框外部的拐角区域是白色的，在屏幕上看起来不好。我不想回去手动重置那几个像素使其透明。这需要 52 x 4 次单独的像素级编辑。相反，我添加了代码使这些有问题的像素变透明。
Public Sub CleanUpCorners(ByRef bmp As System.Drawing.Bitmap, color As Drawing.Color)
Dim limits() As Integer = {7, 5, 4, 3, 2, 1, 1}
For y As Integer = 0 To 6
For x As Integer = 0 To limits(y) - 1
bmp.SetPixel(x, y, color)
bmp.SetPixel(bmp.Width - 1 - x, y, color)
bmp.SetPixel(x, bmp.Height - 1 - y, color)
bmp.SetPixel(bmp.Width - 1 - x, bmp.Height - 1 - y, color)
Next
Next
End Sub
'
' How to invoke
bmp = New Bitmap(clsResources.GetImage("c" + .GetImageIndex(.Suit, .Rank).ToString()))
CleanUpCorners(bmp, System.Drawing.Color.Transparent)
它并不完美，因为像素在图像缩放之前就被更改了。
我想有一个蜘蛛主题的背景，所以我征得了澳大利亚一位蜘蛛专家的许可，获得了他的一些澳大利亚蜘蛛照片。这些照片用于创建平铺的背景图像。有一个标有“我讨厌蜘蛛”的菜单选项，可以关闭这个漂亮的背景功能。我本来不想实现这个菜单选项，但我妻子坚持。
构建块
桌面
桌面是一个标准的 VB.NET 窗体。它有一个用于启动画面的面板控件，八个用于已完成花色的面板控件，以及十个用于发牌的面板。它还有 104 个 PictureBox 来存放牌面图像。它们本可以在运行时更轻松地创建，但这却是原始 VB6 版本遗留下来的。
扑克牌对象
这是一个纸牌游戏，所以它需要一个代表单张牌的类。 `Card` 类代表一张牌的实例。它声明了公共 Enums 来定义可能的牌组、花色和点数。它还有这些属性
Rank As RankSet
Size as CardSize
FaceUp As Boolean
Playable As Boolean
Clickable As Boolean
Dragable As Boolean
Left As Single
Top As Single
Stack As Stack
StackPosition As Short
Image As System.Windows.Forms.PictureBox
`clsCard` 类还需要响应 Image（一个标准的 `PictureBox`）上的事件。所需的事件是 `Mouse_Down`、`Mouse_Up` 和 `Mouse_Move`。在 Spider 中，您可以将相同花色的牌堆作为一个整体移动。最初，通过拖放操作移动多张牌会导致严重的闪烁。解决方案非常简单。只需将窗体属性 `DoubleBuffered` 设置为 `True` 即可。
牌堆对象
纸牌游戏涉及将牌从一个牌堆移动到另一个牌堆。`clsStack` 类代表一个牌堆。它继承自 `CollectionBase`，我还没有更新它使用泛型列表对象。
在内部，它现在使用 `Dictionary` 对象来存储牌。它公开了以下属性
Left
Top
SmallHorizontalSpace
LargeHorizontalSpace
SmallVerticalSpace
LargeVerticalSpace
VerticalSpacing
HorizontalSpacing
StackKey ' Enum denoting which stack is represented. Values are STOCK, PILE1 thru PILE10, and HOME1 thru HOME10
TOS ' Top of Stack index
Open ' Stack can be played to
该类实现了每个 `EnumMoveType` 的方法，以及后退一步和后退一局的方法。为了适应不同的游戏，它不需要更改。
牌堆集合对象
这是一个集合对象，它保存一组牌堆对象。它提供了一种遍历牌堆集合的方法。
发牌器对象
该对象以伪随机顺序发牌。它实现了一个 `DealCard` 方法和一个 `CardsLeft` 属性。它最重要的功能是 `DealCard` 方法。它看起来是这样的
Public Function DealCard(ByVal faceUp As Boolean) As Card
Dim deck As Card.DeckSet
Dim suit As Card.SuitSet
Dim rank As Card.RankSet
Dim card As Card = Nothing
If Me.CardsLeft = 0 Then
Return Nothing
Exit Function
End If
Select Case _DealMode
Case EnumDealMode.RANDOM_DEAL
Do
deck = GetRandom(Card.DeckSet.DECK_ONE, _Decks - 1)
rank = GetRandom(Card.RankSet.LOWEST_RANK + 1, Card.RankSet.HIGHEST_RANK - 1)
suit = GetRandom(Card.SuitSet.LOWEST_SUIT + 1, Card.SuitSet.HIGHEST_SUIT - 1)
Loop Until _CardRecords(deck, rank, suit).Dealt = False
_Seq = _Seq + 1
_CardRecords(deck, rank, suit).Dealt = True
_CardRecords(deck, rank, suit).Seq = _Seq
card = _Cards.Item(CStr(deck) & "." & CStr(rank) & "." & CStr(suit))
card.FaceUp = faceUp
End Select
DealCard = card
End Function
该函数根据牌组、花色和点数选择一张随机牌。如果该牌已经被发出，它会重试。它与游戏无关。
移动日志对象
由于 RedBack 版的 Spider 实现了无限撤销和发牌撤销，它需要跟踪每一次移动并提供撤销它们的方法。这个类处理了这种复杂性。
该类还公开了这两个 `Enums`
Public Enum MoveTypeSet
START_DEAL
END_DEAL
START_MOVE
END_MOVE
MOVE_CARD_FROM_PILE_TO_LIST
MOVE_CARD_FROM_LIST_TO_PILE
TURN_CARD_FACE_UP
End Enum
Public Enum ReplayTypeSet
UNDO_ONE_MOVE
DEAL_1
DEAL_2
DEAL_3
DEAL_4
DEAL_5
End Enum
每一次移动都会被记录下来，以便可以通过撤销来撤销它。这是记录有效牌点击的逻辑。它记录了从牌堆中移除一张牌，将其放置在新的牌堆上，以及是否需要将新露出的牌翻面。
_Log.StartMove()
Stop_Redraw()
For cardIndex = oldPile.Count To startIndex Step -1
moved = moved + 1
cardsToMove(moved) = oldPile.RemovedCard
_Log.MoveCardFromPileToList((oldPile.StackKey))
Next cardIndex
For cardIndex = moved To 1 Step -1
pile.AddCard(cardsToMove(cardIndex))
_Log.MoveCardFromListToPile((pile.StackKey))
Next cardIndex
If Not oldPile.TopCard Is Nothing Then
If oldPile.TopCard.FaceUp = False Then
oldPile.TurnUpTopCard()
_Log.TurnCardFaceUp((oldPile.StackKey))
End If
End If
pile.Refresh()
oldPile.Refresh()
_Log.EndMove()
Start_Redraw()
游戏逻辑
实际的游戏逻辑实现在窗体上。这可能不是放置它的最佳位置；一个可配置的游戏引擎会更好。但是，原始 VB6 版本就是这样处理的，所以它现在还在那里。第一步是创建初始桌面或起始位置。RedBack 调用一个名为 `StartGame` 的方法来启动游戏。它显示一个启动画面，这只是一个 Panel 控件。在任何事情发生之前，都需要关闭它。`StartGame` 然后实例化并填充一个用于牌库（STOCK）的牌堆，十个用于可玩牌列的牌堆，以及八个用于接收已完成花色的牌堆。为了减少屏幕闪烁，它将此操作包含在 `Stop_Redraw` 和 `Start_Redraw` 调用之间。
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Integer) As Integer
'
' API calls to stop Windows refreshing during complex operations. Not so necessary when form.DoubleBuffered is set to true.
Public Sub Stop_Redraw()
LockWindowUpdate(Me.Handle)
End Sub
Public Sub Start_Redraw()
LockWindowUpdate(0)
End Sub
一旦游戏初始化，它就会等待玩家点击或拖动牌。这些事件在 `Card` 类中处理。`MouseMove` 事件必须处理这样一个事实：正在拖动的牌上面可能有相同花色的牌。
它调用 `Card` 类中的一个名为 `MoveCardsOnTop` 的方法。该方法查找上面的牌并将它们与选定的牌一起移动。它使用 `SetBounds` 来移动元素，而不是单独设置 `left` 和 `top`。
这是该方法。
Private Sub MoveCardsOnTop()
Dim pile As Stack
Dim cardIndex As Short
Dim verticalSpace As Single
pile = Me.Stack
verticalSpace = pile.VerticalSpacing
For cardIndex = Me.StackPosition + 1 To pile.Count
With pile.Card(cardIndex).Image
.SetBounds(Me.Image.Left + pile.HorizontalSpacing, Me.Image.Top + verticalSpace, 0, 0, Windows.Forms.BoundsSpecified.x Or Windows.Forms.BoundsSpecified.y)
End With
verticalSpace += pile.VerticalSpacing
Next cardIndex
End Sub
`Card` 的 MouseUp 事件必须判断它是响应拖放事件还是点击事件。它通过计算原始 MouseDown 事件和 MouseUp 事件之间的时间差来判断。如果时间差小于 0.2 秒，它就假定它是响应点击事件。无论哪种情况，它都会调用窗体上的方法来处理事件。这是事件代码。
Private Sub _imgCard_MouseUp(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles _CardImage.MouseUp
Dim newTime As Double
If Not _Playable Then
Exit Sub
End If
newTime = Microsoft.VisualBasic.DateAndTime.Timer
If (newTime - _MouseDownTime) < 0.2 Then
_Moving = False
End If
If _Moving Then
_Moving = False
frmTableau.ProcessCardDrop(Me)
Else
frmTableau.ProcessCardClick(Me)
End If
_MouseDown = False
End Sub
`frmTableau.ProcessCardClick` 方法处理卡片点击。它会遍历它可以采取的各种操作来响应卡片点击。如果它是一个牌库，它就会向牌列牌堆发牌。如果选择了一个完整的花色，它就会将花色移到主牌堆。否则，它会查找匹配的花色和点数。如果找不到，它会查找匹配的花色。如果找不到，它会查找一个空牌列。如果搜索不成功，它会返回。否则，它会执行移动并完成。移动逻辑是通过 `Stack` 对象的方法来完成的。这是逻辑
moved = 0
For cardIndex = oldPile.Count To startIndex Step -1
moved = moved + 1
cardsToMove(moved) = oldPile.RemovedCard
_Log.MoveCardFromPileToList((oldPile.StackKey))
Next cardIndex
For cardIndex = moved To 1 Step -1
pile.AddCard(cardsToMove(cardIndex))
_Log.MoveCardFromListToPile((pile.StackKey))
Next cardIndex
If Not oldPile.TopCard Is Nothing Then
If oldPile.TopCard.FaceUp = False Then
oldPile.TurnUpTopCard()
_Log.TurnCardFaceUp((oldPile.StackKey))
End If
End If
调整大小
某些版本的 Spider 在一个牌列牌堆中添加了太多牌时会出现问题，这些牌会从屏幕底部消失而变得无法触及。为了克服这个问题，Redback 允许玩家在大型、中型和小型牌尺寸之间进行选择。
动画
测试人员，也就是我的妻子，希望在点击牌库时看到牌被发出来。我添加了一个带有动画移动牌的方法。在不闪烁的情况下实现流畅动画被证明有点挑战。在此代码的情况下，我怀疑根本原因在于窗体上有太多控件。每一次屏幕绘制可能都会遍历所有这些控件，看看它们是否需要重绘。解决方案是在动画期间禁用窗体。
我还为卡片点击添加了动画，所以你可以看到卡片移动到选定的目的地。这是动画方法。
Private Sub AnimateMove(oldPile As Stack, startIndex As Integer, pile As Stack, cumVertOffSet As Integer, throttle As Integer)
Dim left As Integer
Dim top As Integer
'
' Work out how many steps there are from source pile to target pile. Throttle increases the number of steps.
Dim steps As Integer = Math.Max(Math.Abs(oldPile.LeftPos - pile.LeftPos), Math.Abs(oldPile.Top - pile.Top)) / throttle
Select Case _Speed
Case SpeedSet.FAST
steps = Math.Min(_FastTHrottle, steps)
Case SpeedSet.MEDIUM
steps = Math.Min(_MediumThrottle, steps)
Case SpeedSet.SLOW
steps = Math.Min(_SlowThrottle, steps)
End Select
'
' Locate the left and top co-ordinates in the target pile
Dim leftTarget As Integer = If(pile.Count = 0, pile.LeftPos, pile.TopCard.Image.Left)
Dim topTarget As Integer = If(pile.Count = 0, pile.Top, pile.TopCard.Image.Top) + cumVertOffSet
'
' Get the card to move and its co-ordibates
Dim card As Card = oldPile.ThisCard(startIndex)
Dim leftSource As Integer = card.Image.Left
Dim topSource As Integer = card.Image.Top
'
' Calculate how far to move on each iteraction
Dim leftInc As Integer = (leftTarget - leftSource) / steps
Dim topInc As Integer = (topTarget - topSource) / steps
With card.Image
left = .Left
top = .Top
'
' Critical step. If this isn't done, the animation flickers badly
Me.Enabled = False
'
' Iterate through the steps
For i As Integer = 1 To steps
'
' On last step, force card to target location
If i = steps Then
left = leftTarget
top = topTarget
Else
left += leftInc
top += topInc
End If
'
' Slow things down
Thread.Sleep(1)
'
' Move the card
.SetBounds(left, top, .Width, .Height, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
'
' Ensure it is visible
.BringToFront()
.Refresh()
'
' Let Windows do its thing
Application.DoEvents()
Next
'
' Reset the card position
card.Top = topTarget
card.LeftPos = leftTarget
'
' Re-enable the tableau.
Me.Enabled = True
End With
End Sub
帮助
我为 VB6 版本创建了一个帮助文件，使用了 Robohelp。当我尝试更新它时，发现我不再安装 RoboHelp 了。所以，我创建了一个简单的 HTML 帮助文件。它看起来比旧的 .CHM 文件更好。
使用代码
此代码使用了中级的 VB.NET 编码技术。因此，对于中级开发人员来说，相对容易地将代码改编到其他或额外的纸牌游戏中。`Card`、`Stack`、`Dealer` 和 `LogMove` 类不特定于 Spider solitaire，可以在其他游戏中无需更改即可使用。
一些邮件服务器会拒绝包含扩展名为 .vb 的文件的 zip 文件。从 zip 文件中提取文件后，将 .vbsrc 文件的扩展名更改为 .vb。
关注点
单击卡片并将其移动到最明显位置的能力可以加快游戏速度。无限撤销消除了玩这个更具挑战性的纸牌游戏的挫败感。蜘蛛背景是一种新奇事物，大多数玩家会将其关闭。
历史
Code-Project 的第一个版本