?? 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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -