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

📄 pcardclass.pas

📁 网络对站平台
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit PcardClass;

interface
uses SysUtils, Contnrs, Dialogs, Classes, PGmProtect;

type
  SKind = (Fan, Xi, Red, Black, BigSupper, SmallSupper); //4种花色+大飞+小飞
  SWinCardKind = (SWCKsan, SWCKdui, SWCKtwodui, SWCKTree, SWCKsun, SWCKsamecolor,
    SWCKTreeandTwo, SWCKfourandone, SWCKsameCLSun);
  PRoneCard = ^ROneCard;
  ROneCard = packed record //牌的结构
    Kind: SKind;
    Value: Integer;
  end;
  TBaseCard = class
  private
    FtotCard: Byte; //总牌数
    FCardArr: array of ROneCard; //一扑克数组
    FCardStack: TStack; //当前牌局
    FCurrCardCount: Byte; //当前的牌数
    FRandomarr: array of Byte;
  public
    property TotCardCounts: byte read FtotCard write FtotCard;
    property CardCount: Byte read FCurrCardCount write FCurrCardCount; //当前的牌数
    procedure RandomArr(Icount: Byte); //洗数组
    procedure CardStackPop; //将洗过的牌写进入牌局
    function GetRandomArrEntry: pointer;
    function GetRandom(Ilength: byte): Pointer; //设置好数组大小后从外部获取数组
    procedure MakeCards(INeesSupper: boolean = True; ILoopCount: byte = 1); //产生牌局 可以选择是否要大小鬼 和 产生几副牌
    function GetOneCard: PROneCard; //发一张牌
    function TralsateCard(IOneCard: ROneCard): string; //转换牌的表现形式
    function ResultCall(ICards: TList): string; //返回一组数
    constructor Create;
    destructor Destory;
  end;
  sPlayerPostion = (sdown, sright, sup, sleft);
  TPlayer = class //玩家类
  private

    FCardArr: TList; //玩家手上的牌
    FPostion: sPlayerPostion; //玩家的位置
    function GetCurrCardCount: Byte;
  public
    PlayerInfo: PRplayer; //玩家的信息
    property CurrCardCount: Byte read GetCurrCardCount default 0; //手里的牌数
    property Cards: TList read FCardArr write FCardArr; //手里的牌
    property Postion: sPlayerPostion read FPostion write FPostion; //玩家的位置
    function InCard(Icard: PROneCard): PROneCard; //摸牌
    function OutCard(Iindex: Integer): PROneCard; //打牌
    constructor Create(IInfo: PRplayer);
    destructor Destory;
  end;
  TZSYCard = class(TBaseCard) //争上游
  private
    FCurrPlayerIndex: Byte; // 记录当前应该出牌的用户
    FLastId: Byte; //上一个用户
    FLastCards: TList; //最后一局的牌局
    FCurrCards: Tlist; //当前的牌局
  protected
    property LastID: byte read FLastId write FLastId; //上一个用户
    property LastCards: TList read FLastCards write FLastCards; //最后一局的牌局
  public
    property CurrCards: TList read FCurrCards write FCurrCards;
    property CurrSendPlayerIdx: Byte read FCurrPlayerIndex write FCurrPlayerIndex; //记录当前应该出牌的用户
    procedure NextPlayer;
    function CanPlayThisCard(IPlayer: TPlayer; IcardS: TList): boolean; //是否可以出这把牌
    function CheckWined(IPlayer: TPlayer): boolean; //检测是否已经赢了
    function RandomBeginPlayer(IplayerCount: Byte): Byte; //随机一个开始出牌的用户
    constructor Create;
    destructor Destory;
  end;
  TTSPCard = class(TBaseCard) //梭哈
  private
    FCurrPlayerIndex: Byte; // 记录当前应该出牌的用户
    FLastMoney: Integer; //上一局的赌注
    function CaseScKind(Icards: TList): SWinCardKind; //返回牌的类型
  public
    PlayerArr: array of TPlayer;
    property CurrPlayerIndex: Byte read FCurrPlayerIndex write FCurrPlayerIndex;
    property LastMoney: Integer read FLastMoney write FLastMoney default 0;
    procedure NextPlayer;
    function CheckGameWined: Byte; //检测游戏的赢家
    function NeedCheckWin: boolean; //下一用户之前判断是否需要检测输赢
    function CheckOutWined: Byte; //用户退出的时候检查是否赢了 如果赢了返回索引号
    function RandomBeginPlayer(IplayerCount: Byte): Byte; //随机一个开始出牌的用户
    procedure SetPlayerPostion(IcurrIdx: Byte); //根据当前用户索引 设定位置
    constructor Create(IPlayerCount: Byte; Iarr: array of PRplayer);
    destructor Destory;
  end;

implementation

{ TCard }

procedure TBaseCard.CardStackPop;
var
  I: Integer;
begin
  for I := 0 to Length(FRandomarr) - 1 do begin // Iterate
    FCardStack.Push(@FCardArr[FRandomarr[i]]);
  end; // for
end;

constructor TBaseCard.Create;
begin
  FCardStack := TStack.Create;
end;

destructor TBaseCard.Destory;
begin
  FCardStack.Free;
  FCardArr := nil;
  inherited;
end;

function TBaseCard.GetOneCard: PROneCard;
begin
  Dec(FCurrCardCount);
  Result := PROneCard(FCardStack.Pop);
end;

function TBaseCard.GetRandom(Ilength: byte): Pointer;
begin
  SetLength(FRandomarr, Ilength);
  Result := Pointer(FRandomarr);
end;

function TBaseCard.GetRandomArrEntry: pointer;
begin
  Result := @FRandomarr;
end;

procedure TBaseCard.MakeCards(INeesSupper: boolean = True; ILoopCount: byte = 1);
var
  j, L, M: Integer;
  LKind: SKind;
begin
  FtotCard := 0;
  for M := 1 to ILoopCount do begin // Iterate
    for L := 0 to 3 do begin // Iterate
      LKind := Skind(L);
      for J := 1 to 13 do begin // Iterate
        Inc(FtotCard);
        SetLength(FCardArr, FtotCard);
        FCardArr[FtotCard - 1].Kind := LKind;
        FCardArr[FtotCard - 1].Value := J;
      end; // for
    end; // for
    if INeesSupper then begin
      Inc(FtotCard, 1);
      SetLength(FCardArr, FtotCard);
      FCardArr[FtotCard - 1].Kind := BigSupper;
      FCardArr[FtotCard - 1].Value := 17;
      Inc(FtotCard, 1);
      SetLength(FCardArr, FtotCard);
      FCardArr[FtotCard - 1].Kind := SmallSupper;
      FCardArr[FtotCard - 1].Value := 16;
    end;
  end; // for
end;

procedure TBaseCard.RandomArr(Icount: Byte);
var
  i, X: Integer;
begin
  Randomize;
  SetLength(FRandomarr, Icount);
  for I := 0 to Icount do begin // Iterate
    repeat
      x := Random(Icount);
    until FRandomarr[x] = 0;
    FRandomarr[X] := i;
  end; // for
  FCurrCardCount := Length(FCardArr);
end;

function TBaseCard.ResultCall(ICards: TList): string;
var
  I: Integer;
begin
  for I := 0 to ICards.Count - 1 do begin // Iterate
    Result := Result + '<' + inttostr(i) + '>' + TralsateCard(PROneCard(ICards.Items[i])^);
  end; // for
end;

function TBaseCard.TralsateCard(IOneCard: ROneCard): string;
var
  LTep: string;
begin
  case IOneCard.Kind of //
    Black: ltep := '黑桃';
    Red: Ltep := '红心';
    Xi: LTep := '梅花';
    Fan: Ltep := '方块';
    BigSupper: LTep := '大鬼';
    SmallSupper: LTep := '小鬼';
  end; // case
  case IOneCard.Value of //
    1: LTep := LTep + 'A';
    2: LTep := LTep + '2';
    3: LTep := LTep + '3';
    4: LTep := LTep + '4';
    5: LTep := LTep + '5';
    6: LTep := LTep + '6';
    7: LTep := LTep + '7';
    8: LTep := LTep + '8';
    9: LTep := LTep + '9';
    10: LTep := LTep + '10';
    11: LTep := LTep + 'J';
    12: LTep := LTep + 'Q';
    13: LTep := LTep + 'K';
  end; // case
  Result := LTep;
end;

{ TZSYCard }

procedure TZSYCard.NextPlayer;
begin
  FCurrPlayerIndex := FCurrPlayerIndex + 1;
  if FCurrPlayerIndex > 3 then FCurrPlayerIndex := 0;
end;

function TZSYCard.CanPlayThisCard(IPlayer: TPlayer; IcardS: TList): boolean;
begin
  Result := False;
end;

function TZSYCard.CheckWinEd(IPlayer: TPlayer): boolean;
begin
  Result := IPlayer.CurrCardCount = 0; //判断是否赢了
end;

constructor TZSYCard.Create;
begin
  inherited Create;
  FLastCards := TList.Create;
  FCurrCards := TList.Create;
end;

destructor TZSYCard.Destory;
var
  I: Integer;
begin
  for I := 0 to FLastCards.Count - 1 do begin // Iterate
    Dispose(FLastCards.Items[i]);
  end; // for
  FLastCards.Free;
  FCurrCards.free;
end;

function TZSYCard.RandomBeginPlayer(IplayerCount: Byte): Byte;
begin
  Randomize;
  FCurrPlayerIndex := random(IplayerCount);
  Result := FCurrPlayerIndex;
end;

{ TPlayer }

constructor TPlayer.Create(IInfo: PRplayer);
begin
  PlayerInfo := IInfo;
  FCardArr := TList.Create;
end;

destructor TPlayer.Destory;
begin
  FCardArr.Free;
end;

function TPlayer.GetCurrCardCount: Byte;
begin
  Result := Cards.Count;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -