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

📄 pmain.pas

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

interface

uses
  Windows, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, PGmProtect, PcardClass,
  StdCtrls;
type
  TTab = class //桌子类
  private
    FId: Cardinal; //自己的id号
    FmaxCount: Byte; //最大的玩家数量
    FGaming: boolean; //是否在游戏中
    FGamekind: SGameKind; //在玩啥游戏
    FTabName: string; //桌子名
    FPlayerArr: Tlist; //玩家的列表
    FSendBuffPlayerArr: array of RPlayer; //数组
    function GetPlayerCount: Byte;
    function GetSendBuffEntry: Pointer; //获取tab用户的进入点
    procedure GiveTabPlayerList(AThread: TIdPeerThread; IEntryPointer: Pointer; Isize: Integer); overload; //给指定用户发送列表
    procedure GiveTabPlayerList(IEntryPointer: Pointer; Isize: Integer); overload; //给所有用户发送
    procedure PlayerChange(IKind: sPlayerChange; IIdx: Byte; Iplayer: Prplayer; Istate: boolean = True); //用户进出
    procedure JoinTabRESP(Athread: TIdPeerThread; IPlayerIdx: byte);
  public
    property MaxCount: byte read FmaxCount write FmaxCount;
    property gameing: boolean read FGaming;
    property TabName: string read FTabName write FTabName;
    property id: Cardinal read Fid write Fid;
    property GameKind: SGameKind read FGamekind;
    property PlayerCount: Byte read GetPlayerCount;
    function InPlayer(IPplayer: PRPlayer): Byte; //加入玩家
    procedure LeavePlayer(Iindex: byte; IsOut: boolean = false); //离开玩家
    function GetPlayer(Iindex: Byte): PRplayer; //获取玩家指针
    procedure ReadyGame(IplayerIdx: Byte; IReadState: Boolean); //玩家准备或者取消准备游戏
    function IsallReady: boolean; //判断是否所有玩家准备就绪
    procedure BeginGame; //开始这张桌子的游戏
    procedure GiveBeginPlayerIdx(Iidx: byte); //随机给开始玩家索引标志着开始游戏
    procedure PlayerCards(IBuff: RSTC_PlayerSendCards); //玩家出牌
    procedure PlayerPass(Ibuff: RSTC_PlayerPass); //玩家跳过
    procedure PlayerChat(Ibuff: RCTS_Chat); //玩家聊天
    procedure PlayerWin(Ibuff:RCTS_UseWin);//玩家赢钱
    constructor Create(ItabName: string; IGmKind: SGameKind; IId: Cardinal; ImaxPlayer: Byte = 4);
    destructor Destory;
  end;
  TGameTabMana = class //游戏局管理类
  private
    FGobleTabID: Cardinal; //游戏桌子的ID号
  public
    FCurrTabCount: Cardinal; //现有的桌子数量
    FGameTabArr: TList; //桌子列表
    property CurrTabCount: Cardinal read FCurrTabCount; //现有的桌子数量
    function GetaTabID: Cardinal; //申请一个tabiD
    function NewTab(ITabName: string; ISGkind: SGameKind): Cardinal; //创建一张桌子
    procedure FreeTab(Iindex: Cardinal); //释放桌子
    function GetTab(IId: Cardinal): TTab; //获取桌子
    constructor Create;
    destructor Destory;
  end;
type
  TFMain = class(TForm)
    GameServer: TIdTCPServer;
    Memo1: TMemo;
    procedure GameServerConnect(AThread: TIdPeerThread);
    procedure GameServerExecute(AThread: TIdPeerThread);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure GameServerListenException(AThread: TIdListenerThread;
      AException: Exception);
    procedure GameServerDisconnect(AThread: TIdPeerThread);
    procedure GameServerException(AThread: TIdPeerThread;
      AException: Exception);
  private
    GBuffHead: RHead;
    GBuffLogin: RCTS_login;
    Lbuff: array of RWaiteTab; //传输tab的buff
    LBuffCount: Cardinal; // 传输tab的记数
    FOnlinesUserCount:Integer;//在线用户数量
    Property OnlinesUserCount:Integer Read FOnlinesUserCount Write FOnlinesUserCount;
    function CanLoginIn(ILogin: RCTS_login): Boolean; //判断是否允许客户端登陆‘
    procedure CreateTab(athread: TIdPeerThread);
    procedure JoinTab(Athread: TIdPeerThread);
    procedure ReadyGame(Athread: TIdPeerThread);
    procedure LeaveTab(athread: TIdPeerThread);
    procedure DisConn(Athread: TIdPeerThread);
    procedure PlayerSendCard(Athread: TIdPeerThread);
    procedure PlayerPass(Athread: TIdPeerThread);
    procedure PlayerChat(Athread: TIdPeerThread);
    Procedure GetOnlineUsersCount(Athread:TIdPeerThread);
    procedure PlayerWinMoney(Athread:TIdPeerThread);//用户赢钱了
  public
    AppState: string;
    GameManage: TGameTabMana;
    WaitePlayerLIst: TList; //等待玩家的列表
    procedure AddShow(IStr: string);
    procedure SendHead(AThread: TIdPeerThread; Iheadcmid: Smallint);
    procedure GiveCards(aThread: TIdPeerThread; TENtryPointer: Pointer; IRandomsArrSize: Integer; ICount: Byte); //给用户牌局
    function GetWaiteTabArrEntry(var ICount: Cardinal): Pointer; //获取等待的桌子列表的进入点
    procedure GiveUserTabList(athread: TIdPeerThread; TENtryPointer: Pointer; ISize: Integer); //产生传输buff
    procedure TabChanged(athread: TIdPeerThread; Ikind: sTabChange; Iparam: Cardinal; IWaiteTab: PRWaiteTab); overload; //给一用户桌子列表发生改变
    procedure TabChanged(Ikind: sTabChange; Iparam: Cardinal; IWaiteTab: PRWaiteTab); overload; //给所有闲逛用户桌子列表发生改变
  end;

var
  FMain: TFMain;

implementation

uses Math;

{$R *.dfm}

{ TGameTabMana }

constructor TGameTabMana.Create;
begin
  FGameTabArr := TList.Create;
end;

destructor TGameTabMana.Destory;
var
  I: Integer;
begin
  for I := 0 to FGameTabArr.Count - 1 do begin // Iterate
    TTab(FGameTabArr.Items[i]).Free;
  end; // for
  FGameTabArr.Free;
end;

procedure TGameTabMana.FreeTab(Iindex: Cardinal);
var
  Ltep: TTab;
begin
  Dec(FCurrTabCount);
  Ltep := GetTab(Iindex);
  FMain.TabChanged(TabFree, Ltep.id, nil);
  FGameTabArr.Delete(FGameTabArr.IndexOf(Ltep));
end;

function TGameTabMana.GetaTabID: Cardinal;
begin
  inc(FGobleTabID);
  Result := FGobleTabID;
end;

function TGameTabMana.GetTab(IId: Cardinal): TTab;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FGameTabArr.Count - 1 do begin // Iterate
    if TTab(FGameTabArr[i]).id = IId then begin
      Result := TTab(FGameTabArr[i]);
      Break;
    end;
  end; // for
end;

function TGameTabMana.NewTab(ITabName: string; ISGkind: SGameKind): Cardinal;
var
  LTab: TTab;
  LTep: PRWaiteTab;
begin
  inc(FCurrTabCount);
  LTab := TTab.Create(ITabName, ISGkind, GetaTabID);
  FGameTabArr.Add(LTab);
  Result := LTab.id;
  new(LTep); //给所有闲逛的用户发送新桌子
  LTep.TabID := LTab.id;
  LTep.TabKind := LTab.GameKind;
  LTep.TabName := LTab.TabName;
  LTep.TabPlayerCount := 0;
  FMain.TabChanged(TabAdd, LTep.tabid, LTep);
  Dispose(LTep);
end;

{ TTab }

procedure TTab.BeginGame;
var
  I, x: Integer;
  Test: array of byte;
begin
  FGaming := True; //将桌子改为游戏中
  Randomize;
  SetLength(Test, 52);
  for I := 0 to 51 do begin // Iterate
    repeat
      x := Random(51);
    until Test[x] = 0;
    Test[X] := i;
  end; // for
  for I := 0 to FPlayerArr.Count - 1 do begin // Iterate
    PRplayer(FPlayerArr[i]).TotMoney:=PRplayer(FPlayerArr[i]).TotMoney-2;
    FMain.GiveCards(PRplayer(FPlayerArr.Items[i]).Contenting,
      @test[0], 52 * Sizeof(byte), 52);
  end; // for
  GiveBeginPlayerIdx(Random(MaxCount-1) + 1);
end;

constructor TTab.Create(ItabName: string; Igmkind: SGameKind; Iid: Cardinal; ImaxPlayer: Byte);
begin
  MaxCount := ImaxPlayer;
  FGaming := False;
  FTabName := ItabName;
  FGamekind := IGmKind;
  FId := IId;
  FPlayerArr := TList.Create;
end;

destructor TTab.Destory;
begin
  FPlayerArr.Free;
end;

function TTab.GetPlayer(Iindex: Byte): PRplayer;
begin
  Result := PRplayer(FPlayerArr.Items[Iindex]);
end;

function TTab.GetSendBuffEntry: Pointer;
var
  I: Integer;
begin
  SetLength(FSendBuffPlayerArr, PlayerCount);
  for I := 0 to FPlayerArr.Count - 1 do begin // Iterate
    FSendBuffPlayerArr[i] := PRplayer(FPlayerArr.Items[i])^;
  end; // for
  Result := Pointer(FSendBuffPlayerArr);
end;

procedure TTab.GiveTabPlayerList(AThread: TIdPeerThread;
  IEntryPointer: Pointer; Isize: Integer);
var
  LBuff: RSTC_GiveTabPlayerList;
begin
  FMain.SendHead(AThread, Cmid_STC_GiveTabPlayerList);
  LBuff.size := Isize;
  LBuff.Count := PlayerCount;
  AThread.Connection.WriteBuffer(Lbuff, Sizeof(LBuff));
  AThread.Connection.WriteBuffer(IEntryPointer^, LBuff.size);
end;

procedure TTab.GiveTabPlayerList(IEntryPointer: Pointer; Isize: Integer);
var
  I: Integer;
  Lbuff: RSTC_GiveTabPlayerList;
begin
  for I := 0 to PlayerCount - 1 do begin // Iterate
    Lbuff.size := Isize;
    Lbuff.Count := PlayerCount;
    PRPlayer(FPlayerArr.Items[i]).Contenting.Connection.WriteBuffer(Lbuff, sizeof(Lbuff));
    PRPlayer(FPlayerArr.Items[i]).Contenting.Connection.WriteBuffer(IEntryPointer^, Lbuff.size);
  end; // for
end;

function TTab.InPlayer(IPplayer: PRPlayer): byte;
begin
  GiveTabPlayerList(IPplayer.Contenting, GetSendBuffEntry, sizeof(Rplayer) * PlayerCount); //给玩家返回此tab里的玩家列表
  FMain.WaitePlayerLIst.Delete(FMain.WaitePlayerLIst.IndexOf(IPplayer)); //从闲逛玩家列表中移出
  IPplayer.ReadGame := False; //初始化进入时玩家准备游戏的状态
  IPplayer.Index := id;
  Result := FPlayerArr.Add(IPplayer);
  IPplayer.ID := Result;
  PlayerChange(PlayerIn, 0, IPplayer); //通知之前的其它玩家
  JoinTabRESP(IPplayer.Contenting, Result);
  FMain.TabChanged(TabAddPlayer, id, nil);
end;

function TTab.IsallReady: boolean;
var
  I: Integer;
begin
  Result := True;
  if PlayerCount < MaxCount then begin
    Result := False;
    Exit;
  end;
  for I := 0 to PlayerCount - 1 do begin // Iterate
    if not PRplayer(FPlayerArr.Items[i]).ReadGame then begin
      Result := False;
      break;
    end;
  end; // for
end;

procedure TTab.LeavePlayer(Iindex: byte; IsOut: boolean = false);
var
  I: Integer;
  LBuff: RSTC_ReSetPalyerIDX;
begin
  FMain.TabChanged(TabDeletePlayer, id, nil);
  if not IsOut then
    FMain.WaitePlayerLIst.Add(FPlayerArr.Items[iindex]); //将玩家加入等待列表
  PRplayer(FPlayerArr.Items[Iindex]).ReadGame := False; //初始化玩同意开始游戏的状态
  FPlayerArr.Delete(Iindex);
  PlayerChange(PlayerOut, Iindex, nil);
  for I := 0 to FPlayerArr.Count - 1 do begin // Iterate
    FMain.SendHead(PRplayer(FPlayerArr.Items[i]).Contenting,CMID_STC_ReSetPlayerIDX);
    LBuff.NewIdx := i;
    PRplayer(FPlayerArr.Items[i]).ID := i;
    PRplayer(FPlayerArr.Items[i]).Contenting.Connection.WriteBuffer(lbuff, sizeof(LBuff));
  end; // for
  If FPlayerArr.Count=0 Then  Self.Free;    
end;

procedure TTab.PlayerChange(IKind: sPlayerChange; IIdx: Byte;
  Iplayer: Prplayer; Istate: boolean = True);
var
  I: Integer;
  Lbuff: RSTC_PlayerIO;
begin
  for I := 0 to PlayerCount - 1 do begin // Iterate
    FMain.SendHead(PRplayer(FPlayerArr.Items[i]).Contenting, Cmid_STC_PlayerIO);
    Lbuff.Kind := IKind;
    Lbuff.Idx := IIdx;
    if Iplayer <> nil then
      Lbuff.Player := Iplayer^;
    Lbuff.State := Istate;
    PRplayer(FPlayerArr.Items[i]).Contenting.Connection.WriteBuffer(Lbuff, sizeof(Lbuff));
  end; // for
end;

procedure TTab.JoinTabRESP(Athread: TIdPeerThread; IPlayerIdx: byte);
var
  LResp: RCTS_JoinTab_RESP;
begin
  LResp.TabId := id;
  LResp.PlayerINDEX := IPlayerIdx;
  FMain.SendHead(Athread, CMid_CTS_JoinTab);
  Athread.Connection.WriteBuffer(lRESP, Sizeof(LResp));
end;


procedure TTab.ReadyGame(IplayerIdx: Byte; IReadState: Boolean);
var
  LtepState: sPlayerChange;
begin
  PRplayer(FPlayerArr.Items[IplayerIdx]).ReadGame := IReadState;
  if IReadState then LtepState := PlayerReady else LtepState := PlayernotReady;
  PlayerChange(LtepState, IplayerIdx, nil);
  if IReadState then //如果都准备好了那就开始游戏
    if IsallReady then
      BeginGame;
end;

function TTab.GetPlayerCount: Byte;
begin
  Result := FPlayerArr.Count;
end;

procedure TTab.GiveBeginPlayerIdx(Iidx: byte);
var
  I: Integer;

⌨️ 快捷键说明

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