pcardclass.pas

商业性对战平台,功能强大,能进行多方对战!!有部分是用汇编写的.

end;

function TPlayer.InCard(Icard: PROneCard): PROneCard; //摸牌
begin
  FCardArr.Add(Icard);
  Result := Icard;
end;

function TPlayer.OutCard(Iindex: Integer): PROneCard; //打牌
begin
  Result := Cards.Items[Iindex];
  Cards.Delete(Iindex);
end;

{ TTSPCard }

function composit(Ilist: TList): TList; //牌排序
var
  Lnum, Lnt: Integer;
  Lmin: Integer;
begin
  Result := TList.Create;
  Lnum := 0;
  Lmin := PRoneCard(Ilist.Items[0]).Value; //
  Result.Add(Ilist.Items[0]);
  while Lnum < Ilist.Count - 1 do begin
    inc(Lnum);
    if PRoneCard(Ilist.Items[Lnum]).Value = 1 then
      PRoneCard(Ilist.Items[Lnum]).Value := 14;
    if PRoneCard(Ilist.Items[Lnum]).Value <= Lmin then begin
      Lmin := pRoneCard(Ilist.Items[Lnum]).Value;
      Result.Insert(0, Ilist.Items[Lnum]);
    end
    else begin
      Lnt := 0;
      repeat
        if pRoneCard(Ilist.Items[Lnum]).Value >
          PRoneCard(Result.Items[Lnt]).Value then
          Inc(Lnt)
        else Break;
      until Lnt = Result.Count;
      Result.Insert(Lnt, Ilist.Items[Lnum]);
    end;
  end;
  Ilist.Free;
end;

function SameCardCount(Ivalue: Byte; Icards: TList): Byte; //返回同样值的数量
var
  I: Integer;
begin
  result := 0;
  for I := 0 to Icards.Count - 1 do begin // Iterate
    if Ivalue = Pronecard(Icards.Items[i]).Value then inc(Result);
  end; // for
end;

function SameCardMaxCount(icards: TList): Byte; //返回同样牌最多的数
var
  i: Integer;
  Ltep: Byte;
  Lthen: Byte;
begin
  Ltep := Pronecard(icards.Items[0]).Value;
  Result := SameCardCount(Ltep, icards);
  for i := 1 to icards.Count - 1 do begin
    if Ltep = Pronecard(icards.Items[i]).Value then Continue //如果是同样的牌就跳过
    else begin
      Ltep := Pronecard(icards.Items[i]).Value; //取得不同值
        Lthen := SameCardCount(Ltep, icards); //获取牌数
      if Lthen > Result then Result := Lthen; //返回最多的
    end;
  end;
end;

function IsSameColor(Icards: TList): Boolean; //返回是否是同花
var
  I: Integer;
  Ltep: SKind;
begin
  result := True;
  Ltep := Pronecard(Icards.Items[0]).Kind;
  for I := 1 to Icards.Count - 1 do // Iterate
    if Ltep <> Pronecard(Icards.Items[i]).Kind then begin
      Result := False;
      Break;
    end;
end;

function IsSun(Icards: TList): Boolean; //是否是顺子
var
  I: Integer;
  Ltep: Byte;
begin
  result := True;
  Ltep := Pronecard(Icards.Items[0]).Value;
  for I := 1 to Icards.Count - 1 do // Iterate
    if Ltep + 1 <> Pronecard(Icards.Items[i]).Value then begin
      Result := False;
      Break;
    end;
end;

function GetMaxvalue(Icard: Tlist): Byte; //获取最大值
begin
  Result := Pronecard(Icard.Items[Icard.Count-1]).Value; //因为已经排过续了所以最后一张牌最大
end;

function GetMaxColor(Ivalue:byte;Icard: Tlist): SKind;
var
  I: Integer;
begin
  result := Pronecard(Icard.Items[0]).Kind;
  for I := 0 to Icard.Count - 1 do begin // Iterate
    If Ivalue=Pronecard(Icard.Items[i]).Value Then
    if ord(Pronecard(Icard.Items[i]).Kind) > ord(Result) then
      Result := Pronecard(Icard.Items[i]).Kind;
  end; // for
end;

Function GetMinCount(Icard:TList):Byte;//获取最小的牌数
Var
  I: Integer;
  n:byte;
Begin
  n :=SameCardCount(Pronecard(Icard.Items[0]).Value,Icard);
  For I := 1 To Icard.Count - 1 Do Begin    // Iterate
    If n<SameCardCount(Pronecard(Icard.Items[i]).Value,Icard) Then
     n:=SameCardCount(Pronecard(Icard.Items[i]).Value,Icard);
  End;    // for
  Result:=n;
End;

function TTSPCard.CaseScKind(Icards: TList): SWinCardKind;
begin
  if IsSameColor(Icards) then begin
    if IsSun(Icards) then
      Result := SWCKsameCLSun
    else Result := SWCKsamecolor;
  end
  else if SameCardMaxCount(Icards) = 4 then Result := SWCKfourandone
  else if (SameCardMaxCount(Icards) = 3) then begin
    if GetMinCount(Icards) = 2 then Result := SWCKTreeandTwo
    else Result := SWCKTree
  end
  else if SameCardMaxCount(Icards) = 2 then begin
    if GetMinCount(Icards) = 2 then
      Result := SWCKtwodui
    else Result := SWCKdui
  end
  else Result := SWCKsan;
end;

function TTSPCard.CheckGameWined: Byte;
Var
  I,x,n: Integer;
  Ltep,Lnext:SWinCardKind;
  LmaxOne,LmaxTwo:Byte;
begin
  X:=0;
  For I := 0 To length(PlayerArr) - 1 Do Begin    // Iterate
    If PlayerArr[i].PlayerInfo^.PassCurrGame Then Continue
    Else x:=i;
  End;    // for
  Result:=x;
  n:=x;
  PlayerArr[X].FCardArr:=composit(PlayerArr[X].FCardArr);
  Ltep:=CaseScKind(PlayerArr[X].FCardArr);
  For I := n+1 To length(PlayerArr) - 1 Do Begin    // Iterate
    PlayerArr[i].FCardArr:=composit(PlayerArr[i].FCardArr);
    Lnext:=CaseScKind(PlayerArr[i].FCardArr);
    If Ltep=Lnext Then Begin //如果是同样的牌
      LmaxOne:=GetMaxvalue(PlayerArr[i].FCardArr);
      LmaxTwo:=GetMaxvalue(PlayerArr[X].FCardArr);
      if LmaxOne>LmaxTwo then begin
         Result:=i;
         x:=i;
      end
      Else Begin
        If LmaxOne=LmaxTwo Then Begin
          If Ord(GetMaxColor(LmaxOne,PlayerArr[i].FCardArr))>ord(GetMaxColor(LmaxTwo,PlayerArr[X].FCardArr)) Then
           Result:=i;
           x:=i;
        End;
      End;
    End;
  End;    // for
end;

function TTSPCard.CheckOutWined: Byte;
var
  I, N: Integer;
  Cur: Byte;
begin
  Result := 250;
  Cur:=0;
  n := 0;
  for I := 0 to High(PlayerArr) do begin // Iterate
    if PlayerArr[i].PlayerInfo^.PassCurrGame then inc(n)
    else Cur := i;
  end; // for
  if n = 3 then Result := Cur;
end;


constructor TTSPCard.Create(IPlayerCount: Byte; Iarr: array of PRplayer);
var
  I: Integer;
begin
  inherited Create;
  SetLength(PlayerArr, IPlayerCount);
  for I := 0 to IPlayerCount - 1 do begin // Iterate
    PlayerArr[i] := TPlayer.Create(Iarr[i]);
  end; // for

end;

destructor TTSPCard.Destory;
var
  I: Integer;
begin
  for I := 0 to Length(PlayerArr) - 1 do begin // Iterate
    PlayerArr[i].Free;
  end; // for
end;

function TTSPCard.NeedCheckWin: boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to High(PlayerArr) do begin // Iterate
    if PlayerArr[i].PlayerInfo^.PassCurrGame then Continue;
    if PlayerArr[i].CurrCardCount <> 5 then begin
      Result := False;
      Break;
    end;
  end; // for
end;

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

function TTSPCard.RandomBeginPlayer(IplayerCount: Byte): Byte;
begin
  FCurrPlayerIndex := IplayerCount;
  Result := FCurrPlayerIndex;
end;

procedure TTSPCard.SetPlayerPostion(IcurrIdx: Byte);
var
  I, n, x: Integer;
begin
  for I := 0 to Length(PlayerArr) - 1 do begin // Iterate //获取起始玩家索引
    if PlayerArr[i].PlayerInfo.ID = IcurrIdx then
      break;
  end; // for
  x := i;
  n := 0;
  repeat
    PlayerArr[x].Postion := sPlayerPostion(n); //设置位置
    inc(n); //增加位置引用
    inc(x); //下一索引
    if X > high(Playerarr) then X := 0; //如果索引超过限制就从头
  until n > 3; //如果设置完位置就推出
end;

end.