📄 pmain.pas
字号:
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 + -