cards.pas

这是一个扑克牌游戏。 1.抓有黑桃7 的玩家首先出黑桃7。 2.然后按逆时针方向出牌。每位玩家依次出牌

{
接龙游戏的牌局数据处理

牌索引 0..12 黑桃(A,2..K) 13..25 红桃(A,2..K) 26..38 梅花(A,2..K) 39..51 方块(A,2..K)

黄文林 2006-02-11
}
unit Cards;

interface

const
  scNone 						= $FF;       	//空标志
  CARD_COUNT 				= 52;      		//扑克张数
  PLAYER_COUNT 			= 4;   				//玩家数
  PLAYER_CARD_COUNT = 13;   			//玩家的扑克数
  FIRST_OUT_CARD 		= 6;   				//首发的牌(黑桃7)

type
  TPlayerCard = record
  	Card: array[0..PLAYER_CARD_COUNT - 1] of Integer;   //牌索引
    Score: Integer;                                     //发牌后全部牌的分数和
  	Count: Integer;                                     //当前张数
  end;
  TOutCard = record
    Min, Max: Integer;  //最小,最大牌, 当前花色未出牌时值为scNone
    MinOwner, MaxOwner: Integer;  //哪个玩家出的牌, 当前花色未出牌时值为scNone
    Order: Integer;  //出牌顺序, 当前花色未出牌时值为0
    MinCover: array[0..PLAYER_COUNT - 1] of Boolean;  //最小牌为此牌后玩家的盖牌情况
    MaxCover: array[0..PLAYER_COUNT - 1] of Boolean;  //最大牌为此牌后玩家的盖牌情况
  end;
  TGoCardState = (gcsOut, gcsCover, gcsError);   //出牌, 盖牌, 错误;
  TGoCard = record
    PlayerIndex: Integer;   //玩家索引
    CardIndex: Integer;     //牌位置索引
    CardID: Integer;         //牌ID
    State: TGoCardState;    //状态
  end;

  TDeskCards = array[0..CARD_COUNT - 1] of Integer;
  TPlayerCards = array[0..PLAYER_COUNT - 1] of TPlayerCard;
  TPlayerScore = array[0..PLAYER_COUNT - 1] of Integer;
  TOutCards = array[0..3] of TOutCard;
  TGameState = (gsStart, gsGo, gsEnd);

  TCards = class
  private
    FDeskCards: TDeskCards;    	//桌上的扑克牌, 用于洗牌后发给玩家
    FPlayerCards, FPlayerCoverCards: TPlayerCards;	//各玩家手上的,盖掉的扑克牌
    FPlayerScore: TPlayerScore;  //各玩家分数
    FOutCards: TOutCards;   //各花色已发出的牌
    FCurrentPlayer: Integer;   //当前出牌的玩家
    FFirstPlayer: Integer;    //首先出牌的玩家
    FState: TGameState;       //游戏状态
    procedure ShuffleCard;   //洗牌
    procedure DealCard;   //发牌
    procedure SortCard;   //牌排序
    procedure TotalScore;   //统计分数
    procedure NextPlayer;   //下一玩家
    procedure OutCard(APlayerIndex, ACardIndex: Integer);      //出牌处理
    procedure CoverCard(APlayerIndex, ACardIndex: Integer);    //盖牌处理
    function CanOut(APlayerIndex, ACardIndex: Integer): Boolean;  //牌是否可出
    function HaveOutCard(APlayerIndex: Integer): Boolean;		//是否有可出的牌
    function CalcOutCard(APlayerIndex: Integer): Integer;  	//电脑出牌计算
    function CalcCoverCard(APlayerIndex: Integer): Integer;	//电脑盖牌计算
    function GetSuit(ACardID: Integer): Integer;   //取得花色
    function GetNum(ACardID: Integer): Integer;    //取得牌值
    function GetScore(ACardID: Integer): Integer; overload;  //取得牌的分值
    function GetScore(ASuit, ANum: Integer): Integer; overload;//取得牌的分值
    function FindCard(APlayerIndex, ASuit, ANum: Integer): Integer; //在自已手上找牌,,没找到返回-1
    function FindCoverCard(APlayerIndex, ASuit, ANum: Integer): Integer;  //在自已的盖牌区找牌,没找到返回-1,
    function IsCover(APlayerIndex, ACardIndex: Integer): Boolean; //牌是否必盖（前面的牌被盖）
    function IsLate(APlayerIndex, ACardIndex: Integer): Boolean; //牌是否没有回合可出牌
    function IsTop(APlayerIndex, ACardIndex: Integer): Boolean;  //牌是否是最顶部的牌
    function HaveCont(APlayerIndex, ACardIndex: Integer): Boolean;  //牌前面的牌是否都在自已手里
    function HaveNext(APlayerIndex, ACardIndex: Integer; ANextN: Integer = 1): Boolean;  //牌后面的第几张牌是否在自已手里
    function AfterScore(APlayerIndex, ACardIndex: Integer): Integer; //后面的牌分数总和(当前玩家）
    function AfterScoreAll(APlayerIndex, ACardIndex: Integer): Integer; //后面的牌分数总和(所有玩家）
    function AfterQuantity(APlayerIndex, ACardIndex: Integer): Integer; //后面的牌张数
    function BeforeQuantity(APlayerIndex, ACardIndex: Integer): Integer;  //前面的牌张数
    function DistanceOut(ACardID: Integer): Integer; //距离已出的牌的张数,若出错（此牌花色未出过牌），返回-1
    function NextIsCover(APlayerIndex, ACardIndex: Integer): Boolean; //下一张是否被自已盖了
    function PriorOutIsMe(ASuit, APlayerIndex, ANum: Integer): Boolean; //此花色的上一张是不是自已出的
    function SureOut(APlayerIndex, ACardIndex: Integer): Boolean; //是否确定可以出
  public
    property PlayerCards: TPlayerCards read FPlayerCards;
    property PlayerCoverCards: TPlayerCards read FPlayerCoverCards;
    property CurrentPlayer: Integer read FCurrentPlayer;
    property FirstPlayer: Integer read FFirstPlayer;
    property State: TGameState read FState;
    property OutCards: TOutCards read FOutCards;
    property PlayerScore: TPlayerScore read FPlayerScore;
    constructor Create;
    procedure NewGame;      //新游戏 （开局, 重新计分）
    procedure StartGame;    //开始游戏
    function ComputerGo: TGoCard;  //电脑玩家出牌,返回出的牌序号
    function HumanGoHelp: Integer;   //玩家出牌求助,返回牌序号
    function HumanGo(ACardIndex: Integer): TGoCard;    //玩家出牌
 published
  end;

implementation

constructor TCards.Create;
var
  i: Integer;
begin
  //初始化
  Randomize;
  for i := 0 to CARD_COUNT - 1 do
    FDeskCards[i] := i;
  ShuffleCard;
  FState := gsEnd;
end;

procedure TCards.NewGame;
var
  i: Integer;
begin
  //玩家分数清零
  for i := 0 to PLAYER_COUNT - 1 do
    FPlayerScore[i] := 0;
  //StartGame;
end;

procedure TCards.StartGame;
begin
  ShuffleCard;   //洗牌100次
  DealCard;           //发牌
  SortCard;           //牌排序
  FState := gsStart;
end;

function TCards.ComputerGo: TGoCard;
begin
  Result.PlayerIndex := FCurrentPlayer;
  if HaveOutCard(FCurrentPlayer) then
  begin
    Result.CardIndex := CalcOutCard(FCurrentPlayer);
    Result.CardID := FPlayerCards[FCurrentPlayer].Card[Result.CardIndex];
    Result.State := gcsOut;
    OutCard(FCurrentPlayer, Result.CardIndex);
  end
  else begin                          
    Result.CardIndex := CalcCoverCard(FCurrentPlayer);
    Result.CardID := FPlayerCards[FCurrentPlayer].Card[Result.CardIndex];
    Result.State := gcsCover;
    CoverCard(FCurrentPlayer, Result.CardIndex);
  end;
end;

function TCards.HumanGoHelp: Integer;
begin
  if HaveOutCard(FCurrentPlayer) then
    Result := CalcOutCard(FCurrentPlayer)
  else
    Result := CalcCoverCard(FCurrentPlayer)
end;

function TCards.HumanGo(ACardIndex: Integer): TGoCard;
begin
  Result.PlayerIndex := FCurrentPlayer;
  Result.CardIndex := ACardIndex;
  Result.CardID := FPlayerCards[FCurrentPlayer].Card[ACardIndex];
  if CanOut(FCurrentPlayer, ACardIndex) then
  begin
    Result.State := gcsOut;
    OutCard(FCurrentPlayer, ACardIndex)
  end
  else if not HaveOutCard(FCurrentPlayer) then
  begin
    Result.State := gcsCover;
    CoverCard(FCurrentPlayer, ACardIndex)
  end
  else
    Result.State := gcsError;
end;

procedure TCards.ShuffleCard;
var
  i, m, n: Integer;
  cards: TDeskCards;
begin
  //插入式洗牌
  //1.将牌放入一临时数组。
  for i := 0 to CARD_COUNT - 1 do
  begin
    cards[i] := FDeskCards[i];
    FDeskCards[i] := scNone;
  end;
  //2.产生随机数，从此数开始往后找空位，依次将临时数组的牌插回。
  for i := 0 to CARD_COUNT - 1 do
  begin
    m := Random(CARD_COUNT - 1);
    n := m;
    repeat
      if FDeskCards[n] = scNone then  //找到空位
      begin
        FDeskCards[n] := cards[i];
        Break;
      end
      else begin  //否则往后找
        Inc(n);
        if n = CARD_COUNT then n := 0;
      end;
    until n = m;
  end;
end;

procedure TCards.DealCard;
var
  i, m, n: Integer;
begin
  //初始玩家牌状态
  for i := 0 to PLAYER_COUNT - 1 do
  begin
		FPlayerCards[i].Count := PLAYER_CARD_COUNT;
    FPlayerCards[i].Score := 0;
		FPlayerCoverCards[i].Count := 0;
  end;
  //发牌
  for i := 0 to CARD_COUNT - 1 do
  begin
    m := i div 4;
    n := i mod 4;
    FPlayerCards[n].Card[m] := FDeskCards[i];
    FPlayerCards[n].Score := FPlayerCards[n].Score + GetScore(FDeskCards[i]);
    if FDeskCards[i] = FIRST_OUT_CARD then
    begin
      FFirstPlayer := n;    //首先出牌玩家
      FCurrentPlayer := n;
    end;
  end;
  //清空已出牌
  for i := 0 to 3 do
  begin
  	FOutCards[i].Min := scNone;
    FOutCards[i].Max := scNone;
    FOutCards[i].MinOwner := scNone;
    FOutCards[i].MaxOwner := scNone;
    FOutCards[i].Order := 0;
    for m := 0 to PLAYER_COUNT - 1 do
    begin
      FOutCards[i].MinCover[m] := False;
      FOutCards[i].MaxCover[m] := False;
    end;
 	end;
end;

procedure TCards.SortCard;
var
  player, i, j, k, m: Integer;
begin
  //根据牌索引采用冒泡法排序
  for player := 0 to PLAYER_COUNT - 1 do
  begin
    for i := 0 to PLAYER_CARD_COUNT - 2 do
    begin
      k := i;
      for j := i + 1 to PLAYER_CARD_COUNT - 1 do
        if FPlayerCards[player].Card[k] > FPlayerCards[player].Card[j] then
          k := j;
      if k <> i then
      begin
        m := FPlayerCards[player].Card[k];
        FPlayerCards[player].Card[k] := FPlayerCards[player].Card[i];
        FPlayerCards[player].Card[i] := m;
      end;
    end;
  end;
end;

procedure TCards.NextPlayer;
begin
  if FState = gsStart then FState := gsGo;
  FCurrentPlayer := FCurrentPlayer + 1;
  if FCurrentPlayer = PLAYER_COUNT then
    FCurrentPlayer := 0;
  //若牌一小局完成时
  if (FCurrentPlayer = FFirstPlayer) and (FPlayerCards[0].Count = 0) then
  begin
    TotalScore;
    FState := gsEnd;
  end;
end;

procedure TCards.OutCard(APlayerIndex, ACardIndex: Integer);
var
  suit, num, i, n: Integer;
begin
  suit := GetSuit(FPlayerCards[APlayerIndex].Card[ACardIndex]);
  num := GetNum(FPlayerCards[APlayerIndex].Card[ACardIndex]);
  //写入最新已出的牌
  if num <= 6 then
  begin
    FOutCards[suit].Min := num;
    FOutCards[suit].MinOwner := APlayerIndex;
    for i := 0 to PLAYER_COUNT - 1 do
      FOutCards[suit].MinCover[i] := False;
  end;
  if num >= 6 then
  begin
    FOutCards[suit].Max := num;
    FOutCards[suit].MaxOwner := APlayerIndex;
    for i := 0 to PLAYER_COUNT - 1 do
      FOutCards[suit].MaxCover[i] := False;
  end;
  if num = 6 then
  begin
    //设置此花色的出牌顺序
    n := 1;
    for i := 0 to 3 do
      if (i <> suit) and (FOutCards[i].Min <> scNone) then Inc(n);
    FOutCards[suit].Order := n;
  end;
  //清除玩家的牌
  FPlayerCards[APlayerIndex].Card[ACardIndex] := scNone;
  Dec(FPlayerCards[APlayerIndex].Count);
  //下一玩家
  NextPlayer;
end;

procedure TCards.CoverCard(APlayerIndex, ACardIndex: Integer);
var
  i: Integer;
begin
  //写入盖牌
  Inc(FPlayerCoverCards[APlayerIndex].Count);
  FPlayerCoverCards[APlayerIndex].Card[FPlayerCoverCards[APlayerIndex].Count - 1]
    := FPlayerCards[APlayerIndex].Card[ACardIndex];
  for i := 0 to 3 do
  begin
    FOutCards[i].MinCover[APlayerIndex] := True;
    FOutCards[i].MaxCover[APlayerIndex] := True;
  end;
  //清除玩家的牌
  FPlayerCards[APlayerIndex].Card[ACardIndex] := scNone;
  Dec(FPlayerCards[APlayerIndex].Count);
  //下一玩家
  NextPlayer;
end;

function TCards.GetSuit(ACardID: Integer): Integer;
begin
  Result := ACardID div 13;
end;

function TCards.GetNum(ACardID: Integer): Integer;
begin
  Result := ACardID mod 13;
end;

function TCards.GetScore(ACardID: Integer): Integer;
begin
  Result := GetScore(GetSuit(ACardID), GetNum(ACardID));
end;

function TCards.GetScore(ASuit, ANum: Integer): Integer;
begin
  Result := ANum + 1;
end;

procedure TCards.TotalScore;
var
  i, j, n: Integer;
begin
  for i := 0 to PLAYER_COUNT - 1 do
  begin
    n := 0;
    //统计玩家盖的牌的分数
    for j := 0 to FPlayerCoverCards[i].Count - 1 do
      n := n + GetScore(FPlayerCoverCards[i].Card[j]);
    FPlayerScore[i] := FPlayerScore[i] + n;
  end;
end;

function TCards.CanOut(APlayerIndex, ACardIndex: Integer): Boolean;
begin
  //若为首出玩家，牌不为首先牌，则牌不能出。
  if (FState = gsStart) and (FFirstPlayer = APlayerIndex)
    and (FPlayerCards[APlayerIndex].Card[ACardIndex] <> FIRST_OUT_CARD) then
  begin
    Result := false;
    Exit;
  end;
  //若牌为7则可出
  if GetNum(FPlayerCards[APlayerIndex].Card[ACardIndex]) = 6 then
    Result := True
  else  //与已出的牌相距等于0，则返回可出
    Result := DistanceOut(FPlayerCards[APlayerIndex].Card[ACardIndex]) = 0;
end;

function TCards.HaveOutCard(APlayerIndex: Integer): Boolean;
var
  suit, i: Integer;
begin
  Result := True;
  //如果为首出玩家，则未出过一张牌，则必有牌出
  if (FState = gsStart) and (FFirstPlayer = APlayerIndex) then
    exit;
  for suit := 0 to 3 do
  begin
    if FOutCards[suit].Min = scNone then Continue; //如果此花色未出过牌，则跳过此花色判断。
    //逐张检查牌是否可出
    for i := 0 to PLAYER_CARD_COUNT - 1 do
    begin
      if (FPlayerCards[APlayerIndex].Card[i] = scNone) then Continue;
      if CanOut(APlayerIndex, i) then exit;
    end;
  end;
  Result := False;
end;

function TCards.FindCard(APlayerIndex, ASuit, ANum: Integer): Integer;
var
  i, suit, num: Integer;
begin
  for i := 0 to PLAYER_CARD_COUNT - 1 do
  begin
    if FPlayerCards[APlayerIndex].Card[i] = scNone then Continue;
    suit := GetSuit(FPlayerCards[APlayerIndex].Card[i]);
    num := GetNum(FPlayerCards[APlayerIndex].Card[i]);
    if (suit = ASuit) and (num = ANum) then
    begin
      Result := i;
      Exit;
    end;
  end;
  Result := 1;
end;

function TCards.FindCoverCard(APlayerIndex, ASuit, ANum: Integer): Integer;
var
  i, suit, num: Integer;
begin
  for i := 0 to FPlayerCoverCards[APlayerIndex].Count - 1 do
  begin
    suit := GetSuit(FPlayerCoverCards[APlayerIndex].Card[i]);
    num := GetNum(FPlayerCoverCards[APlayerIndex].Card[i]);
    if (suit = ASuit) and (num = ANum) then
    begin
      Result := i;
      Exit;
    end;
  end;
  Result := -1;
end;

function TCards.IsCover(APlayerIndex, ACardIndex: Integer): Boolean;