使用Cards.dll的FreeCell游戏(译文)
By robot-v1.0
本文链接 https://www.kyfws.com/games/a-freecell-game-using-cards-dll-zh/
版权声明 本博客所有文章除特别声明外,均采用 BY-NC-SA 许可协议。转载请注明出处!
- 14 分钟阅读 - 6773 个词 阅读量 0使用Cards.dll的FreeCell游戏(译文)
原文地址:https://www.codeproject.com/Articles/30067/A-FreeCell-game-using-Cards-dll
原文作者:Matt Fomich
译文由本站 robot-v1.0 翻译
前言
Instructions for using the Cards dynamic Link library. FreeCell game included.
有关使用Cards动态链接库的说明.包括空当接龙游戏.
介绍(Introduction)
网上有很多关于如何使用Cards动态链接库的好文章,所以我认为制作自己喜欢的单人纸牌游戏FreeCell会很有趣.(There are many good articles on the net on how to use the Cards dynamic link library, so I thought it would be fun to make my favorite one player card game, FreeCell.)
背景(Background)
我真的很喜欢FreeCell. 1992年,Marc L. Allen编写并发布了可用于Windows的更好的FreeCell游戏之一.今天它仍然可以在32位Windows XP和Vista上运行,但是它是16位应用程序,因此不能在Vista或XP 64上运行.我真的很喜欢他使用的界面,因此我决定编写他的现代版本的代码.原始的空当接龙游戏.(I really like FreeCell. In 1992, Marc L. Allen programmed and published one of the better FreeCell games available for Windows. It still works today on 32 bit Windows XP and Vista, but it is a 16 bit application, so it can’t run on Vista or XP 64. I really liked the interface he used, so I decided to code a modern version of his original FreeCell Game.)
使用代码(Using the Code)
该项目使用(This project uses the)**Cards.dll(Cards.dll)**图书馆画扑克牌.网上有很多不错的文章,介绍了如何使用Cards动态链接库.如果您不熟悉卡片库,建议您阅读Matt Pietrek关于该主题的文章:(library to draw the playing cards. There are many good articles on the net on how to use the Cards dynamic link library. If you are not familiar with the cards library, I recommend you read Matt Pietrek’s article on the subject:) http://catch22.net/tuts/cards(http://catch22.net/tuts/cards) .(.) **Cards.dll(Cards.dll)**展示了四个功能和一个子例程.他们是:(exposes four functions and one sub routine. They are:)
-
cdtInit
:此函数初始化卡库,必须首先调用.(: This function initializes the cards library, and must be called first.) 此函数有两个参数:卡的宽度和高度.这些是调用应用程序提供的整数变量,用于记录Cards Library用于Card宽度和高度的默认值.卡宽度的默认值为71像素,卡高度的默认值为96像素.如果要更改默认尺寸,这些值很重要,因为应保持71:96的比例,以免卡图像失真.但是大多数应用程序都使用默认值,在大多数情况下都可以正常工作.如果您使用的是卡片的默认值并且不需要大小,则可以简单地使用零代替(This function takes two arguments: the width and height of the card. These are integer variables supplied by the calling application, and are used to record the default values used by the Cards Library for card width and height. The default values are 71 pixels for card width, and 96 pixels for card height. These values are important if you are going to change the default sizes, because the ratio of 71 by 96 should be maintained, so that the card images are not distorted. But most applications use the default values, which work fine in most cases. If you are using the default values for your cards and don’t need the size, you can simply use zeros in place of the)Width
和(and)Height
变量.(variables.) -
cdtTerm
:此子例程是库的析构函数方法,如果没有其他应用程序正在使用它,它将从内存中释放该库.(: This sub routine is the library’s destructor method, and it frees the library from memory if no other applications are using it.) 当应用程序退出或完成绘制任何卡片时,调用此方法.(Call this method when your application exits, or when you are finished drawing any cards.) -
cdtDraw
:此功能使用默认大小绘制卡.(: This function draws the cards using their default size.) 此函数采用以下参数:(This function takes the following arguments:)hDC
:将在其上绘制卡片图像的对象的句柄.(: The Handle for the object that the card image will be drawn on.)X
:卡片图像的x轴原点.(: The x-axis origin for the card image.)Y
:卡片图像的y轴原点.(: The y-axis origin for the card image.)Card
:卡值.卡片的面值,或者如果向后拉卡片,则要绘制的图案的值.(: The card value. Either the face value of the card, or the value for the pattern to draw if drawing the card back.)Type
:指定绘制卡的正面,背面或反面.将该值设置为零可绘制出卡面,将其设置为一可拉回卡面.(: Specifies to draw the face, back, or inverted face of the card. Set this value to zero to draw the card face, and one to draw the card back.)Clr
:设置CrossHatch卡的背景颜色.所有其他卡的背面和正面都是位图,因此设置此设置对任何其他卡的背面均无效.将此值保留为零,除非您要使用CrossHatch模式将卡片抽回.(: Sets the background color for the CrossHatch card back. All other card backs and fronts are bitmaps, so setting this has no effect for any other card back. Leave this value at zero, unless you are drawing a card back with the CrossHatch pattern.)
-
cdtDrawExt
: 和…一样(: Same as)cdtDraw
除了此功能,您可以指定要绘制的卡片的高度和宽度.(except this function allows you to specify the height and width of the card being drawn.) -
cdtAnimate
:将卡片动画化.循环调用此函数(: Animates the card back. Call this function in a loop with)iState
最初设置为零,然后循环直到该函数返回零.我个人从未使用过此功能.(initially set to zero, and loop until the function returns zero. I personally have never used this function.) 卡值基于没有小丑的标准52卡组.卡值是从其西装和面值得出的.(Card values are based on a standard 52 card deck, with no Jokers. Card values are derived from their suit and face value.) 确定卡值的公式为:FaceValue * 4 + SuitValue,或4F + Suit.(The formula for determining a card value is: FaceValue * 4 + SuitValue, or 4F + Suit.) 面值和西服值枚举如下:(The face and suit value enumerations are as follows:)
Public Enum Suit As Byte
CLUBS = 0
DIAMONDS = 1
HEARTS = 2
SPADES = 3
End Enum
Public Enum Face As Byte
Ace = 0
Two = 1
Three = 2
Four = 3
Five = 4
Six = 5
Seven = 6
Eight = 7
Nine = 8
Ten = 9
Jack = 10
Queen = 11
King = 12
End Enum
使用4F +西服=卡值的示例:(Examples using 4F + Suit = Card Value:)
- 黑桃王牌的大小为4 * 0 + 3 =卡值3.(The Ace of Spades would be 4 * 0 + 3 = a Card Value of 3.)
- 八个俱乐部为4 * 7 + 0 =卡值28.(The Eight of Clubs would be 4 * 7 + 0 = a Card Value of 28.) 这是所有卡值:(Here are all of the card values:)
' Card values:
Ace| 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 |Jack|Queen|King
' CLUBS: 0 4 8 12 16 20 24 28 32 36 40 44 48
' DIAMONDS: 1 5 9 13 17 21 25 29 33 37 41 45 49
' HEARTS: 2 6 10 14 18 22 26 30 34 38 42 46 50
' SPADES: 3 7 11 15 19 23 27 31 35 39 43 47 51
在我的卡类中,该卡使用其卡值进行初始化,并且该值在该卡的生命周期内始终不变.这使得绘制卡面非常容易.(In my card class, the card is initialized with its card value, and this value never changes for the lifetime of that card. This makes drawing the card face really easy.)
Public Class Card : Inherits Control
Public CardValue As Byte
Public OldPoint As Point
Sub New(ByVal cardvalue As Byte)
Me.Size = New Size(CardWidth, CardHeight)
Me.CardValue = cardvalue
End Sub
Private Sub PaintCard(ByVal sender As Object, ByVal e As PaintEventArgs) _
Handles Me.Paint
cdtDraw(e.Graphics.GetHdc, 0, 0, DirectCast(sender, Card).CardValue, 0, 0)
End Sub
End Class
卡库没有任何方法可以对卡进行排序或比较.您必须根据纸牌游戏编写自己的方法.下面显示的方法适用于FreeCell:(The Cards library does not have any methods to sort or compare the cards. You have to write your own methods, based on the card game. The methods shown below are for FreeCell:)
' Method for returning face value based on raw card value.
' The formula for card value is (card = face * 4 + Suit)
Private Function CardFaceValue(ByVal CardValue As Byte, ByVal suite As Suit) As Face
Return CType((CardValue - suite) / 4, Face)
End Function
Public ReadOnly Property FaceValue(ByVal CardValue As Byte) As Face
Get
Return CType(CardFaceValue(CardValue, SuitValue(CardValue)), Face)
End Get
End Property
' This property returns the "raw" Card Value for next higher card
' in sequence in the same suit. If card is a king, the ace in
' same suit is returned. If card is an ace, the two in same suit
' is returned.
Public ReadOnly Property NextFaceValue(ByVal CardValue As Byte) As Byte
Get
' Determine face and suit for current card value.
Dim f As Face = FaceValue(CardValue)
Dim s As Suit = SuitValue(CardValue)
If f < Face.King Then
' return next higher card value by adding 1 to face value.
Return CByte(s + (f + 1) * 4)
Else
' return ace in same suit as the next logical higher
' card than the king.
Return CByte(s + Face.Ace * 4)
End If
End Get
End Property
' This property returns the "raw" Card Value for the next lower card
' in sequence in the same suit. If card is an ace, then the King card
' will be returned. If card is a 2, the ace is returned.
Public ReadOnly Property PrevCardValue(ByVal CardValue As Byte) As Byte
Get
' Determine face and suit for current card value.
Dim f As Face = FaceValue(CardValue)
Dim s As Suit = SuitValue(CardValue)
' return next lower card value in same suit by subtracting 1 from face value.
' If the math is done right, it should properly convert to byte value.
If CardValue > 3 Then
Return CByte(s + (f - 1) * 4)
Else
' Current card is an ace, so return the king in same suit.
Return CByte(s + Face.King * 4)
End If
End Get
End Property
' Returns the opposite color for CardValue argument.
Public ReadOnly Property OppositeSuit(ByVal CardValue As Byte) As SuitColor
Get
Select Case SuitValue(CardValue)
Case Suit.CLUBS, Suit.SPADES
' Return opposite color.
Return SuitColor.Red
Case Suit.DIAMONDS, Suit.HEARTS
' Return opposite color.
Return SuitColor.Black
End Select
End Get
End Property
' Returns two bytes that equal the card values for next 2 lower
' cards in opposite suit, like in FreeCell, when sorting cards
' in columns.
Public Function PrevOppositeSuite(ByVal CardValue As Byte) As Byte()
Dim s As Suit = SuitValue(CardValue)
Dim OppCards(1) As Byte
Dim f As Face = Me.CardFaceValue(CardValue, s)
If f = Face.Ace Then
' Set to King.
f = Face.King
Else
' Set to next lower face value.
f = CType(f - 1, Face)
End If
Select Case s
Case Suit.CLUBS, Suit.SPADES
OppCards(0) = CByte(f * 4 + Suit.DIAMONDS)
OppCards(1) = CByte(f * 4 + Suit.HEARTS)
Case Suit.DIAMONDS, Suit.HEARTS
OppCards(0) = CByte(f * 4 + Suit.SPADES)
OppCards(1) = CByte(f * 4 + Suit.CLUBS)
End Select
Return OppCards
End Function
' Returns two bytes that equal the card values for next 2 higer
' cards in opposite suit, like in FreeCell, when sorting cards
' in columns.
Public Function NextOppositeSuite(ByVal CardValue As Byte) As Byte()
Dim s As Suit = SuitValue(CardValue)
Dim OppCards(1) As Byte
Dim f As Face = Me.CardFaceValue(CardValue, s)
If f = Face.King Then
' Set to Ace.
f = Face.Ace
Else
' Set to next higher face value.
f = CType(f + 1, Face)
End If
Select Case s
Case Suit.CLUBS, Suit.SPADES
OppCards(0) = CByte(f * 4 + Suit.DIAMONDS)
OppCards(1) = CByte(f * 4 + Suit.HEARTS)
Case Suit.DIAMONDS, Suit.HEARTS
OppCards(0) = CByte(f * 4 + Suit.SPADES)
OppCards(1) = CByte(f * 4 + Suit.CLUBS)
End Select
Return OppCards
End Function
' method for returning suit value.
Public Function SuitValue(ByVal CardValue As Byte) As Suit
Select Case CardValue
Case 0, 4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 44, 48
Return Suit.CLUBS
Case 1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41, 45, 49
Return Suit.DIAMONDS
Case 2, 6, 10, 14, 18, 22, 26, 30, 34, 38, 42, 46, 50
Return Suit.HEARTS
Case Else
Return Suit.SPADES
End Select
End Function
Freecell游戏使用(The Freecell game uses the) MouseDown
,(,) MouseMove
和(, and) MouseUp
卡片移动事件.当卡可以清除到ace家用单元格时,我也使用双击.(events to move the cards. I also use double-click for when the cards can clear to the ace home cells.)
检测鼠标按下和鼠标按下以及双击的一个问题是,当用户双击时,您必须能够忽略鼠标按下和鼠标按下的事件.我所做的是我创建了一个doubleclick布尔值,并在鼠标按下事件中将其设置为true,并在鼠标移动过程中将其设置为false.在我的鼠标向上事件中,如果doubleclick为true,则代码退出.这样,当用户双击但卡未移动时,鼠标向上的代码将忽略该呼叫.(One problem with detecting mouse down and mouse up and also double-click is, when the user double-clicks, you have to be able to disregard the mouse down and mouse up events. What I did was I made a doubleclick boolean and sets it to true on the mouse down event, and sets it to false during mouse move. In my mouse up event, the code exits if doubleclick is true. That way, when the user double-clicks but the card did not move, the code in mouse up ignores the call.)
Sub Card_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
If e.Clicks = 1 AndAlso e.Button = Windows.Forms.MouseButtons.Left Then
' MouseMove will fire first time user clicks card.
' Only fire mouse move if mouse location changes.
OldMousept = e.Location
' double-click flag is always set to true.
' It is set false if card is moved.
' This is so mouseUp event only
' fires if card was moved.
DblClick = True
Dim c As Card = DirectCast(sender, Card)
c.BringToFront()
Xpos = Control.MousePosition.X - c.Left
Ypos = Control.MousePosition.Y - c.Top
End If
End Sub
Sub Card_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
If e.Clicks = 0 AndAlso e.Button = Windows.Forms.MouseButtons.Left AndAlso _
e.Location <> OldMousept Then
DblClick = False
DirectCast(sender, Card).Location = _
New Point(Control.MousePosition.X - Xpos, _
Control.MousePosition.Y - Ypos)
End If
End Sub
Sub Card_MouseUp(ByVal sender As Object, _
ByVal e As System.Windows.Forms.MouseEventArgs)
' The DblClick flag is always set to true at mouse-down event,
' to prevent this sub from firing when the user is double-clicking
' the card. If not double-clicking, then when the card is moved
' the mouse move event of the card resets DblClick to
' false. If we remove the DblClick flag, this sub will fire
' multiple times when the user double-clicks the card.
If Not DblClick AndAlso e.Button = Windows.Forms.MouseButtons.Left Then
Dim c As Card = DirectCast(sender, Card)
Dim idx As Integer
' Determine if card is being dropped over another card,
' and if it is, try to dock the card.
' First the Location.X/Left position is checked against
' possible Left-Right docking ranges. If a match is
' found then the Location.Y/Top position is checked against
' possible Top-Bottom docking ranges. There are only 16
' possible docking areas: 8 columns, 4 free cells, and 4
' Ace Docking areas.
' For the 8 columns, the location of the top card in the
' column is used. If the column card count is zero, then
' the Row(0) location is used.
' The numbers were determined using card locations and card
' sizes. In most cases, only 40 % of the destination card
' needs to be covered for dragged card to be dropped there.
Select Case c.Left
Case 77 To 150 ' Aces
Select Case c.Top
' Determine if card is partly covering one of the Aces spots.
Case 138 To 238 ' 0 Ace of Clubs.
TryDockAce(c, 0, True)
Case 247 To 347 ' 1 Ace of Diamonds.
TryDockAce(c, 1, True)
Case 356 To 456 ' 2 Ace of Hearts.
TryDockAce(c, 2, True)
Case 469 To 565 ' 3 Ace of spades.
TryDockAce(c, 3, True)
Case Else
' Card not playable at location it was dropped to.
' Move card back to old position.
c.Location = c.OldPoint
End Select
' Values for rows and column positions:
' Rows (Y Pos) {135, 160, 185, 210, 235, 260, 285}
' Columns (X Pos) {195, 278, 361, 444, 527, 610, 693, 776}
Case 157 To 233 ' Column 0
idx = Columns(0).Count - 1
Select Case True
Case idx > -1
' First verify that this is not the same top card in
' the column. If it is, return it to its old location.
If Columns(0)(idx) Is c Then
c.Location = c.OldPoint
' Check if Top of card is being dropped
' in range of column 0's Y position. All Cards
' should auto-dock/auto-drop when released, if
' 40-50% covering area of the destination card.
ElseIf c.Top >= Columns(0)(idx).Top - 50 AndAlso _
c.Top <= Columns(0)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 0, False)
Else
' Card not playable at location it was dropped to.
c.Location = c.OldPoint
End If
' If column has no cards in it, check if card is being
' dropped over row zero in the empty column.
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
' Move the card into the empty row and handle where
' the card came from.
MoveToEmptyCol(c, 0, False)
Case Else
' Card not playable at location it was dropped to.
c.Location = c.OldPoint
End Select
Case 240 To 316 ' Column 1
idx = Columns(1).Count - 1
Select Case True
Case idx > -1
If Columns(1)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(1)(idx).Top - 50 AndAlso _
c.Top <= Columns(1)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 1, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
MoveToEmptyCol(c, 1, False)
Case Else
c.Location = c.OldPoint
End Select
Case 323 To 399 'Either Column 2 or FreeCell 0.
Select Case True
Case c.Top >= 570 AndAlso c.Top <= 681
' Card is over Free Cell 0.
' Try to dock to Free Cell 0.
TryDockFC(c, 0)
Case Columns(2).Count > 0
idx = Columns(2).Count - 1
If Columns(2)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(2)(idx).Top - 50 AndAlso _
c.Top <= Columns(2)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 2, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
' Card over first row in empty column.
MoveToEmptyCol(c, 2, False)
Case Else
c.Location = c.OldPoint
End Select
Case 406 To 482 ' Either Column 3 or FreeCell 1.
Select Case True
Case c.Top >= 570 AndAlso c.Top <= 681
' Card is over Free Cell 1.
' Try to dock to Free Cell 1.
TryDockFC(c, 1)
Case Columns(3).Count > 0
idx = Columns(3).Count - 1
If Columns(3)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(3)(idx).Top - 50 AndAlso _
c.Top <= Columns(3)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 3, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
' Card over first row in empty column.
MoveToEmptyCol(c, 3, False)
Case Else
c.Location = c.OldPoint
End Select
Case 489 To 565 ' Either Column 4 or FreeCell 2.
Select Case True
Case c.Top >= 570 AndAlso c.Top <= 681
' Card is over Free Cell 2.
' Try to dock to Free Cell 2.
TryDockFC(c, 2)
Case Columns(4).Count > 0
idx = Columns(4).Count - 1
If Columns(4)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(4)(idx).Top - 50 AndAlso _
c.Top <= Columns(4)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 4, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
' Card over first row in empty column.
MoveToEmptyCol(c, 4, False)
Case Else
c.Location = c.OldPoint
End Select
Case 572 To 648 ' Either Column 5 or FreeCell 3.
Select Case True
Case c.Top >= 570 AndAlso c.Top <= 681
' Card is over Free Cell 3.
' Try to dock to Free Cell 3.
TryDockFC(c, 3)
Case Columns(5).Count > 0
idx = Columns(5).Count - 1
If Columns(5)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(5)(idx).Top - 50 AndAlso _
c.Top <= Columns(5)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 5, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
' Card over first row in empty column.
MoveToEmptyCol(c, 5, False)
Case Else
c.Location = c.OldPoint
End Select
Case 649 To 731 ' Column 6
idx = Columns(6).Count - 1
Select Case True
Case idx > -1
If Columns(6)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(6)(idx).Top - 50 AndAlso _
c.Top <= Columns(6)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 6, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
Me.MoveToEmptyCol(c, 6, False)
Case Else
c.Location = c.OldPoint
End Select
Case 732 To 814 ' Column 7
idx = Columns(7).Count - 1
Select Case True
Case idx > -1
If Columns(7)(idx) Is c Then
c.Location = c.OldPoint
ElseIf c.Top >= Columns(7)(idx).Top - 50 AndAlso _
c.Top <= Columns(7)(idx).Top + 70 Then
TryMoveToColumn(c, idx, 7, False)
Else
c.Location = c.OldPoint
End If
Case c.Top >= Rows(0) - 50 AndAlso c.Top <= Rows(0) + 70
Me.MoveToEmptyCol(c, 7, False)
Case Else
c.Location = c.OldPoint
End Select
Case Else
' Card not playable at location it was dropped to.
' Move card back to old position.
c.Location = c.OldPoint
End Select
End If
End Sub
一旦将所有牌都清除到Ace Home Cells中,就可以在FreeCell中赢得比赛.在此游戏中,线程使用线程安全的调用方法移动每张卡,从而重新初始化卡并散布它们.卡以随机距离散开.有时它们散布得足以看到每张卡.有时它们散布在外面,如下图所示:(Once all cards have been cleared to the Ace Home Cells, in FreeCell, the game has been won. In this game, a thread re-initializes the cards and spreads them out, using a thread-safe invoke method to move each card. Cards are spread out at a random distance. Sometimes they are spread out just enough to see each card. Sometimes they are spread way out, like in the picture below:)
大多数Freecell游戏都保存了游戏,或者保存了可以选择和播放的套牌. Windows XP的Microsoft FreeCell有100,000个可选游戏.我决定将100,000个游戏存储在一个嵌入式二进制文件中,以供选择游戏.对于Freecell而言,最简单的方法是按照特定顺序存储52字节的模式,该模式将在游戏中处理.在字节之间没有填充的情况下,我的100,000个游戏占用了5 MB以上的空间,这就是我的应用程序超过5 MB的原因.我尝试压缩文件,但仍然超过3 MB.微软设法存储了同样的100,000个游戏,而他们的FreeCell应用程序只有55 KB.如果有人知道如何管理,我想知道.(Most Freecell games have saved games, or saved decks that can be selected and played. Microsoft FreeCell for Windows XP has 100,000 selectable games. I decided to store 100,000 games in an embedded binary file for selecting games. The simplest way to do this for Freecell is to store a pattern of 52 bytes in a particular order that it will be dealt out in, for the game. With no padding between the bytes, my 100,000 games took up over 5 MB, which is why my application is over 5 MB. I tried compressing the file, and it was still over 3 MB. Microsoft manages to store the same 100,000 games, and their FreeCell app is only 55 kilobytes. If anyone knows how they manage this, I would like to know.)
更新(Updated):谢谢,MojoFlys指出,当为一套新游戏获取一组纸牌时,无需加载一组字节,您只需将所选的游戏号用作随机类实例的种子,并生成卡那样.然后,您可以根据所选的游戏号进行特定的纸牌交易,而无需存储任何东西.(: Thanks, MojoFlys, for pointing out that when getting a set of cards for a new game, instead of loading a set of bytes, you can simply use the selected game number as a seed for an instance of a random class, and generate the cards that way. Then, you can make a specific card deal based on the game number selected, without having to store anything.)
我修改了项目,这是用户选择游戏的新方法.(I modified the project, and here is the new method for the user selected game.) GameIndex
是选定的游戏,(is the selected game, an) Integer
1至100,000之间.比必须存储100,000个游戏容易得多!(between 1 and 100,000. Much easier than having to store 100,000 games!)
Dim r As New Random(GameIndex)
Dim Cards(51) As Byte
Dim st As New Generic.Stack(Of Byte)
Do
For b As Byte = 0 To 51
b = CType(r.Next(0, 52), Byte)
If Not st.Contains(b) Then
st.Push(b)
End If
Next b
Loop Until st.Count = 52
更新(Updated):我在代码中发现了一个错误,该错误记录了对哪些卡进行了排序,并且可以作为一列进行移动.它在(: I found a bug in the code that records which cards are sorted, and can be moved as a column. It was in the) SetSorted
子程序.这是更新的代码.(subroutine. Here is the updated code.)项目下载和可执行文件下载均已更新(The project download and executable download have both been updated).请注意,在旧的子程序中,(. Note that in the old subroutine, in the) For Next
循环,如果下一张相反的牌不匹配,则(loop, if the next opposite card did not match, the) Else
语句丢失,并且不会退出子程序.取而代之的是,它会一直循环播放,因此您可以在同一列中放置两组已排序的卡片,并将移动事件添加到应保持不可移动状态的卡片中.(statement was missing, and it would not exit the sub. Instead, it would keep looping, so you could have two sets of sorted cards in the same column, and move events would be added to cards that should remain un-moveable.)
Sub SetSorted(ByVal Col As Byte)
Dim idx As Integer
' Remove sorted card events from all
' of the cards in the column.
For idx = 0 To Columns(Col).Count - 1
RemoveSortedEvents(Columns(Col)(idx))
Next idx
idx = Columns(Col).Count - 1
' For there to be a moveable group of cards, there must
' be at least 2 cards/count must be at least 2.
If idx > 0 Then
Dim Cards As Byte()
For i As Integer = idx To 1 Step -1
Cards = pc.NextOppositeSuite(Columns(Col)(i).CardValue)
If Cards(0) = Columns(Col)(i - 1).CardValue OrElse _
Cards(1) = Columns(Col)(i - 1).CardValue Then
AddSortedEvents(Columns(Col)(i - 1))
Else
Exit Sub
End If
Next i
End If
End Sub
这个项目的编写确实很有趣,而且这是您很难放下的那些有趣的项目之一.我开始在一个周末进行编码,然后将一个有趣的编码周末变成了三个:).(This project was really a lot of fun to code, and it was one of those fun projects you have a hard time putting down. I started coding it over one weekend, and one weekend of coding for fun turned into three :).) 请注意,要在Windows Vista中运行此应用程序,您需要复制(Please note that to run this application in Windows Vista, you will need to copy)**Cards.dll(Cards.dll)**到exe文件所在的文件夹,也可以运行RegSvr32并注册(to the same folder that the exe file is in, or you can also run RegSvr32 and register)**cards.dll(cards.dll)**在Vista中.(in Vista.) 免费软件(Freeeware):请随时使用或修改此项目中的任何代码,但请勿将其用于任何商业产品.(: Please feel free to use or modify any of the code in this project, but do not use it for any commercial product.) 免责声明(Disclaimer):对于使用本文中发布的任何代码对任何计算机设备造成的任何损坏或可能造成的任何数据丢失,我概不负责.使用此代码需要您自担风险.(: I am not responsible for any damage to any computer equipment, or for any data loss that might occur while using any of the code posted in this article. Use this code at your own risk.)
许可
本文以及所有相关的源代码和文件均已获得The Code Project Open License (CPOL)的许可。
VB8.0 VB9.0 VB6 VB VB7.x Windows WinXP Visual-Studio Design Dev 新闻 翻译