pmain.pas

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

unit Pmain;

interface

uses
  Windows, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, PGmProtect, StdCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, xdarray, PRenameCard, PcardClass, RzLabel, Mask,
  RzEdit, RzCmboBx, ComCtrls, RzListVw, RzButton, RzBckgnd, ImgList,
  RzStatus, RzSplit, ExtCtrls, RzPanel;
type
  TReciveThread = class(TThread)
  private
    Ghead: RHead;
    procedure SHowGameForm; //显示gameform
    procedure ShowMainForm; //显示MainForm
    procedure SynShowNext; //画下一个玩家
    procedure SynSendCard; //出牌
    procedure SynAddMemo; // 添加到显示框
    procedure SynDrawPlayerList; //画出用户列表框
    procedure SynDrawTabList; //画出用户列表框
    procedure BeginGame; //让主线程开始游戏
    procedure DoExecute(ICon: TIdTCPClient);
    procedure RevDisconn;
    procedure RevCreateTab(ICon: TIdTCPClient);
    procedure RevJoinTab(ICon: TIdTCPClient);
    procedure RevLeaveTab(ICon: TIdTCPClient);
    procedure RevTabChanged(ICon: TIdTCPClient);
    procedure RevPlayerChange(Icon: TIdTCPClient);
    procedure RevResetPlayerIdx(ICon: TIdTCPClient);
    procedure RevGiveCards(Icon: TIdTCPClient);
    procedure RevGetBeginPlayerIdx(Icon: TIdTCPClient);
    procedure RevPlayerSendCards(Icon: TIdTCPClient);
    procedure RevPlayerPass(Icon: TIdTCPClient);
    procedure RevPlayerChat(Icon: TIdTCPClient);
    procedure RevOnlinesUsers(Icon: TIdTCPClient);
  public
    LGbuff: RSTC_GiveBeginPlayerIdx;
    LGSendCard: RSTC_PlayerSendCards;
    LGbuffChat: RCTS_Chat;
    LGbuffPlayerIO: RSTC_PlayerIO;
    procedure Execute; override;
  end;
  TFmain = class(TForm)
    GameClient: TIdTCPClient;
    RzBackground1: TRzBackground;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    GameTabList: TRzListView;
    EgameKind: TRzComboBox;
    EgameMaxplayerCount: TRzComboBox;
    RzButton2: TRzButton;
    EtabName: TRzEdit;
    RzLabel1: TRzLabel;
    RzLabel2: TRzLabel;
    RzLabel3: TRzLabel;
    ImageList1: TImageList;
    RzSizePanel1: TRzSizePanel;
    RzButton1: TRzButton;
    RzSizePanel2: TRzSizePanel;
    RzStatusBar1: TRzStatusBar;
    RzClockStatus1: TRzClockStatus;
    RzStatusPane1: TRzStatusPane;
    RzFieldStatus1: TRzFieldStatus;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure RzButton2Click(Sender: TObject);
    procedure GameTabListSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure RzButton1Click(Sender: TObject);
    procedure GameTabListDblClick(Sender: TObject);
  private
    Ghead: RHead; //包头缓冲
    GWaiteTabArr: array of RWaiteTab; //等待桌子的数组
    GWaiteTabArrCount: Cardinal; //等待桌子的数组记数
    FTabID: Cardinal;
    FPlayerIdxIntab: Byte;
    FReadying: boolean;
    FIntabing: boolean;
    Fgaming: Boolean;
    procedure DisConn(ICon: TIdTCPClient);
    procedure PlantTabList; //更新桌子显示
    procedure RevTabPlayerList(Icon: TIdTCPClient);
    function CreateTab(ICon: TIdTCPClient; ItabName: string; IGameKind: SGameKind): boolean; //创建桌子
    function JionTab(Icon: TIdTCPClient; ITabId: Cardinal): boolean; //加入桌子
  public
    Appstate: string;
    GReciveThread: TReciveThread;
    GTabPlayerArr: array of Rplayer; //tab内玩家数组
    GTabPlayerArrCount: Byte; //tab内玩家数组记数
    property Tabing: boolean read FIntabing write FIntabing default False;
    property Readying: boolean read FReadying write FReadying default False;
    property Gaming: boolean read Fgaming write Fgaming default False;
    property TabID: Cardinal read FTabID write FTabID;
    property PlayerIdxIntab: Byte read FPlayerIdxIntab write FPlayerIdxIntab;
    procedure AddShow(Istr: string);
    procedure SendHead(ICon: TIdTCPClient; IheadCmid: Smallint); //发命令
    function LoginIn(ICon: TIdTCPClient; Iacc, Ipsd: string): boolean; //登陆
    procedure ReciveWaiteList(ICon: TIdTCPClient); //获取桌子列表
    function GetWaiteTab(ItabID: Cardinal): Cardinal;
    procedure GetTabList(Icon: TIdTCPClient); //获取空闲桌子列表
    function ReadyGame(Icon: TIdTCPClient; IReadyState: boolean): boolean; //准备好游戏了
    procedure LeaveTab(Icon: TIdTCPClient); //离开桌子
    { Public declarations }
  end;

var
  Fmain: TFmain;

implementation

uses Pgame, DateUtils, Plogin;

{$R *.dfm}

{ TFmain }

function TFmain.LoginIn(ICon: TIdTCPClient; Iacc, Ipsd: string): boolean;
var
  LBuff: RCTS_login;
begin
  Result := True;
  try
    SendHead(ICon, Cmid_CTS_Login);
    LBuff.Acc := Iacc;
    LBuff.psd := Ipsd;
    ICon.WriteBuffer(Lbuff, Sizeof(Lbuff));
    ICon.ReadBuffer(Ghead,Sizeof(Ghead));
  except
    Result := False;
  end;
end;

procedure TFmain.ReciveWaiteList(ICon: TIdTCPClient);
var
  Ibuff: RSTC_GiveWaiteTabList;
begin
  ICon.ReadBuffer(Ibuff, Sizeof(Ibuff));
  GWaiteTabArrCount := Ibuff.ListSize div Sizeof(RWaiteTab);
  if GWaiteTabArrCount > 0 then begin
    SetLength(GWaiteTabArr, GWaiteTabArrCount);
    ICon.ReadBuffer(Pointer(GWaiteTabArr)^, Ibuff.ListSize);
    PlantTabList;
  end;
end;

procedure TFmain.SendHead(ICon: TIdTCPClient; IheadCmid: Smallint);
begin
  Ghead.Cmid := IheadCmid;
  ICon.WriteBuffer(Ghead, sizeof(Ghead));
end;

function TFmain.CreateTab(ICon: TIdTCPClient; ItabName: string;
  IGameKind: SGameKind): boolean;
var
  Lbuff: RCTS_CreateTab;
begin
  Result := True;
  SendHead(ICon, CMID_CTS_CreateTab);
  Lbuff.TabName := ItabName;
  Lbuff.TabKind := IGameKind;
  ICon.WriteBuffer(Lbuff, Sizeof(Lbuff));
end;

function TFmain.JionTab(Icon: TIdTCPClient; ITabId: Cardinal): boolean;
var
  Ibuff: RCTS_JoinTab;
begin
  Result := True;
  SendHead(Icon, CMid_CTS_JoinTab);
  Ibuff.TabID := ITabId;
  Icon.WriteBuffer(Ibuff, Sizeof(Ibuff));
end;

procedure TFmain.LeaveTab(Icon: TIdTCPClient);
var
  Lbuff: RCTS_LeaveTab;
begin
  SendHead(Icon, CMID_CTS_LeaveTab);
  Lbuff.TabID := TabID;
  Lbuff.PlayerID := PlayerIdxIntab;
  Icon.WriteBuffer(Lbuff, Sizeof(Lbuff));
  Tabing := False;
end;

procedure TFmain.GetTabList(Icon: TIdTCPClient);
begin
  SendHead(Icon, Cmid_STC_GiveWaiteTabList);
end;

procedure TFmain.PlantTabLIst;
var
  I: Integer;
  Ltep: TListItem;
begin
  GameTabList.Clear;
  for I := 0 to GWaiteTabArrCount - 1 do begin // Iterate
    if GWaiteTabArr[i].TabName <> '' then begin
      Ltep := GameTabList.Items.Add;
      Ltep.Caption := GwaiteTabarr[i].TabName;
      Ltep.ImageIndex := 0;
    end;
  end; // for
end;

function TFmain.ReadyGame(Icon: TIdTCPClient;
  IReadyState: boolean): boolean;
var
  Ibuff: RCTS_ReadyGame;
begin
  Result := True;
  SendHead(Icon, Cmid_CTS_ReadyGame);
  Ibuff.TabID := TabID;
  Ibuff.PlayerINDEX := PlayerIdxIntab;
  Ibuff.STate := IReadyState;
  Icon.WriteBuffer(Ibuff, Sizeof(Ibuff));
end;

procedure TFmain.RevTabPlayerList(Icon: TIdTCPClient);
var
  Lbuff: RSTC_GiveTabPlayerList;
begin
  Icon.ReadBuffer(Lbuff, sizeof(Lbuff));
  GTabPlayerArrCount := Lbuff.Count;
  SetLength(GTabPlayerArr, GTabPlayerArrCount);
  Icon.ReadBuffer(Pointer(GTabPlayerArr)^, Lbuff.size);
end;


procedure TFmain.AddShow(Istr: string);
begin

end;

function TFmain.GetWaiteTab(ItabID: Cardinal): Cardinal;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Length(GWaiteTabArr) - 1 do begin // Iterate
    if GWaiteTabArr[i].TabID = ItabID then begin
      Result := i;
      break;
    end;
  end; // for
end;

procedure TFmain.DisConn(ICon: TIdTCPClient);
begin
  try
    SendHead(ICon, CMid_CTS_DisConn);
  except
  end;
end;

{ TReciveThread }

procedure TReciveThread.BeginGame;
begin
  Fgame.GameBeging(LGbuff.Index);
end;

procedure TReciveThread.DoExecute(Icon: TIdTCPClient);
begin
  if Fmain.Appstate <> CappstateNormal then Exit;
  ICon.ReadBuffer(Ghead, sizeof(GHead));
  case Ghead.Cmid of //
    CMid_CTS_JoinTab: RevJoinTab(ICon); //加入tab返回的
    CMID_CTS_CreateTab: RevCreateTab(ICon); //创建tab返回的
    CMID_CTS_LeaveTab: RevLeaveTab(ICon);
    Cmid_STC_TabChange: RevTabChanged(ICon); //桌子状态变更
    Cmid_STC_PlayerIO: RevPlayerChange(ICon); //tab内玩家变更
    Cmid_STC_GiveWaiteTabList: Fmain.ReciveWaiteList(Icon); //接受桌子列表
    CMID_STC_ReSetPlayerIDX: RevResetPlayerIdx(ICon); //重设玩家在桌子内的的索引