《天天德州》之德州牛仔概率计算器

unit uTexasPoker;

interface

uses
  SysUtils, Windows;

type
  // 花色(红桃、方块、黑桃、梅花)
  TCardColor = (ccHearts, ccDiamond, ccSpades, ccClubs);

  // 输赢类型(牛仔赢、平局、公牛赢)
  TWinningType = (wtCowboy, wtTie, wtBull);
  
  // 手牌类型(同花、连牌、对子、同花连牌、对A、杂牌)
  THandCardType = (hctFlush, hctStraight, hctOnePair, hctFlushStraight, hctPairA, hctNone);

  // 手牌+公共牌最终所成牌型(高牌、一对、两对、三条、顺子、同花、葫芦、四条(金刚)、同花顺、皇家同花顺)
  TGameCardType = (gctHighCard, gctOnePair, gctTwoPair, gctThreeOfAKind, gctStraight, gctFlush, gctFullHouse, gctFourOfAKind, gctStraightFlush, gctRoyalFlush);

  TCardProp = record
    Value: Byte;
    Color: TCardColor;
  end;

  PPlayerCardType = ^TPlayerCardType;
  TPlayerCardType = record
    GameCardType: TGameCardType;
    CardValueArr: array[1..5] of Byte;    
  end;

  PColoredCardArr = ^TColoredCardArr;
  TColoredCardArr = array[TCardColor, 1..14] of Byte;
  
const
  cCardPropLen                                      = SizeOf(TCardProp);
  cPlayerCardTypeLen                                = SizeOf(TPlayerCardType);
  cHandCardTypeDesc: array[THandCardType] of string = (‘同花‘, ‘连牌‘, ‘对子‘, ‘同花连牌‘, ‘对A‘, ‘普通‘);
  cGameCardTypeDesc: array[TGameCardType] of string = (‘高牌‘, ‘一对‘, ‘两对‘, ‘三条‘, ‘顺子‘, ‘同花‘, ‘葫芦‘, ‘金刚‘, ‘同花顺‘, ‘皇家同花顺‘);

type
  TExecutingCallback = procedure of object;
  TOutputCallback    = procedure(const S: string) of object;
  
  TTexasPoker = class
  private
    FDeckCards: array[1..52] of Byte;
    FCommCards: array[1..5] of Byte;
    FPlayerCards: array[1..4] of Byte;
    FHandCardProps: array[1..4] of TCardProp;
    FCowboyCards: TColoredCardArr;
    FBullCards: TColoredCardArr;
    FCowboyCardType: TPlayerCardType;
    FBullCardType: TPlayerCardType;
    FHandCardTypes: array[THandCardType] of Integer;
    FWinningTypes: array[TWinningType] of Integer;
    FWinCardTypes: array[TGameCardType] of Integer;
    FCowboyCardTypes: array[TGameCardType] of Integer;
    FBullCardTypes: array[TGameCardType] of Integer;
    procedure Reset;
    procedure Initialize;
    procedure GenCommCards;
    procedure GenPlayerCards;
    procedure NormalizePlayerCards;    
    procedure StatHandCardTypes;
    procedure AnalysePlayerCardTypes;
    procedure ComparePlayerCardTypes;
    procedure OutputStats(const ExecNum: Integer; const OutputCallback: TOutputCallback);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Execute(const ExecNum: Integer; const ExecutingCallback: TExecutingCallback; const OutputCallback: TOutputCallback);
    function CardValueFromIdx(Idx: Byte): Byte;
    function CardColorFromIdx(Idx: Byte): TCardColor;
  end;

implementation

{ TTexasPoker }

procedure TTexasPoker.AnalysePlayerCardTypes;

  function CheckRoyalFlush(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    CardColor: TCardColor;
    I: Integer;
  begin
    for CardColor := Low(TCardColor) to High(TCardColor) do
    begin
      if (ColoredCardArr[CardColor][14] = 1) and (ColoredCardArr[CardColor][13] = 1) and (ColoredCardArr[CardColor][12] = 1)
        and (ColoredCardArr[CardColor][11] = 1) and (ColoredCardArr[CardColor][10] = 1)
      then
      begin
        PlayerCardType.GameCardType := gctRoyalFlush;
        for I := 1 to 5 do
          PlayerCardType.CardValueArr[I] := 14 - I + 1;
        Result := True;
        Exit;
      end;
    end;
    Result := False;
  end;

  function CheckStraightFlush(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    CardColor: TCardColor;
    I, J: Integer;
  begin
    for I := 13 downto 5 do
    begin
      for CardColor := Low(TCardColor) to High(TCardColor) do
      begin
        if (ColoredCardArr[CardColor][I] = 1) and (ColoredCardArr[CardColor][I - 1] = 1) and (ColoredCardArr[CardColor][I - 2] = 1)
          and (ColoredCardArr[CardColor][I - 3] = 1) and (ColoredCardArr[CardColor][I - 4] = 1)
        then
        begin
          PlayerCardType.GameCardType := gctStraightFlush;
          for J := 1 to 5 do
            PlayerCardType.CardValueArr[J] := I - J + 1;
          Result := True;
          Exit;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckFourOfAKind(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J: Integer;
  begin
    for I := 14 downto 2 do
    begin
      if (ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccDiamond][I] = 1)
        and (ColoredCardArr[ccSpades][I] = 1) and (ColoredCardArr[ccClubs][I] = 1)
      then
      begin
        PlayerCardType.GameCardType := gctFourOfAKind;
        for J := 1 to 4 do
          PlayerCardType.CardValueArr[J] := I;
        for J := 14 downto 2 do
        begin
          if (J <> I)
            and ((ColoredCardArr[ccHearts][J] = 1) or (ColoredCardArr[ccDiamond][J] = 1) or (ColoredCardArr[ccSpades][J] = 1) or (ColoredCardArr[ccClubs][J] = 1))
          then
          begin
            PlayerCardType.CardValueArr[5] := J;
            Result := True;
            Exit;
          end;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckFullHouse(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J, K: Integer;
  begin
    for I := 14 downto 2 do
    begin
      if ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccSpades][I] = 1))
         or ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
         or ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccSpades][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
         or ((ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccSpades][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
      then
      begin
        for J := 14 downto 2 do
        begin
          if J <> I then
          begin
            if ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccDiamond][J] = 1))
              or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
              or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
              or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
              or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
              or ((ColoredCardArr[ccSpades][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
            then
            begin
              PlayerCardType.GameCardType := gctFullHouse;
              for K := 1 to 3 do
                PlayerCardType.CardValueArr[K] := I;
              PlayerCardType.CardValueArr[4] := J;
              PlayerCardType.CardValueArr[5] := J;
              Result := True;
              Exit;
            end;
          end;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckFlush(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    CardColor: TCardColor;
    I, Cnt: Integer;
  begin    
    for CardColor := Low(TCardColor) to High(TCardColor) do
    begin
      Cnt := 0;
      for I := 14 downto 2 do
      begin
        if ColoredCardArr[CardColor][I] = 1 then
        begin
          Inc(Cnt);
          PlayerCardType.CardValueArr[Cnt] := I;
          if Cnt >= 5 then
            Break;
        end;
      end;
      if Cnt >= 5 then
      begin
        PlayerCardType.GameCardType := gctFlush;
        Result := True;
        Exit;
      end;
    end;
    Result := False;
  end;

  function CheckStraight(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J: Integer;
  begin
    for I := 14 downto 5 do
    begin
      if ((ColoredCardArr[ccHearts][I] = 1) or (ColoredCardArr[ccDiamond][I] = 1) or (ColoredCardArr[ccSpades][I] = 1) or (ColoredCardArr[ccClubs][I] = 1))
        and ((ColoredCardArr[ccHearts][I - 1] = 1) or (ColoredCardArr[ccDiamond][I - 1] = 1) or (ColoredCardArr[ccSpades][I - 1] = 1) or (ColoredCardArr[ccClubs][I - 1] = 1))
        and ((ColoredCardArr[ccHearts][I - 2] = 1) or (ColoredCardArr[ccDiamond][I - 2] = 1) or (ColoredCardArr[ccSpades][I - 2] = 1) or (ColoredCardArr[ccClubs][I - 2] = 1))
        and ((ColoredCardArr[ccHearts][I - 3] = 1) or (ColoredCardArr[ccDiamond][I - 3] = 1) or (ColoredCardArr[ccSpades][I - 3] = 1) or (ColoredCardArr[ccClubs][I - 3] = 1))
        and ((ColoredCardArr[ccHearts][I - 4] = 1) or (ColoredCardArr[ccDiamond][I - 4] = 1) or (ColoredCardArr[ccSpades][I - 4] = 1) or (ColoredCardArr[ccClubs][I - 4] = 1))
      then
      begin
        PlayerCardType.GameCardType := gctStraight;
        for J := 1 to 5 do
          PlayerCardType.CardValueArr[J] := I - J + 1;
        Result := True;
        Exit;
      end;
    end;
    Result := False;
  end;

  function CheckThreeOfAKind(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J, K: Integer;
  begin
    for I := 14 downto 2 do
    begin
      if ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccSpades][I] = 1))
         or ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
         or ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccSpades][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
         or ((ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccSpades][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
      then
      begin
        PlayerCardType.GameCardType := gctThreeOfAKind;
        for J := 1 to 3 do
          PlayerCardType.CardValueArr[J] := I;        
        K := 4;
        for J := 14 downto 2 do
        begin
          if J <> I then
          begin
            if (ColoredCardArr[ccHearts][J] = 1) or (ColoredCardArr[ccDiamond][J] = 1) or (ColoredCardArr[ccSpades][J] = 1) or (ColoredCardArr[ccClubs][J] = 1) then
            begin              
              PlayerCardType.CardValueArr[K] := J;
              Inc(K);
              if K > 5 then
              begin
                Result := True;
                Exit;
              end;
            end;
          end;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckTwoPair(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J, Cnt: Integer;
  begin
    Cnt := 0;
    for J := 14 downto 2 do
    begin
      if ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccDiamond][J] = 1))
        or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
        or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
        or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
        or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
        or ((ColoredCardArr[ccSpades][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
      then
      begin
        Inc(Cnt);
        PlayerCardType.CardValueArr[Cnt * 2 - 1] := J;
        PlayerCardType.CardValueArr[Cnt * 2] := J;
        if Cnt >= 2 then
        begin
          for I := 14 downto 2 do
          begin
            if (I <> PlayerCardType.CardValueArr[1]) and (I <> PlayerCardType.CardValueArr[3]) then
            begin
              if (ColoredCardArr[ccHearts][I] = 1) or (ColoredCardArr[ccDiamond][I] = 1) or (ColoredCardArr[ccSpades][I] = 1) or (ColoredCardArr[ccClubs][I] = 1) then
              begin
                PlayerCardType.GameCardType := gctTwoPair;
                PlayerCardType.CardValueArr[5] := I;
                Result := True;
                Exit;
              end;
            end;
          end;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckOnePair(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J, Cnt: Integer;
  begin
    for J := 14 downto 2 do
    begin
      if ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccDiamond][J] = 1))
        or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
        or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
        or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
        or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
        or ((ColoredCardArr[ccSpades][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
      then
      begin
        PlayerCardType.CardValueArr[1] := J;
        PlayerCardType.CardValueArr[2] := J;
        Cnt := 3;
        for I := 14 downto 2 do
        begin
          if I <> PlayerCardType.CardValueArr[1] then
          begin
            if (ColoredCardArr[ccHearts][I] = 1) or (ColoredCardArr[ccDiamond][I] = 1) or (ColoredCardArr[ccSpades][I] = 1) or (ColoredCardArr[ccClubs][I] = 1) then
            begin              
              PlayerCardType.CardValueArr[Cnt] := I;
              Inc(Cnt);
              if Cnt > 5 then
              begin
                PlayerCardType.GameCardType := gctOnePair;
                Result := True;
                Exit;
              end;
            end;
          end;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckHighCard(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, Cnt: Integer;
  begin
    Result := True;
    PlayerCardType.GameCardType := gctHighCard;
    Cnt := 0;
    for I := 14 downto 2 do
    begin
      if (ColoredCardArr[ccHearts][I] = 1) or (ColoredCardArr[ccDiamond][I] = 1) or (ColoredCardArr[ccSpades][I] = 1) or (ColoredCardArr[ccClubs][I] = 1) then
      begin
        Inc(Cnt);
        PlayerCardType.CardValueArr[Cnt] := I;
        if Cnt >= 5 then
          Exit;
      end;
    end;
  end;

  function Analyse(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): TGameCardType;
  begin
    if CheckRoyalFlush(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctRoyalFlush;
      Exit;
    end;
    if CheckStraightFlush(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctStraightFlush;
      Exit;
    end;
    if CheckFourOfAKind(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctFourOfAKind;
      Exit;
    end;
    if CheckFullHouse(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctFullHouse;
      Exit;
    end;
    if CheckFlush(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctFlush;
      Exit;
    end;
    if CheckStraight(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctStraight;
      Exit;
    end;
    if CheckThreeOfAKind(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctThreeOfAKind;
      Exit;
    end;
    if CheckTwoPair(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctTwoPair;
      Exit;
    end;
    if CheckOnePair(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctOnePair;
      Exit;
    end;
    CheckHighCard(ColoredCardArr, PlayerCardType);
    Result := gctHighCard;
  end;
  
begin
  Inc(FCowboyCardTypes[Analyse(@FCowboyCards, @FCowboyCardType)]);
  Inc(FBullCardTypes[Analyse(@FBullCards, @FBullCardType)]);
end;

function TTexasPoker.CardColorFromIdx(Idx: Byte): TCardColor;
begin
  Result := TCardColor((Idx - 1) mod 4);
end;

function TTexasPoker.CardValueFromIdx(Idx: Byte): Byte;
begin
  Result := (Idx - 1) div 4 + 1;
end;

procedure TTexasPoker.ComparePlayerCardTypes;

  procedure CowboyWin;
  begin
    Inc(FWinningTypes[wtCowboy]);
    Inc(FWinCardTypes[FCowboyCardType.GameCardType]);
  end;

  procedure BullWin;
  begin
    Inc(FWinningTypes[wtBull]);
    Inc(FWinCardTypes[FBullCardType.GameCardType]);
  end;

  procedure PlayEven;
  begin
    Inc(FWinningTypes[wtTie]);
  end;
  
var
  I: Integer;  
begin
  if FCowboyCardType.GameCardType > FBullCardType.GameCardType then
  begin
    CowboyWin;
    Exit;
  end;
  
  if FCowboyCardType.GameCardType < FBullCardType.GameCardType then
  begin
    BullWin;
    Exit;
  end;

  if FCowboyCardType.GameCardType = gctRoyalFlush then
  begin
    PlayEven;
    Exit;
  end;

  if (FCowboyCardType.GameCardType = gctStraightFlush) or (FCowboyCardType.GameCardType = gctStraight) then
  begin
    if FCowboyCardType.CardValueArr[1] > FBullCardType.CardValueArr[1] then
      CowboyWin
    else if FCowboyCardType.CardValueArr[1] < FBullCardType.CardValueArr[1] then
      BullWin
    else
      PlayEven;
    Exit;
  end;

  if (FCowboyCardType.GameCardType = gctFourOfAKind) or (FCowboyCardType.GameCardType = gctFullHouse) then
  begin
    if FCowboyCardType.CardValueArr[1] > FBullCardType.CardValueArr[1] then
      CowboyWin
    else if FCowboyCardType.CardValueArr[1] < FBullCardType.CardValueArr[1] then
      BullWin
    else
    begin
      if FCowboyCardType.CardValueArr[5] > FBullCardType.CardValueArr[5] then
        CowboyWin
      else if FCowboyCardType.CardValueArr[5] < FBullCardType.CardValueArr[5] then
        BullWin 
      else
        PlayEven;
    end;
    Exit;
  end;

  if (FCowboyCardType.GameCardType = gctFlush) or (FCowboyCardType.GameCardType = gctHighCard) then
  begin
    for I := 1 to 5 do
    begin
      if FCowboyCardType.CardValueArr[I] > FBullCardType.CardValueArr[I] then
      begin
        CowboyWin;
        Exit;
      end
      else if FCowboyCardType.CardValueArr[I] < FBullCardType.CardValueArr[I] then
      begin
        BullWin;
        Exit;
      end;
    end;
    PlayEven;
    Exit;
  end;

  if FCowboyCardType.GameCardType = gctThreeOfAKind then
  begin
    if FCowboyCardType.CardValueArr[1] > FBullCardType.CardValueArr[1] then
      CowboyWin
    else if FCowboyCardType.CardValueArr[1] < FBullCardType.CardValueArr[1] then
      BullWin
    else
    begin
      if FCowboyCardType.CardValueArr[4] > FBullCardType.CardValueArr[4] then
        CowboyWin
      else if FCowboyCardType.CardValueArr[4] < FBullCardType.CardValueArr[4] then
        BullWin 
      else
      begin
        if FCowboyCardType.CardValueArr[5] > FBullCardType.CardValueArr[5] then
          CowboyWin
        else if FCowboyCardType.CardValueArr[5] < FBullCardType.CardValueArr[5] then
          BullWin 
        else
          PlayEven;
      end;        
    end;
    Exit;
  end;

  if FCowboyCardType.GameCardType = gctTwoPair then
  begin
    if FCowboyCardType.CardValueArr[1] > FBullCardType.CardValueArr[1] then
      CowboyWin
    else if FCowboyCardType.CardValueArr[1] < FBullCardType.CardValueArr[1] then
      BullWin
    else
    begin
      if FCowboyCardType.CardValueArr[3] > FBullCardType.CardValueArr[3] then
        CowboyWin
      else if FCowboyCardType.CardValueArr[3] < FBullCardType.CardValueArr[3] then
        BullWin 
      else
      begin
        if FCowboyCardType.CardValueArr[5] > FBullCardType.CardValueArr[5] then
          CowboyWin
        else if FCowboyCardType.CardValueArr[5] < FBullCardType.CardValueArr[5] then
          BullWin 
        else
          PlayEven;
      end;        
    end;
    Exit;
  end;

  if FCowboyCardType.GameCardType = gctOnePair then
  begin
    if FCowboyCardType.CardValueArr[1] > FBullCardType.CardValueArr[1] then
      CowboyWin
    else if FCowboyCardType.CardValueArr[1] < FBullCardType.CardValueArr[1] then
      BullWin
    else
    begin
      for I := 3 to 5 do
      begin
        if FCowboyCardType.CardValueArr[I] > FBullCardType.CardValueArr[I] then
        begin
          CowboyWin;
          Exit;
        end
        else if FCowboyCardType.CardValueArr[I] < FBullCardType.CardValueArr[I] then
        begin
          BullWin;
          Exit;
        end;
      end;
      PlayEven;
    end;
    Exit;
  end;end;

constructor TTexasPoker.Create;
begin

end;

destructor TTexasPoker.Destroy;
begin

  inherited;
end;

procedure TTexasPoker.Execute(const ExecNum: Integer; const ExecutingCallback: TExecutingCallback; const OutputCallback: TOutputCallback);
const
  cExecNumMin = 100000;
var
  I, Num: Integer;
begin
  Reset;
  Num := ExecNum;
  if Num < cExecNumMin then
  begin
    Num := cExecNumMin;
    if Assigned(OutputCallback) then
      OutputCallback(Format(‘【模拟次数合理变更：%d-->%d】‘, [ExecNum, Num]));
  end;
  for I := 1 to Num do
  begin
    if (I shr 7 = 0) and Assigned(ExecutingCallback) then
      ExecutingCallback;

    Initialize;
    GenCommCards;
    GenPlayerCards;
    NormalizePlayerCards;
    StatHandCardTypes;
    AnalysePlayerCardTypes;
    ComparePlayerCardTypes;
  end;

  if Assigned(OutputCallback) then
    OutputStats(Num, OutputCallback);
end;

procedure TTexasPoker.GenCommCards;
var
  RdnCnt: Integer;
  RdnIdx: Integer;
begin
  RdnCnt := 0;
  repeat
    RdnIdx := Random(52) + 1;
    if FDeckCards[RdnIdx] = 0 then
    begin
      FDeckCards[RdnIdx] := 1;
      FCommCards[RdnCnt + 1] := RdnIdx;
      Inc(RdnCnt);
    end;
  until RdnCnt >= Length(FCommCards);
end;

procedure TTexasPoker.GenPlayerCards;
var
  RdnCnt: Integer;
  RdnIdx: Integer;
begin
  RdnCnt := 0;
  repeat
    RdnIdx := Random(52) + 1;
    if FDeckCards[RdnIdx] = 0 then
    begin
      FDeckCards[RdnIdx] := 1;
      FPlayerCards[RdnCnt + 1] := RdnIdx;
      Inc(RdnCnt);
    end;
  until RdnCnt >= Length(FPlayerCards);
end;

procedure TTexasPoker.Initialize;
begin
  ZeroMemory(@FDeckCards, Length(FDeckCards));
  ZeroMemory(@FCommCards, Length(FCommCards));
  ZeroMemory(@FPlayerCards, Length(FPlayerCards));
  ZeroMemory(@FHandCardProps, Length(FHandCardProps) * cCardPropLen);
  ZeroMemory(@FCowboyCardType, cPlayerCardTypeLen);
  ZeroMemory(@FBullCardType, cPlayerCardTypeLen);
  ZeroMemory(@FCowboyCards, Length(FCowboyCards) * Length(FCowboyCards[Low(TCardColor)]));
  ZeroMemory(@FBullCards, Length(FBullCards) * Length(FBullCards[Low(TCardColor)]));
end;

procedure TTexasPoker.NormalizePlayerCards;
var
  I: Integer;
  C: TCardColor;
  V: Byte;
begin
  for I := Low(FPlayerCards) to High(FPlayerCards) do
  begin
    C := CardColorFromIdx(FPlayerCards[I]);
    V := CardValueFromIdx(FPlayerCards[I]);
    FHandCardProps[I].Color := C;
    FHandCardProps[I].Value := V;
    if I mod 2 = 1 then
    begin
      FCowboyCards[C][V] := 1;
      if V = 1 then
        FCowboyCards[C][14] := 1;
    end else
    begin
      FBullCards[C][V] := 1;
      if V = 1 then
        FBullCards[C][14] := 1;
    end;
  end;
  
  for I := Low(FCommCards) to High(FCommCards) do
  begin
    C := CardColorFromIdx(FCommCards[I]);
    V := CardValueFromIdx(FCommCards[I]);
    FCowboyCards[C][V] := 1;
    FBullCards[C][V] := 1;
    if V = 1 then
    begin
      FCowboyCards[C][14] := 1;
      FBullCards[C][14] := 1;
    end;
  end;
end;

procedure TTexasPoker.OutputStats(const ExecNum: Integer;
  const OutputCallback: TOutputCallback);
const
  cStatStr   = ‘    %12s  %12s  %12s  %12s‘;
  cStatStrEx = ‘    %25s  %12s  %12s  %12s‘;
  cSumStr    = ‘    %12s  %12s  %12s‘;
var
  HandCardType: THandCardType;
  Rate: Single;
  Cnt, WinLoseCnt: Integer;
  WinCardType: TGameCardType;
begin
  OutputCallback(‘‘);
  
  OutputCallback(‘  任一人手牌统计信息如下：‘);
  OutputCallback(Format(cStatStr, [‘牌型‘, ‘次数‘, ‘比例‘, ‘赔率‘]));
  OutputCallback(‘        --------------------------------------------------‘);
  for HandCardType := Low(FHandCardTypes) to High(FHandCardTypes) do
  begin
    Rate := FHandCardTypes[HandCardType] / ExecNum;
    OutputCallback(Format(cStatStr, [cHandCardTypeDesc[HandCardType], IntToStr(FHandCardTypes[HandCardType]), Format(‘%.6f‘, [Rate * 100]) + ‘%‘, Format(‘%.6f‘, [1 / Rate])]));
  end;

  OutputCallback(‘‘);
  OutputCallback(‘  获胜牌型统计信息如下：‘);
  OutputCallback(Format(cStatStrEx, [‘牌型‘, ‘次数‘, ‘比例‘, ‘赔率‘]));
  OutputCallback(‘       ----------------------------------------------------------------‘);
  WinLoseCnt := ExecNum - FWinningTypes[wtTie];    
  Cnt := FWinCardTypes[gctHighCard] + FWinCardTypes[gctOnePair];
  OutputCallback(Format(cStatStrEx, [‘高牌/一对‘, IntToStr(Cnt), Format(‘%.6f‘, [(Cnt / WinLoseCnt) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (Cnt / WinLoseCnt)])]));
  Cnt := FWinCardTypes[gctTwoPair];
  OutputCallback(Format(cStatStrEx, [‘两对‘, IntToStr(Cnt), Format(‘%.6f‘, [(Cnt / WinLoseCnt) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (Cnt / WinLoseCnt)])]));
  Cnt := FWinCardTypes[gctFlush] + FWinCardTypes[gctStraight] + FWinCardTypes[gctThreeOfAKind];
  OutputCallback(Format(cStatStrEx, [‘三条/顺子/同花‘, IntToStr(Cnt), Format(‘%.6f‘, [(Cnt / WinLoseCnt) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (Cnt / WinLoseCnt)])]));
  Cnt := FWinCardTypes[gctFullHouse];
  OutputCallback(Format(cStatStrEx, [‘葫芦‘, IntToStr(Cnt), Format(‘%.6f‘, [(Cnt / WinLoseCnt) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (Cnt / WinLoseCnt)])]));
  Cnt := FWinCardTypes[gctFourOfAKind] + FWinCardTypes[gctStraightFlush] + FWinCardTypes[gctRoyalFlush];
  OutputCallback(Format(cStatStrEx, [‘金刚/同花顺/皇家同花顺‘, IntToStr(Cnt), Format(‘%.6f‘, [(Cnt / WinLoseCnt) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (Cnt / WinLoseCnt)])]));

  OutputCallback(‘‘);
  OutputCallback(‘  输赢统计信息如下：‘);
  OutputCallback(Format(cStatStr, [‘描述‘, ‘次数‘, ‘比例‘, ‘赔率‘]));
  OutputCallback(‘      ----------------------------------------------------‘);
  OutputCallback(Format(cStatStr, [‘牛仔获胜数‘, IntToStr(FWinningTypes[wtCowboy]), Format(‘%.6f‘, [(FWinningTypes[wtCowboy] / ExecNum) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (FWinningTypes[wtCowboy] / ExecNum)])])); 
  OutputCallback(Format(cStatStr, [‘公牛获胜数‘, IntToStr(FWinningTypes[wtBull]), Format(‘%.6f‘, [(FWinningTypes[wtBull] / ExecNum) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (FWinningTypes[wtBull] / ExecNum)])]));
  OutputCallback(Format(cStatStr, [‘平局数‘, IntToStr(FWinningTypes[wtTie]), Format(‘%.6f‘, [(FWinningTypes[wtTie] / ExecNum) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (FWinningTypes[wtTie] / ExecNum)])]));
  
  OutputCallback(‘‘);
  OutputCallback(‘  获胜明细牌型统计信息如下：‘);
  OutputCallback(Format(cStatStr, [‘牌型‘, ‘次数‘, ‘比例‘, ‘赔率‘]));
  OutputCallback(‘      ----------------------------------------------------‘);
  for WinCardType := Low(FWinCardTypes) to High(FWinCardTypes) do
  begin
    Rate := FWinCardTypes[WinCardType] / ExecNum;
    if Rate > 0 then
      OutputCallback(Format(cStatStr, [cGameCardTypeDesc[WinCardType], IntToStr(FWinCardTypes[WinCardType]), Format(‘%.6f‘, [Rate * 100]) + ‘%‘, Format(‘%.6f‘, [1 / Rate])]))
    else
      OutputCallback(Format(cStatStr, [cGameCardTypeDesc[WinCardType], IntToStr(FWinCardTypes[WinCardType]), Format(‘%.6f‘, [Rate * 100]) + ‘%‘, ‘0%‘]));
  end;
  
  OutputCallback(‘‘);
  OutputCallback(‘  牛仔所中牌型统计信息如下：‘);
  OutputCallback(Format(cSumStr, [‘牌型‘, ‘次数‘, ‘比例‘]));
  OutputCallback(‘      --------------------------------------‘);
  for WinCardType := Low(FCowboyCardTypes) to High(FCowboyCardTypes) do
    OutputCallback(Format(cSumStr, [cGameCardTypeDesc[WinCardType], IntToStr(FCowboyCardTypes[WinCardType]), Format(‘%.6f‘, [FCowboyCardTypes[WinCardType] / ExecNum * 100]) + ‘%‘]));

  OutputCallback(‘‘);
  OutputCallback(‘  公牛所中牌型统计信息如下：‘);
  OutputCallback(Format(cSumStr, [‘牌型‘, ‘次数‘, ‘比例‘]));
  OutputCallback(‘      --------------------------------------‘);
  for WinCardType := Low(FBullCardTypes) to High(FBullCardTypes) do
    OutputCallback(Format(cSumStr, [cGameCardTypeDesc[WinCardType], IntToStr(FBullCardTypes[WinCardType]), Format(‘%.6f‘, [FBullCardTypes[WinCardType] / ExecNum * 100]) + ‘%‘]));

  OutputCallback(‘‘);
end;

procedure TTexasPoker.Reset;
begin
  ZeroMemory(@FHandCardTypes, Length(FHandCardTypes) * 4);
  ZeroMemory(@FWinningTypes, Length(FWinningTypes) * 4);
  ZeroMemory(@FHandCardTypes, Length(FHandCardTypes) * 4);
  ZeroMemory(@FCowboyCardTypes, Length(FCowboyCardTypes) * 4);
  ZeroMemory(@FBullCardTypes, Length(FBullCardTypes) * 4);
end;

procedure TTexasPoker.StatHandCardTypes;
var
  BoMatched: Boolean;
begin
  BoMatched := False;
  
  if (FHandCardProps[1].Color = FHandCardProps[3].Color)
    or (FHandCardProps[2].Color = FHandCardProps[4].Color)
  then
  begin
    Inc(FHandCardTypes[hctFlush]);
    BoMatched := True;
  end;

  if (Abs(FHandCardProps[1].Value - FHandCardProps[3].Value) = 1)
    or (Abs(FHandCardProps[2].Value - FHandCardProps[4].Value) = 1)
    or (Abs(FHandCardProps[1].Value - FHandCardProps[3].Value) = 12)
    or (Abs(FHandCardProps[2].Value - FHandCardProps[4].Value) = 12)
  then
  begin
    Inc(FHandCardTypes[hctStraight]);
    BoMatched := True;
  end;

  if (FHandCardProps[1].Value = FHandCardProps[3].Value) or (FHandCardProps[2].Value = FHandCardProps[4].Value) then
  begin
    Inc(FHandCardTypes[hctOnePair]);
    if ((FHandCardProps[1].Value = FHandCardProps[3].Value) and (FHandCardProps[1].Value = 1))
      or ((FHandCardProps[2].Value = FHandCardProps[4].Value) and (FHandCardProps[2].Value = 1))
    then
      Inc(FHandCardTypes[hctPairA]);
    BoMatched := True;
  end;

  if ((FHandCardProps[1].Color = FHandCardProps[3].Color) and ((Abs(FHandCardProps[1].Value - FHandCardProps[3].Value) = 1) or (Abs(FHandCardProps[1].Value - FHandCardProps[3].Value) = 12)))
    or ((FHandCardProps[2].Color = FHandCardProps[4].Color) and ((Abs(FHandCardProps[2].Value - FHandCardProps[4].Value) = 1) or (Abs(FHandCardProps[2].Value - FHandCardProps[4].Value) = 12)))
  then
  begin
    Inc(FHandCardTypes[hctFlushStraight]);
    BoMatched := True;
  end;

  if not BoMatched then
    Inc(FHandCardTypes[hctNone]);
end;

end.