pgame.pas

网络对站平台

unit Pgame;

interface

uses
  SysUtils, messages, Windows, Variants, Classes, Graphics, Controls, Forms,
  ExtCtrls, StdCtrls, ComCtrls, RzPrgres, RzPanel, RzCmboBx, Dialogs,
  RzButton, RzLabel, RzEdit, RzListVw, Animate, GIFCtrl,
  PcardClass, PRenameCard, PGmProtect, IdTCPConnection, IdTCPClient,
  ImgList;
type
  TReNameCard = class(TCard);
  TFgame = class(TForm)
    Bevel1: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    Bevel5: TBevel;
    Bevel6: TBevel;
    Bevel7: TBevel;
    Bevel8: TBevel;
    Bevel9: TBevel;
    Bevel10: TBevel;
    Bevel11: TBevel;
    Bevel12: TBevel;
    Bevel13: TBevel;
    Bevel14: TBevel;
    Bevel15: TBevel;
    Bevel16: TBevel;
    Bevel17: TBevel;
    Bevel18: TBevel;
    Bevel19: TBevel;
    Bevel20: TBevel;
    Bevel2: TBevel;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    RzComboBox1: TRzComboBox;
    BTsendCard: TRzBitBtn;
    BtPass: TRzBitBtn;
    ChoseMoney: TRzComboBox;
    Bevel21: TBevel;
    Bevel22: TBevel;
    Bevel23: TBevel;
    Bevel24: TBevel;
    RzGroupBox1: TRzGroupBox;
    lbCurrPlayer: TRzLabel;
    RxGifTip: TRxGIFAnimator;
    RzBitBtn6: TRzBitBtn;
    RzBitBtn7: TRzBitBtn;
    TurnTimer: TTimer;
    Lbup: TRzLabel;
    LbDown: TRzLabel;
    LbLeft: TRzLabel;
    LbRight: TRzLabel;
    RzBitBtn4: TRzBitBtn;
    Rzlistplayer: TRzListView;
    Showmemo: TRzRichEdit;
    RzProgressBar1: TRzProgressBar;
    RzLabel1: TRzLabel;
    GroupTabuserList: TRzGroupBox;
    GroupShow: TRzGroupBox;
    Imgup: TImage;
    ImgRight: TImage;
    ImgDown: TImage;
    imgLeft: TImage;
    ImageList1: TImageList;
    Image1: TImage;
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure RzBitBtn3Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure RzComboBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RzBitBtn7Click(Sender: TObject);
    procedure RzBitBtn6Click(Sender: TObject);
    procedure TurnTimerTimer(Sender: TObject);
    procedure BtPassClick(Sender: TObject);
    procedure ChoseMoneyChange(Sender: TObject);
    procedure ChoseMoneySelect(Sender: TObject);
    procedure BTsendCardClick(Sender: TObject);
    procedure ChoseMoneyKeyPress(Sender: TObject; var Key: Char);
    procedure RzBitBtn4Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FTurnBeginTime: TTime;
    JPGParth: string;
  public
    GMyGame: TTSPCard;
    procedure GameCreate;
    procedure GameBeging(IrandomPlayerIndex: Byte);
    procedure GameFree;
    procedure TalktoEveryBady(Icon: TIdTcpClient; Ibuff: RCTS_Chat); //聊天
    procedure AddShow(Icontent: string); //添加显示
    function GetPostBelve(Ipostion: sPlayerPostion; ICount: Byte): TBevel; //获取筐筐
    procedure ShowCard(IValue: PROneCard; Ipst: sPlayerPostion; IPos: Byte); //将扑克绘制出来
    procedure SHowGifTip(IBevel: TBevel); //画 出牌提示
    procedure SHowButtom(IState: boolean); //轮到当前玩家 显示/隐藏按钮
    function TurnSelf(ISelfIdx: byte): boolean; //判断是否轮到自己了
    function CurrIsPassUser: boolean; //是否是返放弃用户
    procedure TakeTimeBegin(Iplayer: PRplayer); //记时开始
    procedure SetCurrLable(Iplayer: PRplayer); //设置当前玩家信息
    procedure LookValue(Sender: TObject); //察看自己的头牌
    procedure SendCards(Ibuff: RSTC_PlayerSendCards); //玩家出牌
    procedure ShowNext; //画出下一家
    procedure ShowName(IPost: sPlayerPostion; Iplayer: PRplayer); //画名字和头像
    procedure VisibleName(Ipost: sPlayerPostion); //隐藏名字和头像
    procedure PlayerWined(Iidx: byte); //玩家赢了这局了
    procedure AddMoney(ICon: TIdTCPClient); //加分
    procedure ShowRule; //显示规则
  end;

var
  Fgame: TFgame;
  CardHandle: TList;

implementation

uses Pmain, DateUtils;

{$R *.dfm}

procedure TFgame.Button4Click(Sender: TObject);
begin
  if Fmain.Tabing then begin
    Fmain.LeaveTab(Fmain.GameClient);
    Fmain.GetTabList(Fmain.GameClient);
    Close;
    Fmain.Show;
  end;
end;

procedure TFgame.Button5Click(Sender: TObject);
begin
  if Fmain.Tabing then begin
    Fmain.ReadyGame(Fmain.GameClient, not Fmain.Readying);
    Fmain.Readying := not Fmain.Readying;
  end;
end;

procedure TFgame.RzBitBtn1Click(Sender: TObject);
begin
  TButton(Sender).Visible := False;
  if Fmain.Tabing then begin
    Fmain.ReadyGame(Fmain.GameClient, not Fmain.Readying);
  end;
end;

procedure TFgame.RzBitBtn2Click(Sender: TObject);
begin
  Close;
end;

procedure TFgame.RzBitBtn3Click(Sender: TObject);
begin
  with TOpenDialog.Create(Self) do begin
    FileName := '请选择一个要做为背景的Bmp或者Jpg图片';
    Filter := '*.*';
    if Execute then begin
      if FileExists(FileName) then
        Image1.Picture.LoadFromFile(FileName);
      Image1.SendToBack;
    end;
  end; // with
end;

procedure TFgame.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if not RzBitBtn2.Enabled then begin
    if MessageDlg('在游戏中退出是会引起公愤的...,确认要引起吗？', mtWarning, [mbYes, mbNo], 0) = Mryes then
     Fgame.GameFree;
    CanClose := True;
  end
  else begin
    CanClose := True;
  end;
end;

procedure TFgame.GameBeging(IrandomPlayerIndex: Byte);
var
  I, n: Integer;
begin
Try
  GMyGame.RandomBeginPlayer(IrandomPlayerIndex);
  //开始发排 发2轮
  for I := 0 to 1 do begin // Iterate                          //初始发牌
    for n := 0 to High(GMyGame.PlayerArr) do begin // Iterate
      ShowCard(GMyGame.PlayerArr[GMyGame.CurrPlayerIndex].InCard(GMyGame.GetOneCard),
        GMyGame.PlayerArr[GMyGame.CurrPlayerIndex].Postion,
        GMyGame.PlayerArr[GMyGame.CurrPlayerIndex].CurrCardCount);
      GMyGame.PlayerArr[GMyGame.CurrPlayerIndex].PlayerInfo^.TotMoney :=
        GMyGame.PlayerArr[GMyGame.CurrPlayerIndex].PlayerInfo^.TotMoney - 1;
      Sleep(100);
      GMyGame.NextPlayer;
    end; // for
  end; // for
Except
 Application.MessageBox('游戏处理初始化错误','悲惨');
End;  
  for I := 0 to High(GMyGame.PlayerArr) do begin // Iterate
    GMyGame.PlayerArr[i].PlayerInfo^.PassCurrGame := False; //初始化 放弃状态
    ShowName(GMyGame.PlayerArr[i].Postion, GMyGame.PlayerArr[i].PlayerInfo);
  end; // for
  SHowGifTip(GetPostBelve(GMyGame.PlayerArr[GMyGame.CurrPlayerIndex].Postion, 6)); //画出出牌提示
  RxGifTip.Visible := True; //显示提示
  RzGroupBox1.Visible := True; //显示筐
  SetCurrLable(GMyGame.PlayerArr[GMyGame.CurrPlayerIndex].PlayerInfo); //显示当前用户和赌金
  if TurnSelf(Fmain.PlayerIdxIntab) then //如果轮到自己画出按钮
    SHowButtom(True);
  RzBitBtn2.Enabled := False;
  FTurnBeginTime := time;
  TurnTimer.Enabled := True;
  Refresh; //刷新一下窗体

end;

procedure TFgame.GameCreate;
var
  I: Integer;
  Ltep: PRPlayer;
  Lteparr: Tlist;
begin
Try
  Lteparr := TList.Create;
  for I := 0 to High(Fmain.GTabPlayerArr) do begin // Iterate
    Ltep := @Fmain.GTabPlayerArr[i];
    Lteparr.Add(Ltep);
  end; // for
  GMyGame := TTSPCard.Create(Fmain.GTabPlayerArrCount,
    [Lteparr[0], Lteparr[1], Lteparr[2], Lteparr[3]]);
  Lteparr.Free;
  GMyGame.SetPlayerPostion(Fmain.PlayerIdxIntab);
  ShowRule;
except
Application.MessageBox('游戏管理器创建错误','倒霉');
end;
end;

procedure TFgame.GameFree;
var
  I: Integer;
begin
  for I := CardHandle.Count - 1 downto 0 do begin // Iterate
    TReNameCard(CardHandle.Items[i]).Free;
    CardHandle.Delete(i);
  end;
  for I := 0 to High(GMyGame.PlayerArr) do // Iterate
    VisibleName(GMyGame.PlayerArr[i].Postion);
  RzGroupBox1.Visible := False;
  RzProgressBar1.Visible := False;
  RxGifTip.Visible := False;
  RxGifTip.Animate:=False;
  SHowButtom(False);
  lbCurrPlayer.Tag := 0;
  TurnTimer.Enabled := False;
  RzBitBtn1.Visible := True;
  RzBitBtn2.Enabled:=True;
  FreeAndNil(GMyGame);
end;

function TFgame.GetPostBelve(Ipostion: sPlayerPostion; ICount: Byte): TBevel;
var
  I, n: Integer;
  Ltep: string;
begin
  Result := nil;
  Ltep := inttostr(ord(Ipostion) + 1) + inttostr(ICount);
  n := strtoint(Ltep);
  for I := 0 to Fgame.ComponentCount - 1 do begin // Iterate
    if Fgame.Components[i].Tag = n then begin
      Result := Fgame.Components[i] as TBevel;
      Break;
    end;
  end; // for
end;

procedure TFgame.ShowCard(IValue: PROneCard; Ipst: sPlayerPostion; IPos: Byte);
var
  Ltep: TBevel;
  LShowCard: TReNameCard;
begin
  Ltep := GetPostBelve(Ipst, IPos);
  LShowCard := TReNameCard.Create(self);
  LShowCard.Hide;
  LshowCard.Parent := Self;
  LShowCard.Top := Ltep.Top + 8;
  LShowCard.Left := Ltep.Left + 8;
  LShowCard.Tag := Ltep.Tag;
  LShowCard.OnClick := LookValue;
  LShowCard.Suit := TCardSuit(Ord(IValue^.Kind));
  LShowCard.Value := IValue^.Value;
  LShowCard.Show;