www.pudn.com > Roulette.rar > rltgame.pas
unit rltgame;
interface
uses
Classes, Types, DXInput, DXDraws, Graphics, Windows, SysUtils, TltConst,
math, ULoading, Forms;
type
TPlayData = record
//PlayData : array[0..60000] of Byte; //PlayData 60001
Name : string[3]; //Name 4
playerType : Byte; //Type 1
score : LongInt; //score 4
Dif : shortint; //难度 1
// State : TPlayerState; //Stage 1 = 60012
end;
TRlt = class
private
FHasInit : boolean;
FCurrentRoundNo: integer;
FRoundScord: TRoundScord;
// FCountDown: integer;
FRoundBeginTime : DWord;
FRealWheelParams : TWheelParams;
WheelParamChanged : boolean;
procedure DoBeting;
procedure DoBeforeWheel;
procedure DoPaused;
procedure DoWheeling;
procedure DoScore;
procedure DoDemo;
procedure DoStop;
function GetCountDown: integer;
procedure SetCurrentRoundNo(const Value: integer);
public
Round : TRound;
ErrorCode : Byte;
TimeSetting : TTimeSetting;
WheelParams : TWheelParams;
CurrentWheelParam : TWheelParam;
procedure Draw;
procedure Update;
constructor Create();
function DoInit: boolean;
procedure DoFinit;
procedure UpdateWheelParams;
procedure UpdateWheel;
procedure SetRound(const Value: TRound);
published
property CurrentRoundNo : integer read FCurrentRoundNo write SetCurrentRoundNo;
property CountDown : integer read GetCountDown;
// property RoundState : TRound read FRoundState write FRoundState;
end;
TPlayerPanelState = (ppsNoBody, ppsLogining, ppsLoginError, ppsActive, ppsLoginOtherWay, ppsUnknow);
TPlayer = class
private
FRBet : LongInt;
FBBet : LongInt;
FGBet : LongInt;
function GetBBet: LongInt;
function GetGBet: LongInt;
function GetRBet: LongInt;
procedure SetBBet(const Value: LongInt);
procedure SetGBet(const Value: LongInt);
procedure SetRBet(const Value: LongInt);
public
UserID : String;
Password : String;
money : LongInt;
State : TPlayerState;
Modified : boolean;
procedure ClearBets;
procedure Update;
property RBet : LongInt read GetRBet write SetRBet;
property BBet : LongInt read GetBBet write SetBBet;
property GBet : LongInt read GetGBet write SetGBet;
procedure Clear;
end;
TPlayerPanel = class
private
//page1
LoginButtomRect : TRect;
//page2
UserIDBox : TRect;
PasswordBox : TRect;
OKButtomRect : TRect;
CancelButtomRect : TRect;
LogoutButtomRect : TRect;
//page3
UserIDLabel : TRect;
ScoreLabel : TRect;
MsgLable : TRect;
Msg2Lable : TRect;
RBox : TRect;
BBox : TRect;
GBox : TRect;
//LogoutButtomRect : TRect;
//page4
ErrorLabel : TRect;
InputCount : integer;
Cursor : TPoint;
procedure SetState(const Value: TPlayerPanelState);
public
UserName : String;
Password : String;
Player : TPlayer;
FouceID : byte;
FState : TPlayerPanelState;
BoundsRect : TRect;
ClientRect : TRect;
Eabled : boolean;
procedure Update(CursorPos : TPoint; MouseState : byte; Key : Word);
procedure Draw(DestSurface : TDirectDrawSurface; PlayPanelFrame,ItemsSurface : TDirectDrawSurface);
property State : TPlayerPanelState read FState write SetState;
constructor Create(Player : TPlayer);
function OverButton(CursorPos: TPoint; R : TRect): boolean ;
end;
TChipPanel = class
private
FCursorPos : TPoint;
ChipRect : array [0..4] of TRect;
FSelectedChip: longint;
procedure SetSelectedChip(const Value: longint);
function GetSelectedChipValue: longint;
function OverButton(CursorPos: TPoint; R: TRect): boolean;
public
BoundsRect : TRect;
ClientRect : TRect;
property SelectedChip : longint read FSelectedChip write SetSelectedChip;
property SelectedChipValue : longint read GetSelectedChipValue;
procedure Update(CursorPos : TPoint; MouseState : byte; Key : Word);
procedure Draw(DestSurface, ChipPanelSurface, ItemsSurface : TDirectDrawSurface);
constructor Create();
end;
TTimePanel = class
Time : integer;
BoundsRect : TRect;
ClientRect : TRect;
TimeLabelRect : TRect;
RoundLabelRect : TRect;
Color : TColor;
procedure Update(CursorPos : TPoint; MouseState : byte; Key : Word);
procedure Draw(DestSurface, PanelSurface, ItemsSurface : TDirectDrawSurface);
constructor Create();
end;
THistoryPanel = class
BoundsRect : TRect;
ClientRect : TRect;
procedure Update(CursorPos : TPoint; MouseState : byte; Key : Word);
procedure Draw(DestSurface, PanelSurface, ItemsSurface : TDirectDrawSurface);
constructor Create();
end;
var
rlt : TRlt;
Players : array [0..3] of TPlayer;
PlayerPanel : array [0..3] of TPlayerPanel;
ChipPanel : TChipPanel;
TimePanel : TTimePanel;
HistoryPanel : ThistoryPanel;
// PPD : TPlayData;
Level1,Level2,Flag1 : Integer;
Frame1,FrameRate : Integer;
FrameTime : LongInt;
LastTime : LongInt;
MouseState : byte;
implementation
uses rltClient, Main;
{ TRlt }
procedure TRlt.Draw;
begin
try
case Round.State of
rsWaitToBegin, rsPaused:
begin
MainForm.DrawRoulette;
MainForm.DrawHistoryPanel;
MainForm.DrawPlayerPanels;
MainForm.DrawPaused;
MainForm.DrawMouse;
{draw wait}
end;
rsBeting:
begin
MainForm.DrawRoulette;
MainForm.DrawTimePanel;
MainForm.DrawChipPanel;
MainForm.DrawPlayerPanels;
MainForm.DrawHistoryPanel;
MainForm.DrawMouse;
end;
rsBeforeWheel:
begin
MainForm.DrawRoulette;
MainForm.DrawTimePanel;
MainForm.DrawPlayerPanels;
// MainForm.DrawChipPanel;
// MainForm.DrawHistoryPanel;
MainForm.DrawMouse;
end;
rsWheeling:
begin
MainForm.DrawRoulette;
MainForm.DrawScore;
MainForm.DrawMouse;
end;
rsScore:
begin
MainForm.DrawRoulette;
MainForm.DrawMouse;
// MainForm.DrawPaused;
end;
end;
//MainForm.DrawFPS;
MainForm.DXDraw.Flip;
Except
if not MainForm.DXDraw.CanDraw then
begin
try
MainForm.DXDraw.Finalize;
MainForm.DXDraw.Initialize;
except
end;
end;
end;
end;
var
ii: integer;
procedure TRlt.Update;
begin
//update game state;
if (not FHasInit) and (not DoInit) then Exit;
case Round.State of
rsWaitToBegin:
begin
{}
end;
rsDemo{开始本轮}:
begin
DoDemo;
end;
rsBeting{下注}:
begin
DoBeting;
end;
rsBeforeWheel{准备开局}:
begin
DoBeforeWheel;
end;
rsWheeling{转盘}:
begin
DoWheeling;
end;
rsScore{分数}:
begin
DoScore;
end;
rsPaused{系统暂停}:
begin
DoPaused;
end;
rsStop :
begin
DoStop;
end;
//, rsSyn{数据同步});
end;
MainForm.KeyList.Clear;
MouseState := 0;
UpdateWheel;
end;
procedure TRlt.DoBeting;
var
I, J: integer;
Key : word;
P : TPoint;
begin
// 开始新一局
if Level2 =1 then
begin
FRoundBeginTime := LastTime - Round.CountDown*1000 + 1000;//误差
MainForm.PlaySoundBeginBet;
Level2 := 2;
end;
//update
GetCursorPos(P);
P := MainForm.DXDraw.ScreenToClient(P);
if MainForm.KeyList.Count>0 then begin
for J := 0 to MainForm.KeyList.Count -1 do begin
Key := Word(MainForm.KeyList[J]);
for I := 0 to 3 do begin
PlayerPanel[I].Update(P,MouseState, Key);
end;
end;
end else begin
for I := 0 to 3 do begin
PlayerPanel[I].Update(P,MouseState, 0);
end;
ChipPanel.Update(P, MouseState, 0);
TimePanel.Update(P, MouseState, 0);
HistoryPanel.Update(P, MouseState, 0);
end;
end;
constructor TRlt.Create;
begin
FHasInit := false;
Round.State := rsWaitToBegin;
Level2 := 1;
end;
procedure TRlt.DoFinit;
begin
end;
function TRlt.DoInit : boolean;
begin
//1,第一次登入，2掉线后恢复登入
//syn server Roundstate 1.RoundNo, RoundScord,RoundState,PassTime,RoundCounter,
//RoundSetting.
Result := false;
if not RltConnection.Connected then Exit;
// Round := TltInterpreter.CallGetCurrentRound;
//WaitRoundToBegin;
Round.State := rsWaitToBegin;
Level2 := 1;
// FRoundScord := TltInterpreter.CallGetScore(Round.No, Round.WheelNo);
WheelParams := TltInterpreter.CallGetWheelParams;
FRoundBeginTime :=LastTime - WheelParams.WheelStartTickCount;
UpdateWheelParams;
FHasInit := true;
Result := true;
end;
procedure TRlt.DoBeforeWheel;
begin
if Level2 = 1 then begin
MainForm.PlaySoundStopBet;
Level2 := 2;
end;
end;
procedure TRlt.DoPaused;
begin
end;
procedure TRlt.DoScore;
begin
if Level2 =1 then begin
MainForm.PlaySoundNum(Round.WheelResult);
Level2 := 2;
end;
end;
procedure TRlt.DoWheeling;
begin
end;
procedure TRlt.DoDemo;
begin
end;
function TRlt.GetCountDown: integer;
begin
Result := TimeSetting.BeforeWheelTimeSet - Round.CountDown;
if Result <=0 then Result := 0;
end;
procedure TRlt.SetCurrentRoundNo(const Value: integer);
begin
FCurrentRoundNo := Value;
end;
procedure TRlt.UpdateWheelParams;
begin
//更新了旋转参数，将速度进行适当的调整，以达到目的结果；
FRealWheelParams := WheelParams;
CurrentWheelParam := FRealWheelParams.Params[0];
end;
procedure TRlt.UpdateWheel;
var
DT : integer;
i : integer;
V : single;
DV : single;
MaxFrameTime : integer;
begin
//转动轮子；
//当前轮子状态，收到包时，期望轮子状态，
//当前
for i :=0 to FRealWheelParams.ParamsCount-1 do begin
if (LastTime - FRoundBeginTime) / 1000 <= FRealWheelParams.Params[i].FrameTime +FRealWheelParams.Params[i].TimeDuration then
break;
end;
if i>= FRealWheelParams.ParamsCount then I:= FRealWheelParams.ParamsCount -1;
MaxFrameTime := (FRealWheelParams.Params[i].FrameTime +FRealWheelParams.Params[i].TimeDuration) * 1000;
//当前帧定义
CurrentWheelParam := FRealWheelParams.Params[i];
with CurrentWheelParam do begin
BallR := 8;
if CurrentWheelParam.TimeDuration = 0 then Exit;
//开始时间
DT := LastTime - FRoundBeginTime- FRealWheelParams.Params[i].FrameTime* 1000;
if DT> MaxFrameTime then DT := MaxFrameTime;
//如果时间太长，则完成此关键帧
if DT > TimeDuration * 1000 then
DT := TimeDuration * 1000;
{ if I=4 then
begin
{ WheelTheta := FRealWheelParams.Params[i].WheelTheta + WheelV * (DT /1000)
+(-WheelV/TimeDuration-WheelA*TimeDuration/2)*(DT /1000)*(DT /1000)
+ WheelA* (DT/1000) * (DT/1000) * (DT/1000)/6 ;
BallTheta := FRealWheelParams.Params[i].BallTheta + WheelV * (DT / 1000)
+(-WheelV/TimeDuration-WheelA*TimeDuration/2)*(DT /1000)*(DT /1000)
+ BallA * (DT/1000) * (DT/1000)*(DT/1000)/6 ;}
{ WheelTheta := FRealWheelParams.Params[i].WheelTheta + WheelV * (DT /1000)
+(-WheelV/TimeDuration)*(DT /1000)*(DT /1000)
+ 2*PI* (DT/1000) * (DT/1000)/TimeDuration/TimeDuration ;
BallTheta := FRealWheelParams.Params[i].BallTheta + + WheelV * (DT /1000)
+(-WheelV/TimeDuration)*(DT /1000)*(DT /1000)
+ 2*PI* (DT/1000) * (DT/1000)/TimeDuration/TimeDuration ;
end else}
begin
WheelTheta := FRealWheelParams.Params[i].WheelTheta + WheelV * (DT /1000)
+ WheelA* (DT/1000) * (DT/1000) /2 ;
BallTheta := FRealWheelParams.Params[i].BallTheta + BallV * (DT / 1000)
+ BallA * (DT/1000) * (DT/1000) /2 ;
end;
//矫正
DV := abs(BallV-WheelV);
if (BallR>-1) and (BallR<5) and (DV < 0.01) and (DV>0) then begin
BallTheta := BallTheta - 0.001;
end;
//由球速度决定球离心半径；
V := WheelV + (DT/ 1000)* wheelA;
//球速较高的时候；
if V>=2 then
BallR :=abs((abs(V)-0.1) * 5.5 / 1 )
else
//球在下降区
if V>1.256 then
BallR :=abs((abs(V*V)-0.1) * (2.7) / 1 + 0.8 )
else if V > 0 then begin
BallR := (1 - DT /1000) *4.5/1;
if DT/1000>1 then BallR := 0;
if BallR>4.5 then BallR:=4.5;
end else if (V=0) or (abs(BallV- WheelV)<0.1) then begin
BallR := 0;
end; {else
if (V>0) and (V<=1) then
begin
BallR := (2 - DT /1000) *4.5/2;
if DT/1000>2 then BallR := 0;
// BallR :=abs((abs(V)-0.1) * 4.7 / 1 );
// BallR := 0;
// BallR := 4.5;
end else
if (V<0) and (V>=-1) then
begin
BallR :=abs((abs(V*V)-0.1) * 6 / 1 +1 );
end; }
if (BallR < 5) and (abs(BallV)>0.1) then begin
if Level2<>3 then begin
MainForm.PlaySoundBounce;
Level2 :=3;
end;
end;
// DV := (Sin( DT/1000/ CurrentWheelParam.TimeDuration*pi))* FRealWheelParams.Params[i].BallR ;
// BallR := BallR + sin((DV+1)*pi/(BallR+1))*DV;
if BallR>11 then BallR := 11;
if BallR<0 then BallR := 0;
//if (BallR<-1) then BallHeight := -BallR * 2 / 11;
//跳跃
BallHeight := BallR * 1.5 / 11;
if (BallR>-1) and (BallR<5) and (abs(BallV-WheelV)>0.001) then begin
DV := abs(BallV+ (BallA-WheelA)*DT/1000-WheelV);
if DV > 4 then DV := 37/5 else
if DV > 3 then DV := 37/4 else
if DV > 2 then DV := 37/2 else DV := 37/1;
BallHeight := BallHeight + abs(Sin((WheelTheta-BallTheta)*(DV)))*1.5;
end;
end;//}
end;
procedure TRlt.SetRound(const Value: TRound);
begin
if Round.State <> Value.State then Level2 := 1;
Round := Value;
end;
procedure TRlt.DoStop;
begin
MainForm.FInitMidi;
RltConnection.Connected := false;
if IDYes <> MessageBox(MainForm.handle, '服务器关闭!是否重新连接', '', MB_YESNO or MB_ICONQUESTION) then
Application.Terminate;
Level1 :=5;
end;
{ TPlayerPanel }
constructor TPlayerPanel.Create(Player: TPlayer);
const
BDX = 64;
BDY = 23;
begin
Self.Player := Player;
BoundsRect := Rect(0, 0, 250, 112);
LoginButtomRect := Rect(90, 40, 90+ BDX , 40 + BDY);
//page2
UserIDBox := Rect(60, 6, 181, 44);
PasswordBox := Rect(60, 36, 181, 68);
OKButtomRect := Rect(56, 70, 56+ BDX , 70 + BDY);
CancelButtomRect := Rect(148, 70, 148+ BDX , 70 + BDY);
LogoutButtomRect := Rect(170, 10, 170+ BDX , 10 + BDY);
MsgLable := Rect(44, 30, 181, 64);
Msg2Lable := Rect(20, 30, 181, 64);
//page3
UserIDLabel := Rect(16, 10, 124 , 44);
ScoreLabel := Rect(16, 40, 124 , 68);
RBox := Rect(1, 75, 83, 102);
BBox := Rect(84, 75, 166, 102);
GBox := Rect(167, 75,250, 102);
// LogoutButtomRect := Rect(140, 24, 140+ BDX , 24 + BDY);
end;
procedure TPlayerPanel.Draw(DestSurface : TDirectDrawSurface;
PlayPanelFrame, ItemsSurface: TDirectDrawSurface);
procedure DrawBox(R : TRect; S :String;Enabled : Boolean);
var
CR : TRect;
begin
//CR := Rect(X, Y, 62+X ,21+ Y);
CR := R;
OffsetRect(CR, BoundsRect.Left, BoundsRect.Top);
with DestSurface.Canvas do begin
Font.Charset := GB2312_CHARSET;
if (PtInRect(CR, Cursor) and Enabled) then begin
Brush.Color := $F8BBB8;
Brush.Style := bsSolid;
FillRect(CR);
Font.Color := clWhite;
end else begin
Brush.Style := bsClear;
Font.Color := $F8BBB8;
end;
Font.Name := '';
Font.Size := 12;
Brush.Style := bsClear;
TextOut(CR.Left+18,CR.Top+4, S);
Release;
end;
DestSurface.Draw(Cr.Left, CR.Top, Rect(1,204,100,228), ItemsSurface, true);
end;
procedure DrawEdit(R : TRect; S: String; Enabled: boolean; Focus : boolean; MaskChar:Char = #0);
var
CR : TRect;
I : integer;
SS : String;
begin
CR := R;
OffsetRect(CR, BoundsRect.Left, BoundsRect.Top);
//Draw Rect
DestSurface.Draw(Cr.Left, CR.Top, Rect(108,201,271,232), ItemsSurface, true);
//Draw Text
with DestSurface.Canvas do begin
Font.Charset := GB2312_CHARSET;
Brush.Style := bsClear;
// Font.Style := [fsBold];
if Enabled and Focus then begin
Font.Color := clWhite;
end else begin
Font.Color := $F8BBB8;
end;
Font.Name := 'Arial';
Font.Size := 12;
Brush.Style := bsClear;
if MaskChar <>'' then begin
SS := '';
for I := 0 to Length(S) -1 do begin
SS := SS + MaskChar;
end;
S := SS;
end;
if Focus and ((LastTime div 300) mod 2 = 0) then S := S+'|';
TextOut(CR.Left+4,CR.Top+6, S);
Release;
end; //Draw Foucus;
end;
procedure DrawText(R : TRect; S : String; Size : integer = 9 );
var
CR : TRect;
begin
CR := R;
OffsetRect(CR, BoundsRect.Left, BoundsRect.Top);
with DestSurface.Canvas do begin
Font.Charset := GB2312_CHARSET;
Brush.Style := bsClear;
Font.Color := clWhite;
Font.Name := '';
Font.Size := Size;
Brush.Style := bsClear;
TextOut(CR.Left+4,CR.Top+4, S);
Release;
end; //Draw Foucus;
end;
procedure DrawRectText(R : TRect; S : String; Size : integer = 9);
var
CR : TRect;
begin
CR := R;
OffsetRect(CR, BoundsRect.Left, BoundsRect.Top);
with DestSurface.Canvas do begin
Font.Charset := DEFAULT_CHARSET;
Brush.Style := bsClear;
Font.Color := clWhite;
Font.Name := '';
Font.Size := Size;
Brush.Style := bsClear;
windows.DrawText(Handle, pchar(S),Length(S), CR, DT_CENTER or DT_VCENTER);
// DrawText(CR, S);
Release;
end; //Draw Foucus;
end;
var
SRect : TRect;
begin
SRect := Rect(0,0, 250, 102);
DestSurface.Draw(BoundsRect.Left, BoundsRect.Top, SRect, PlayPanelFrame, true);
case State of
ppsNoBody:
begin
DrawBox(LoginButtomRect, '登入', True);
end;
ppsLogining:
begin
DrawText(UserIDLabel, '帐号', 12);
DrawText(ScoreLabel, '密码', 12);
DrawEdit(UserIDBox, UserName, True, FouceID = 1);
DrawEdit(PasswordBox, Password, True, FouceID = 2, '#');
DrawBox(OKButtomRect, '确定', true);
DrawBox(CancelButtomRect, '取消', true);
end;
ppsLoginError:
begin
DrawText(MsgLable, '用户命或密码错误!', 12);
DrawBox(CancelButtomRect, '重试', true);
end;
ppsLoginOtherWay:
begin
DrawText(Msg2Lable, '帐号在其他地方登陆或被请出！', 12);
DrawBox(CancelButtomRect, '确定', true);
end;
ppsUnknow:
begin
DrawText(Msg2Lable, '发生未知错误！', 12);
DrawBox(CancelButtomRect, '确定', true);
end;
ppsActive:
begin
SRect := Rect(0,36, 250, 138);
DestSurface.Draw(BoundsRect.Left, BoundsRect.Top, SRect, PlayPanelFrame, true);
DrawText(UserIDLabel, ' 帐号: '+ UserName, 12);
DrawText(ScoreLabel, ' 点数: ' + IntToStr(max(0,Player.money-Player.RBet-Player.BBet-Player.GBet)),12);
DrawBox(LogoutButtomRect, '注销', true);
if Player.RBet <> 0 then
DrawRectText(RBox, IntToStr(Player.RBet), 14);
if Player.GBet <> 0 then
DrawRectText(GBox, IntToStr(Player.GBet), 14);
if Player.BBet <> 0 then
DrawRectText(BBox, IntToStr(Player.BBet), 14);
end;
end;
end;
function TPlayerPanel.OverButton(CursorPos: TPoint; R: TRect): boolean;
var
TmpR : TRect;
begin
TmpR := R;
OffsetRect(TmpR, BoundsRect.Left, BoundsRect.Top);
if PtInRect(TmpR, CursorPos) then
Result := true
else
Result := false;
end;
procedure TPlayerPanel.SetState(const Value: TPlayerPanelState);
begin
FState := Value;
end;
procedure TPlayerPanel.Update(CursorPos: TPoint;
MouseState : byte; Key: Word);
function Clicked : boolean;
begin
Result := (MouseState = 1);
end;
function ClickedButton(R : TRect): boolean ;
begin
if (MouseState = 1) and OverButton(CursorPos, R) then
Result := True
else
Result := False;
end;
function RClickedButton(R : TRect): boolean ;
begin
if (MouseState = 2) and OverButton(CursorPos, R) then
Result := True
else
Result := False;
end;
var
PlayerInfo : TPlayerInfo;
I : integer;
begin
Self.Cursor := CursorPos;
case FState of
ppsNoBody:
begin
if ClickedButton(LoginButtomRect) then begin
State := ppsLogining;
FouceID := 1;
InputCount := 0;
end;
end;
ppsLogining:
begin
//得到焦点
if Clicked then begin
if ClickedButton(UserIDBox) then FouceID := 1
else
if ClickedButton(PasswordBox) then FouceID := 2
else//失去焦点
FouceID := 0;
end;
if Key in [VK_NUMPAD0..VK_NUMPAD9] then
Key := Key - VK_NUMPAD0 + Ord('0');
if (FouceID = 1) then begin
if (Key in [Ord('0')..Ord('9') ]) and (Length(UserName)<=12) then
UserName := UserName + String(char(Key))
else if (Key in [VK_BACK, VK_Left]) and (Length(UserName)>0) then
UserName := copy(UserName, 1, length(UserName) -1);
InputCount := 0;
end;
if (FouceID = 2) then begin
if (Key in [Ord('0')..Ord('9'), ord('a')..Ord('z'), Ord('A')..Ord('Z')])
and (Length(Password)<=12) then
Password := Password + String(char(Key))
else if (Key in [VK_BACK, VK_Left]) and (Length(Password)>0) then
Password := copy(Password, 1, length(Password) -1);
InputCount :=0;
end;
inc(InputCount);
if (InputCount>300) or ClickedButton(CancelButtomRect) then begin
State := ppsNoBody;
UserName := '';
Password := '';
end;
if ClickedButton(OKButtomRect) then begin
for i :=0 to 3 do begin
if (UserName<>'') and ( Players[i].UserID = UserName) and (PlayerPanel[i] <> Self) then begin
with PlayerPanel[i] do begin
TltInterpreter.CallLogoffPlayer(Player.UserID);
State := ppsLoginOtherWay;
UserName := '';
Password := '';
Player.Clear;
InputCount := 0;
end;
end;
end;
if TltInterpreter.CallLoginPlayer(UserName, Password) then begin
State := ppsActive;
PlayerInfo := TltInterpreter.CallGetPlayerInfo(UserName);
if PlayerInfo.State = psActive then begin
Player.UserID := PlayerInfo.ID;
Player.money := PlayerInfo.money;
Player.State := PlayerInfo.State;
end else begin
Player.UserID := '';
Player.money := 0;
Player.State := psNoBody;
State := ppsUnknow;
end;
end else begin
State := ppsLoginError;
InputCount := 0;
// FouceID := 2;
end;
end;
end;
ppsLoginError:
begin
inc(InputCount);
if (InputCount>1000) then begin
State := ppsNoBody;
UserName := '';
Password := '';
end;
if ClickedButton(CancelButtomRect) then begin
State := ppsLogining;
FouceID := 2;
end;
end;
ppsLoginOtherWay, ppsUnknow:
begin
inc(InputCount);
if (InputCount>300) or ClickedButton(CancelButtomRect) then begin
State := ppsNoBody;
UserName := '';
Password := '';
end;
end;
ppsActive:
begin
if ClickedButton(LogoutButtomRect) then begin //logout
TltInterpreter.CallLogoffPlayer(Player.UserID);
State := ppsNoBody;
UserName := '';
Password := '';
Player.Clear;
end;
if ClickedButton(RBox) then begin
Player.RBet := Player.RBet + ChipPanel.SelectedChipValue;
MainForm.PlaySoundBetting;
end;
if RClickedButton(RBox) then begin
Player.RBet := Player.RBet - ChipPanel.SelectedChipValue;
MainForm.PlaySoundBetting;
end;
if ClickedButton(BBox) then begin
Player.BBet := Player.BBet + ChipPanel.SelectedChipValue;
MainForm.PlaySoundBetting;
end;
if RClickedButton(BBox) then begin
Player.BBet := Player.BBet - ChipPanel.SelectedChipValue;
MainForm.PlaySoundBetting;
end;
if ClickedButton(GBox) then begin
Player.GBet := Player.GBet + ChipPanel.SelectedChipValue;
MainForm.PlaySoundBetting;
end;
if RClickedButton(GBox) then begin
Player.GBet := Player.GBet - ChipPanel.SelectedChipValue;
MainForm.PlaySoundBetting;
end;
if Player.Modified then begin
Player.Update;
end;
end;
end;
end;
{ TPlayer }
procedure TPlayer.Clear;
begin
UserID := '';
Password := '';
FRBet := 0;
FBBet := 0;
FGBet := 0;
Modified := false;
State := psNoBody;
end;
procedure TPlayer.ClearBets;
begin
FRBet := 0;
FBBet := 0;
FGBet := 0;
Modified := true;
end;
function TPlayer.GetBBet: LongInt;
begin
Result := FBBet;
end;
function TPlayer.GetGBet: LongInt;
begin
Result := FGBet;
end;
function TPlayer.GetRBet: LongInt;
begin
Result := FRBet;
end;
procedure TPlayer.SetBBet(const Value: LongInt);
begin
if FBBet <> Value then
begin
FBBet := Value;
if FBBet <0 then FBBet := 0;
Modified := true;
end;
end;
procedure TPlayer.SetGBet(const Value: LongInt);
begin
if FGBet <> Value then
begin
FGBet := Value;
if FGBet <0 then FGBet := 0;
Modified := true;
end;
end;
procedure TPlayer.SetRBet(const Value: LongInt);
begin
if FRBet <> Value then
begin
FRBet := Value;
if FRBet <0 then FRBet := 0;
Modified := true;
end;
end;
procedure TPlayer.Update;
begin
if Modified then
TltInterpreter.CallBet(Self);
Modified := false;
end;
{ TChipPanel }
constructor TChipPanel.Create;
var
I : integer;
begin
// ClientRect := Rect(0, 0, 332, 144);
ClientRect := Rect(0, 0, 301, 104);
for I := 0 to Length(ChipRect) -1 do begin
// ChipRect[I] := Rect( I * 33 + 75, 30 + 8, 33 + I * 33 + 75, 65 + 8 );
ChipRect[I] := Rect( I * 40 + 60, 30 + 8, 40 + I * 40 + 60, 65 + 8 );
end;
end;
function TChipPanel.OverButton(CursorPos: TPoint; R: TRect): boolean;
var
TmpR : TRect;
begin
TmpR := R;
OffsetRect(TmpR, BoundsRect.Left, BoundsRect.Top);
if PtInRect(TmpR, CursorPos) then
Result := true
else
Result := false;
end;
procedure TChipPanel.Draw(DestSurface, ChipPanelSurface, ItemsSurface: TDirectDrawSurface);
var
I : integer;
SR : TRect;
X, Y : integer;
begin
//draw panel;
DestSurface.Draw(BoundsRect.Left, BoundsRect.Top, ClientRect, ChipPanelSurface, true);
//draw chips
// ItemsSurface
for I := 0 to Length(ChipRect) -1 do
begin
X := 66; Y := 21;
SR := Rect(X,Y+35*I, X+33, Y + 35 + 35 *I);
if I = FSelectedChip then
begin
X:= 33;
SR := Rect(X,Y+35*I, X+33, Y + 35 + 35 *I)
end
else if OverButton(FCursorPos, ChipRect[I])then
SR := Rect(0, Y+35*I, 33, Y+ 35 + 35 *I);
DestSurface.Draw(chiprect[I].Left + BoundsRect.Left, chipRect[I].Top + BoundsRect.Top , SR, ItemsSurface, true);
end;
end;
function TChipPanel.GetSelectedChipValue: longint;
const
ChipValue : array [0..4] of longint = (50, 100, 500, 1000, 5000);
begin
Result := chipValue[FSelectedChip];
end;
procedure TChipPanel.SetSelectedChip(const Value: longint);
begin
FSelectedChip := Value;
end;
procedure TChipPanel.Update(CursorPos: TPoint; MouseState: byte;
Key: Word);
var
I : integer;
function ClickedButton(R : TRect): boolean ;
begin
if (MouseState = 1) and OverButton(CursorPos, R) then
Result := True
else
Result := False;
end;
begin
FCursorPos := CursorPos;
for I := 0 to Length(ChipRect) -1 do
begin
if ClickedButton(ChipRect[I]) then
begin
SelectedChip := I;
MainForm.PlaySoundSelChip;
end;
end;
end;
{ TTimePanel }
constructor TTimePanel.Create;
begin
Color := clWhite;
// ClientRect := Rect(0, 0, 332, 144);
ClientRect := Rect(0, 1, 301, 103);
{ RoundLabelRect := Rect(0, 5, 301, 48);
TimeLabelRect := Rect(0, 35, 301, 114);}
TimeLabelRect := Rect(0, 10, 301, 130);
end;
procedure TTimePanel.Draw(DestSurface, PanelSurface, ItemsSurface : TDirectDrawSurface);
procedure DrawRectText(R : TRect; S : String; Size : integer = 9);
var
CR : TRect;
begin
CR := R;
OffsetRect(CR, BoundsRect.Left, BoundsRect.Top);
with DestSurface.Canvas do begin
Brush.Style := bsClear;
Font.Color := Self.Color;
Font.Name := '';
Font.Charset := ANSI_CHARSET;
Font.Size := Size;
Brush.Style := bsClear;
windows.DrawText(Handle, pchar(S),Length(S),CR,DT_CENTER or DT_VCENTER);
// DrawText(CR, S);
Release;
end; //Draw Foucus;
end;
begin
//draw panel;
DestSurface.Draw(BoundsRect.Left,BoundsRect.Top,ClientRect,PanelSurface,true);
Color := clWhite;
DrawRectText(RoundLabelRect, '第'+ IntToStr(rlt.Round.No) +'局', 24);
if rlt.CountDown<=rlt.TimeSetting.BeforeWheelTimeSet-rlt.TimeSetting.BetTimeSet then
Color := TColor($4444FF);
DrawRectText(TimeLabelRect, FormatFloat('00',rlt.CountDown),60);
end;
procedure TTimePanel.Update(CursorPos: TPoint; MouseState: byte;
Key: Word);
begin
Time := rlt.CurrentRoundNo;
end;
{ THistoryPanel }
constructor THistoryPanel.Create;
begin
ClientRect := Rect(0, 0, 800-144-15, 600-20-229);
end;
procedure THistoryPanel.Draw(DestSurface, PanelSurface, ItemsSurface : TDirectDrawSurface);
var
I ,J: integer;
function GetColorIndex(Num : integer): integer;
begin
result := -1;
case Num of
1, 3,5,7,9,12,14,16,18,19,21,23,25,27,30,32,34,36:
Result := 0;
2,4,6,8,10,11,13,15,17,20,22,24,26,28,29,31,33,35:
Result := 1;
0: Result := 2;
else Result := -1;
end;
end;
procedure DrawRectText(R : TRect; S : String; Size : integer = 9);
var
CR : TRect;
begin
CR := R;
OffsetRect(CR, BoundsRect.Left, BoundsRect.Top);
with DestSurface.Canvas do
begin
Font.Charset := DEFAULT_CHARSET;
Brush.Style := bsClear;
Font.Color := clWhite;
Font.Name := 'Technic';
Font.Size := Size;
Brush.Style := bsClear;
windows.DrawText(Handle, pchar(S),Length(S), CR, DT_CENTER or DT_VCENTER);
// DrawText(CR, S);
Release;
end; //Draw Foucus;
end;
var
CBoundsRect ,R, DR : TRect;
begin
//draw panel;
CBoundsRect := BoundsRect;
DestSurface.Draw(BoundsRect.Left, BoundsRect.Top, ClientRect, PanelSurface, true);
for I := 1 to 10 do
for J := 0 to 4 do
begin
if (rlt.Round.Scord.Number[J * 10 + I]>=0) then
begin
R := Rect(
200+41*GetColorIndex(rlt.Round.Scord.Number[J * 10 + I ]),
0,
200+41*GetColorIndex(rlt.Round.Scord.Number[J * 10 + I ])+41,
33);
DR := Rect(
I * 42+ 103 - 42,
J * 34 + 81 + 3,
I * 42+ 103,
J * 34 + 81 + 34);
if (rlt.Round.Scord.Count>=J * 10 + I ) then
begin
DestSurface.Draw(I * 42+ 103 + BoundsRect.Left - 42, J * 34 + 81 + BoundsRect.Top,
R, ItemsSurface,true);
DrawRectText(DR, IntToStr(rlt.Round.Scord.Number[J * 10 + I ]), 18);
end;
end;
end;
BoundsRect := CBoundsRect;
end;
procedure THistoryPanel.Update(CursorPos: TPoint; MouseState: byte;
Key: Word);
begin
end;
initialization
rlt := TRlt.Create;
for ii := 0 to 3 do
begin
Players[ii] := TPlayer.Create;
PlayerPanel[ii] := TPlayerPanel.Create(players[ii]);
PlayerPanel[ii].ClientRect := Rect(0,0, 250, 102);
PlayerPanel[ii].BoundsRect := Rect(0,0, 250, 102);
end;
OffsetRect(PlayerPanel[0].BoundsRect, 0, 0);
OffsetRect(PlayerPanel[1].BoundsRect, 800-250, 0);
OffsetRect(PlayerPanel[2].BoundsRect, 0, 600-102);
OffsetRect(PlayerPanel[3].BoundsRect, 800-250, 600-102);
ChipPanel := TChipPanel.Create;
// ChipPanel.BoundsRect := Rect(239, 600-80, 239+322, 600);
ChipPanel.BoundsRect := Rect(249, 600-104, 249+301, 600);
TimePanel := TTimePanel.Create;
// TimePanel.BoundsRect := Rect(239, 0, 800 - 114 , 144 );
TimePanel.BoundsRect := Rect(249, 0, 249+301 , 144 );
HistoryPanel := THistoryPanel.Create;
HistoryPanel.BoundsRect := Rect(249, 144, 800 , 600 - 144 );;
finalization
for ii := 0 to 3 do begin
Players[ii].Free;
PlayerPanel[ii].Free;
end;
ChipPanel.Free;
rlt.Free;
end.