www.pudn.com > Roulette.rar > rltSvr.pas
unit rltSvr;
interface
uses Classes, SConnectEx, TltConst, ExtCtrls, MMSystem, Types, windows, TltLogic
, SysUtils;
type
TTltClient = class;
TPlayer = class;
{自动状态机，以时间为脉冲
}
TTltManager = class(TComponent)
private
FTickCount : DWord;
FStartTickCount : DWord;
// FWheelCounter : integer;
FWheelStartTickCount : DWord;
FCountDown: integer;
FBetTimeSetting : DWord;
FBeforeWheelTimeSetting : DWord;
FWheelingTimeSetting : DWord;
FScoreTimeSetting : DWord;
FRoundMain : DWord;
FState: TRoundState;
FTimeSettingModified : boolean;
FFlag : array [0..31] of byte;
FBaseValue, FTotalValue, FObjectValue, FRate, FBleed : longint;
AllBetTotle : longint;
Level2 : integer;
FBallTheta, FWheelTheta : single;
FSpecialNum : boolean;
FLastWheelParamGetTime : integer;
FPauseAtRoundEnd : boolean;
function GetResult : integer;
function GetCountDown: integer;
procedure UpdateCounter;
procedure UpdateLogic;
procedure Update;
procedure Log;
procedure UpdateCountDown;
procedure ResetWheel;
procedure UpdateTimeSetting;
procedure DoBeting;
procedure DoBeforeWheel;
procedure DoWheeling;
procedure DoScore;
procedure DoWheelEnd;
procedure DoStop;
procedure DoPaused;
function GetState: TRoundState;
function GetClientByPlayer(Player: TPlayer): TTltClient;
function GetColorIndex(Num: integer): integer;
function GetWheelParams(State: TRoundState):TWheelParams;
function GetRandomNumByColor(ColorIndex: integer): integer;
procedure ResetPlayerBet;
public
TimeSetting : TTimeSetting;
FTltClients : TList;
FPlayerList : TList;
Round : TRound;
NeedResetPlayerBet : boolean;
PauseOnNewRound : boolean;
RoundID : integer;
WheelResult : integer;
WheelParams : TWheelParams;
RoundScords : array [0..99] of TRoundScord;
RoundScordInfosArray : array [0..99] of TRoundScordInfos;
BetCount : array [TBetType] of longint;
// FState : TRoundState;
Timer : TTimer;
procedure UpdateClients(Proc : TClientProc);
function DoPlayerEdit(APlayerEditInfo : TPlayerEditInfo): TPlayerEditInfo;
function GetPlayerList(APlayerList : TPlayerList) : TPlayerList;
function SetPlayerList(APlayerList : TPlayerList) : TPlayerList;
function GetRoundInfoLog(var AArrayofRoundInfo : TArrayofRoundInfo) : integer;
function GetPlayerBetInfoLog(var AArrayofPlayerBetInfo : TArrayofPlayerBetInfo) : integer;
function ClearRoundInfoLog : boolean;
function ClearPlayerBetInfoLog : boolean;
function ClearPlayerList : boolean;
procedure StartRound;
procedure DoTimer(Sender : TObject);
function CreatePlayer : TPlayer;
function LoginPlayer( APlayer : TPlayer):boolean;overload;
function LoginPlayer(PlayerID , Password : String; AClient: TtltClient) : boolean;overload;
procedure LogoffPlayer(PlayerID : String);
procedure DeletePlayer(ID : String);
function GetOpenNumber : integer;
function SetOpenNumber(ANum: integer) : integer;
function SetOpenColorIndex(AColorIndex : integer) :boolean;
function GetBetCount : TBatArray;
function NextState : TRoundState;
function GetPlayerByID(PlayerID : String) : TPlayer;
destructor Destroy; override;
procedure AddClient(Client : TTltClient);
procedure RemoveClient(Client : TTltClient);
function GetGameParams : TGameParams;
function SetGameParams(AGameParams : TGameParams) : boolean;
function SetRoundState(const Value: TRoundState): boolean;
procedure ResetRound;
function GetRoundScordInfo(RoundID : integer) : TRoundScordInfos;
function CheckAdmin(Tag : integer; AdminStr : String):boolean;
published
property BaseValue : integer read FBaseValue;
property TotalValue: integer read FTotalValue write FTotalValue;
property ObjectValue : integer read FObjectValue write FObjectValue;
property Rate:integer read FRate write FRate;
property Bleed: integer read FBleed write FBleed;
property CountDown : integer read GetCountDown write Round.CountDown;
property State : TRoundState read GetState;
public
procedure UpDateWheelParams;
procedure Dafultsetting;
procedure InitRound;
constructor Create(AOwner: TComponent); override;
procedure DoInit;
end;
TPlayer = class
ID : String;
Password : String;
HadLogin : String;
UserName : String;
Memo : String;
Client : TTltClient;
Money : integer;
TimeOut : integer;
LastActiveTime : TDateTime;
Bet : array [TBetType] of integer;
Modified : boolean;
State : TPlayerState;
function GetPlayerInfo : TPlayerInfo;
procedure SetPlayerInfo(PlayerInfo : TPlayerInfo);
constructor Create;
end;
TTltClient = class
FManager : TTltManager;
PlayerList : TList;
Interpreter : TrltServerInterpreter;
public
constructor Create(manager : TTltManager);
destructor Destroy; override;
function HasPlayer(Player : TPlayer) : boolean;
procedure AddPlayer(Player : TPlayer);
procedure RemovePlayer(Player : TPlayer);
end;
var
rltManager : TTltManager;
implementation
uses ScktMain, DAU;
{ TTltClient }
{ TTltManager }
procedure TTltManager.AddClient(Client: TTltClient);
begin
if not Assigned(Client) then Exit;
FTltClients.Add(Client);
end;
constructor TTltManager.Create(AOwner: TComponent);
begin
inherited;
FSpecialNum := false;
PauseOnNewRound := true;
//init
Dafultsetting;
UpdateTimeSetting;
//read setting;
//timer
Timer := TTimer.Create(self);
Timer.OnTimer := DoTimer;
Timer.Enabled := true;
FPlayerList := TList.Create;
FTltClients := TList.Create;
//new Round
DoInit;
inc(Round.CountDown);
InitRound;
Round.State := rsPaused;
NeedResetPlayerBet := false;
end;
function TTltManager.CreatePlayer: TPlayer;
begin
// No user;
end;
procedure TTltManager.Dafultsetting;
begin
Round.Main := 1;
Round.No := 1;
Round.WheelNo := 0;
FRate := 1;
Round.State := rsPaused;
Level2 := 1;
FBetTimeSetting := 50;
FBeforeWheelTimeSetting := 10;
FWheelingTimeSetting := 15;
FScoreTimeSetting := 5;
UpdateTimeSetting;
end;
procedure TTltManager.DeletePlayer(ID: String);
begin
end;
destructor TTltManager.Destroy;
var
I : integer;
begin
while FPlayerList.Count >0 do
begin
LogoffPlayer(TPlayer(FPlayerList[0]).ID);
end;
while FTltClients.Count >0 do
begin
RemoveClient(TTltClient(FTltClients[0]));
end;
FPlayerList.Free;
FTltClients.free;
inherited;
end;
procedure TTltManager.DoBeforeWheel;
var
I : integer;
rltInterpreter : TrltServerInterpreter;
begin
if Level2 = 1 then
begin //
if not FSpecialNum then
Round.WheelResult := GetResult;
FSpecialNum := false;
Level2 := 2;
WheelParams := GetWheelParams(State);
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetWheelParams(WheelParams);
end;
end;
if Level2 = 2 then
begin
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetRound;
end;
end;
//最终核算结果
//拒绝客户端下注
//接收管理端的结果更改,将结果数据发送到客户端
//将正确接收到数据的客户端用户记录在案,如果本局顺利完成,将完成结算
//同步客户端时间
end;
procedure TTltManager.DoBeting;
var
I : integer;
rltInterpreter : TrltServerInterpreter;
WheelParams : TWheelParams;
SendTimeSetting : boolean;
begin
//sent betCountChange
//sent RoundStart
SendTimeSetting := FTimeSettingModified;
if Level2 = 1 then
begin
inc(Round.WheelNo);
if Round.WheelNo>50 then
begin
Round.WheelNo := 1;
inc(Round.No);
Round.Scord.Count := 0;
if PauseOnNewRound then SetRoundState(rsStop);
end;
Round.WheelResult := -1;
Level2 := 2;
//轮子慢速旋转
WheelParams := GetWheelParams(State);
if FTimeSettingModified then UpdateTimeSetting;
if SocketForm <> nil then
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetWheelParams(WheelParams);
if SendTimeSetting then rltInterpreter.CallSetTimeSetting;
end;
Round.Auto := true;
end;
if SocketForm <> nil then
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetRound;
end;
//同步下注时间一次
//下注
//统计下注量
//计算开出结果
//通知客户端
//计算状态变更;
end;
procedure TTltManager.DoScore;
var
I : integer;
rltInterpreter : TrltServerInterpreter;
ColorIndex : integer;
Lost, Win : integer;
BetTotle : integer;
CPlayerBetInfo : TPlayerBetInfo;
begin
if Level2 = 1 then
begin
ColorIndex := GetColorIndex(Round.WheelResult);
for I := 0 to FPlayerList.Count -1 do
begin
with TPlayer(FPlayerList[i]) do
begin
CPlayerBetInfo.PreMoney := Money;
Lost := Bet[btRed] + Bet[btBlack] + Bet[btGreen];
Win := 0;
case ColorIndex of
0 : Win := Bet[btRed]*2;
1 : Win := Bet[btBlack]*2;
2 : Win := Bet[btGreen]*36;
end;
Money := Money - Lost + Win;
Modified := true;
if Lost <> 0 then
begin
CPlayerBetInfo.PlayerID := ID;
CPlayerBetInfo.r := bet[btRed];
CPlayerBetInfo.b := bet[btBlack];
CPlayerBetInfo.g := Bet[btGreen];
CPlayerBetInfo.Settlement := Money;
CPlayerBetInfo.Datetime := now;
CPlayerBetInfo.RoundNo := Round.No;
CPlayerBetInfo.RoundMain := Round.Main;
CPlayerBetInfo.WheelNo := Round.WheelNo;
CPlayerBetInfo.Result := Round.WheelResult;
CPlayerBetInfo.ResultColor := ColorIndex;
DASavePlayerBetInfo(CPlayerBetInfo);
end;
//if Lost - Win <> 0 then DAEditPlayer(TPlayer(FPlayerList[i]));
FillChar(Bet, sizeof(Bet), #0);
rltInterpreter := Client.Interpreter;
rltInterpreter.CallSetPlayerInfo(TPlayer(FPlayerList[i]));
end;
DASavePlayer(TPlayer(FPlayerList[i]));
end;
BetTotle := BetCount[btRed] + BetCount[btBlack] + BetCount[btGreen];
FTotalValue :=FTotalValue + BetTotle;
case ColorIndex of
0 : dec(FTotalValue, BetCount[btRed]*2);
1 : dec(FTotalValue, BetCount[btBlack]*2);
2 : dec(FTotalValue, BetCount[btGreen]*36);
end;
//利润期望
FObjectValue := (BetTotle) * FRate div 100 + FObjectValue;
Round.Scord.Number[Round.WheelNo] := Round.WheelResult;
Round.Scord.Count := Round.WheelNo;
RoundScords[Round.No] := Round.Scord;
RoundScordInfosArray[Round.No].RoundMain := Round.No;
RoundScordInfosArray[Round.No].WheelCount := Round.WheelNo;
RoundScordInfosArray[Round.No].WheelInfos[Round.WheelNo].RoundID := Round.No;
RoundScordInfosArray[Round.No].WheelInfos[Round.WheelNo].WheelID := Round.WheelNo;
RoundScordInfosArray[Round.No].WheelInfos[Round.WheelNo].RedBet := BetCount[btRed];
RoundScordInfosArray[Round.No].WheelInfos[Round.WheelNo].BlackBet := BetCount[btBlack];
RoundScordInfosArray[Round.No].WheelInfos[Round.WheelNo].GreenBet := BetCount[btGreen];
RoundScordInfosArray[Round.No].WheelInfos[Round.WheelNo].Result := Round.WheelResult;
RoundScordInfosArray[Round.No].WheelInfos[Round.WheelNo].ResultColor := ColorIndex;
RoundScordInfosArray[Round.No].WheelInfos[Round.WheelNo].Settment := TotalValue;
RoundScordInfosArray[Round.No].WheelInfos[Round.WheelNo].DateTime := Now;
RoundScordInfosArray[Round.No].WheelInfos[Round.WheelNo].AutoValue := Round.Auto;
DASaveRoundScordInfo(RoundScordInfosArray[Round.No].WheelInfos[Round.WheelNo]);
WheelParams := GetWheelParams(State);
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetWheelParams(WheelParams);
end;
Level2 := 2;
end;
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetRound;
end;
//统计,结算分值
//记录到数据库
//改变记录到管理端
//改变各个客户端玩家的分数
end;
procedure TTltManager.DoTimer(Sender: TObject);
var
I : integer;
rltInterpreter : TrltServerInterpreter;
begin
//状态机入口
//更新当前时间
//检测时间有效性(忽略)
//改变游戏全局数据
//更新客户端数据
{ FCountDown := (FTickCount - GetTickCount) div 1000;
if (CountDown>=0) and (CountDown<=FBetTimeSet) then
begin
DoBeting;
end else
if (CountDown>FBetTimeSet) and (CountDown<= FBeforeWheelTimeSet) then
begin
DoBeforeWheel;
end else
if (CountDown>FBeforeWheelTimeSet) and (CountDown<= FWheelingTimeSet) then
begin
DoWheeling;
end else
if (CountDown>FWheelingTimeSet) and (CountDown<= FWheelEndSet) then
begin
DoScore;
end;
if (CountDown> FWheelEndSet) then
begin
DoWheelEnd;
end;
}
// UpdateCountDown;
Update;
{ for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetCountDown;
end;}
end;
procedure TTltManager.DoWheelEnd;
var
I : integer;
rltInterpreter : TrltServerInterpreter;
begin
if FPauseAtRoundEnd then SetRoundState(rsStop)
else InitRound;
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetRound;
end;
// 重置局状态
// CountDown
end;
procedure TTltManager.DoWheeling;
var
I : integer;
rltInterpreter : TrltServerInterpreter;
begin
if Level2 = 1 then
begin
WheelParams := GetWheelParams(State);
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetWheelParams(WheelParams);
end;
Level2 := 2;
end;
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetRound;
end;
//提示客户端进入轮盘显示
//等待客户端完成轮盘旋转
end;
function TTltManager.GetBetCount: TBatArray;
begin
end;
function TTltManager.GetCountDown: integer;
begin
Result := Round.CountDown;
end;
function TTltManager.GetOpenNumber: integer;
begin
Result := Round.WheelResult;
end;
function TTltManager.GetPlayerByID(PlayerID: String): TPlayer;
var
I : integer;
Player : TPlayer;
begin
Result := nil;
for I := 0 to FPlayerList.Count -1 do
begin
Player := TPlayer(FPlayerList[i]);
if PlayerID = Player.ID then
begin
Result := Player;
Exit;
end;
end;
end;
function TTltManager.GetClientByPlayer(Player : TPlayer) : TTltClient;
var
I : integer;
Client : TTltClient;
begin
Result := nil;
for I := 0 to FPlayerList.Count -1 do
begin
Client := TTltClient(FTltClients[i]);
if Client.HasPlayer(Player) then
begin
Result := Client;
Exit;
end;
end;
end;
function TTltManager.GetState: TRoundState;
begin
Result := Round.State;
end;
function TTltManager.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 TTltManager.InitRound;
begin
FPauseAtRoundEnd := false;
FTickCount := GetTickCount;
FWheelStartTickCount := FTickCount;
FillChar(FFlag, sizeof(FFlag), #0);
Round.CountDown := FCountDown;
Round.State := rsBeting;
Round.Main := FRoundMain;
if FTimeSettingModified then UpdateTimeSetting;
end;
function TTltManager.LoginPlayer(APlayer: TPlayer): boolean;
var
Player : TPlayer;
I, Index : integer;
begin
I := 0;
while I < FPlayerList.Count do
begin
if TPlayer(FPlayerList[i]).ID = APlayer.ID then
begin
LogoffPlayer(APlayer.ID);
end else inc(I);
end;
FPlayerList.Add(APlayer);
APlayer.State := psActive;
APlayer.Modified := true;
end;
function TTltManager.LoginPlayer(PlayerID, Password: String; AClient: TtltClient): boolean;
var
Player : TPlayer;
Index : integer;
begin
Result := false;
Player := TPlayer.Create;
try
Player.ID := PlayerID;
if not DALoadPlayer(Player) then
begin
Result := false;
Exit;
end;
if Password = Player.Password then
begin
Result := true;
AClient.AddPlayer(Player);
LoginPlayer(Player);
end;
finally
if not Result then Player.Free;
end;
end;
procedure TTltManager.LogoffPlayer(PlayerID: String);
var
Player : TPlayer;
begin
Player := GetPlayerByID(PlayerID);
if Player<>nil then
begin
FPlayerList.Remove(Player);
Player.Client.RemovePlayer(Player);
DASavePlayer(Player);
Player.Free;
end;
end;
function TTltManager.GetRandomNumByColor(ColorIndex : integer): integer;
const Nums : array[0..36] of integer =( 1, 3,5,7,9,12,14,16,18,19,21,23,25,27,30,32,34,36,
2,4,6,8,10,11,13,15,17,20,22,24,26,28,29,31,33,35,0);
begin
Result := -1;
case ColorIndex of
0:begin
Result := Nums[random(16)];
end;
1:begin
Result := Nums[random(16)+16];
end;
2:begin
Result := 0;
end;
end;
end;
function TTltManager.NextState: TRoundState;
begin
with Round do
case State of
rsPaused:
begin
State := rsBeting;
end;
rsDemo:
begin
State := rsBeting;
end;
rsBeting:
begin
State := rsBeforeWheel;
end;
rsBeforeWheel:
begin
State := rsWheeling;
end;
rsWheeling:
begin
State := rsScore;
end;
rsScore:
begin
State := rsBeting;
InitRound;
end;
end;
Level2 :=1;
end;
procedure TTltManager.RemoveClient(Client: TTltClient);
begin
if not Assigned(Client) then Exit;
while Client.PlayerList.Count>0 do
begin
LogoffPlayer(TPlayer(Client.PlayerList[0]).ID);
end;
FTltClients.Remove(Client);
end;
procedure TTltManager.ResetWheel;
begin
InitRound;
end;
function TTltManager.SetOpenNumber(ANum: integer): integer;
begin
Round.WheelResult := ANum;
end;
procedure TTltManager.StartRound;
begin
end;
procedure TTltManager.Update;
var
NowTime : DWord;
DltTime : DWord;
function ChkTime: boolean;
begin
NowTime := GetTickCount;
DltTime := NowTime - FTickCount;
if DltTime<0 then
begin
DltTime := 1000;
NowTime := 1000;
FTickCount := 0
end;
if DltTime > 20000 then //系统超时,强制重启本轮
begin
ResetWheel;
Result := false;
Exit;
end;
FTickCount := NowTime;
Result := True;
end;
function UpDateState: boolean ;
begin//计算状态变更
with TimeSetting do
begin
if (state = rsBeting) and (Round.CountDown >= BetTimeSet) then NextState
else
if (state = rsBeforeWheel) and (Round.CountDown >= BeforeWheelTimeSet) then NextState
else
if (state = rsWheeling) and (Round.CountDown >= WheelingTimeSet) then NextState
else
if (state = rsScore) and (Round.CountDown >= ScoreTimeSet) then NextState;
end;
end;
const
CRedBet = 0;
CBlackBet = 1;
CGreenBet = 2;
var
I : integer;
begin
if NeedResetPlayerBet then ResetPlayerBet;
with Round do
begin
if not ChkTime then Exit; //检查时间
if State in [rsBeting..rsScore] then
Round.CountDown := (FTickCount - FWheelStartTickCount ) div 1000;
if state = rsBeting then DoBeting;
if State = rsBeforeWheel then DoBeforeWheel;
if State = rsWheeling then DoWheeling;
if State = rsScore then DoScore;
if State = rsStop then DoStop;
if State = rsPaused then DoPaused;
// if State = rsBeginToWait then DoBeginToWait;
UpDateState;
FTickCount := NowTime; //累加时间
end;
//更新下注量
FillChar(BetCount, sizeof(BetCount), #0);
for i := 0 to FPlayerList.Count -1 do
begin
with TPlayer(FPlayerList[i]) do
begin
inc(BetCount[btRed], Bet[btRed]);
inc(BetCount[btBlack], Bet[btBlack]);
inc(BetCount[btGreen], Bet[btGreen]);
end;
end;
//
Log;
// inc
end;
procedure TTltManager.UpdateClients(Proc: TClientProc);
var
I : integer;
rltInterpreter : TrltServerInterpreter;
begin
if Assigned(Proc) then
begin
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallProc(Proc);
end;
end;
end;
procedure TTltManager.UpdateCountDown;
begin
// FWheelCounter := GetTickCount - FWheelStartTickCount]
//inc(FCountDown);
end;
procedure TTltManager.UpdateCounter;
begin
end;
procedure TTltManager.UpdateLogic;
begin
end;
procedure TTltManager.UpdateTimeSetting;
begin
with TimeSetting do
begin
BetTimeSet := FBetTimeSetting;
BeforeWheelTimeSet := BetTimeSet + FBeforeWheelTimeSetting;
WheelingTimeSet := BeforeWheelTimeSet + FWheelingTimeSetting;
ScoreTimeSet := WheelingTimeSet + FScoreTimeSetting;
WheelEndSet := ScoreTimeSet;
end;
end;
procedure TTltManager.Log;
begin
if SocketForm = nil then Exit;
SocketForm.Label8.Caption := Format('r:%d b:%d g:%d r:%d',[BetCount[btRed], BetCount[btBlack], BetCount[btGreen], Round.WheelResult]);
SocketForm.Label9.Caption := Format('值:%d 期望:%d ',[FTotalValue, FObjectValue]);
SocketForm.Label10.Caption := Format('User:%d ',[FPlayerList.Count]);
end;
function TTltManager.GetResult: integer;
var
BetTotle : longint;
DT : longint;
NewObjectValue : longint;
ColorIndex : integer;
ExpectedValue :array[TBetType] of longint;
Power : array[TBetType] of longint;
TotalPower : longint;
// Mul : int64;
function GetPowerRandom(v1,v2,v3 : integer):integer;//0..2
var
tt : integer;
v : integer;
// dt : integer;
begin
if v1<0 then v1 :=0;
if v2<0 then v2 :=0;
if v3<0 then v3 :=0;
tt := v1 + v2 + v3;
if tt <>0 then
begin//带权随机
v := Random(tt);
if v< v1 then Result := 0;
if (v>=v1) and(v=v1+v2) then Result :=2;
end else
begin
v := Random(37); //正常随机
Result := GetColorIndex(v);
end;
end;
begin
//计算结果
//1下注量
FillChar(Power, sizeOf(Power), #0);
BetTotle := BetCount[btRed] + BetCount[btBlack] + BetCount[btGreen];
//利润期望
NewObjectValue := (BetTotle) * FRate div 100 + FObjectValue;
//（理想利润）
DT := NewObjectValue - FTotalValue ;
//DT 差额；
;
//单次可能利润；
ExpectedValue[btRed] := - BetCount[btRed] + BetCount[btBlack] + BetCount[btGreen];
ExpectedValue[btBlack] := BetCount[btRed] - BetCount[btBlack] + BetCount[btGreen];
ExpectedValue[btGreen] := BetCount[btRed] + BetCount[btBlack] - BetCount[btGreen] * 35;
//与预期利润的差距，
//
if (ExpectedValue[btRed]>=0) or (ExpectedValue[btRed] - DT>0) then
Power[btRed] := 18;
if (ExpectedValue[btBlack]>=0) or (ExpectedValue[btBlack] - DT>=0) then
Power[btBlack] := 18;
if (ExpectedValue[btGreen]>=0) or (ExpectedValue[btGreen] - DT>=0) then
Power[btGreen] := 1;
//越接近预期利润差，概率越大
ExpectedValue[btRed] := ExpectedValue[btRed] - DT; //0 10
ExpectedValue[btBlack] := ExpectedValue[btBlack] - DT; //-10 10
ExpectedValue[btGreen] := ExpectedValue[btGreen] - DT; //1000 350
if (abs(ExpectedValue[btRed])abs(ExpectedValue[btGreen])) then
Power[btGreen] := Power[btGreen] * 2 //如果绿色最小
else if (abs(ExpectedValue[btRed])abs(ExpectedValue[btBlack])) then
begin
if (abs(ExpectedValue[btBlack])>abs(ExpectedValue[btGreen])) then
Power[btGreen] := Power[btGreen] * 2 //如果绿色最小
else if(abs(ExpectedValue[btBlack])= TimeSetting.BeforeWheelTimeSet*1000 then
begin
with Result.Params[0] do
begin
FrameTime := TimeSetting.BetTimeSet ;
TimeDuration := 1;
WheelTheta := FWheelTheta;
WheelA := 0;
BallA := 0;
BallTheta := FBallTheta;
BallHeight := 0;
BallR := 0;
FWheelTheta :=FWheelTheta + TimeDuration * WheelV
+ WheelA * TimeDuration * TimeDuration /2;
FBallTheta := FBallTheta + BallV * TimeDuration
+ BallA * TimeDuration * TimeDuration /2;
end;
with Result.Params[1] do
begin
FrameTime := Result.Params[0].FrameTime + Result.Params[0].TimeDuration;
TimeDuration := TimeSetting.BeforeWheelTimeSet-FrameTime;
WheelTheta := FWheelTheta;
WheelA := 0;
BallA := 0;
WheelV := 0;
BallV := 0;
BallTheta := FBallTheta;
BallHeight := 0;
BallR := 0;
FWheelTheta :=FWheelTheta + TimeDuration * WheelV
+ WheelA * TimeDuration * TimeDuration /2;
FBallTheta := FBallTheta + BallV * TimeDuration
+ BallA * TimeDuration * TimeDuration /2;
end;
FLastWheelParamGetTime := GetTickCount;
end;
end;
rsWheeling:
begin
//初期加速,ball fly out
Result.ParamsCount := 5;
with Result.Params[0] do
begin
FrameTime := TimeSetting.BeforeWheelTimeSet;
TimeDuration := 1;
WheelTheta := FWheelTheta;
WheelA := -1;
BallA := 0.5;
WheelV :=6;//no change
BallV := -6.000;
BallTheta := FBallTheta;
// BallHeight := 1.5;
BallR := 11;
FWheelTheta :=FWheelTheta + TimeDuration * WheelV
+ WheelA * TimeDuration * TimeDuration /2;
FBallTheta := FBallTheta + BallV * TimeDuration
+ BallA * TimeDuration * TimeDuration /2;
end;
//+速 culute to win;
with Result.Params[1] do
begin
FrameTime := Result.Params[0].FrameTime + Result.Params[0].TimeDuration;
TimeDuration := 1;
WheelTheta := FWheelTheta;
WheelA := -1;
BallA := 0.5;
WheelV := Result.Params[0].WheelV + Result.Params[0].WheelA
* Result.Params[0].TimeDuration;
BallV := Result.Params[0].BallV + Result.Params[0].BallA
* Result.Params[0].TimeDuration;
BallTheta := FBallTheta;
BallHeight := 0;
BallR := 11;
FWheelTheta :=FWheelTheta + TimeDuration * WheelV
+ WheelA * TimeDuration * TimeDuration /2;
FBallTheta := FBallTheta + BallV * TimeDuration
+ BallA * TimeDuration * TimeDuration /2;
end;
//--
with Result.Params[2] do
begin
FrameTime := Result.Params[1].FrameTime + Result.Params[1].TimeDuration;
TimeDuration := 1;
WheelTheta := FWheelTheta;
WheelA := -1;
BallA := 0.5;
WheelV := Result.Params[1].WheelV + Result.Params[1].WheelA
* Result.Params[1].TimeDuration;
BallV := Result.Params[1].BallV + Result.Params[1].BallA
* Result.Params[1].TimeDuration;
BallTheta := FBallTheta;
BallHeight := 0;
BallR := 11;
FWheelTheta :=FWheelTheta + TimeDuration * WheelV
+ WheelA * TimeDuration * TimeDuration /2;
FBallTheta := FBallTheta + BallV * TimeDuration
+ BallA * TimeDuration * TimeDuration /2;
end;
//基本匀速
with Result.Params[3] do
begin
FrameTime := Result.Params[2].FrameTime + Result.Params[2].TimeDuration;
TimeDuration := 7;
WheelTheta := FWheelTheta;
WheelV := Result.Params[2].WheelV + Result.Params[2].WheelA
* Result.Params[2].TimeDuration;
BallV := Result.Params[2].BallV + Result.Params[2].BallA
* Result.Params[2].TimeDuration;
BallA := 0.5;
i := 0;
repeat
WheelA := (-NumOfAngle[Round.WheelResult]+2* pi*i - (FWheelTheta- FBallTheta)-(WheelV-BallV)*Result.Params[3].TimeDuration)
/ Result.Params[3].TimeDuration / Result.Params[3].TimeDuration*2 + BallA;
inc(i);
until WheelA>-0.3;
BallTheta := FBallTheta;
BallHeight := 0;
BallR := 11;
FWheelTheta :=FWheelTheta + TimeDuration * WheelV
+ WheelA * TimeDuration * TimeDuration /2;
FBallTheta := FBallTheta + BallV * TimeDuration
+ BallA * TimeDuration * TimeDuration /2;
end;
//结果 ball to stop
with Result.Params[4] do
begin
FrameTime := Result.Params[3].FrameTime + Result.Params[3].TimeDuration;
TimeDuration := 5;
WheelTheta := FWheelTheta;
WheelV := Result.Params[3].WheelV + Result.Params[3].WheelA
* Result.Params[3].TimeDuration;
BallV := WheelV;
WheelA := -WheelV / TimeDuration;
BallA := WheelA;
BallTheta := FWheelTheta + NumOfAngle[Round.WheelResult];
BallHeight := 0;
BallR := 0;
FWheelTheta :=FWheelTheta + TimeDuration * WheelV
+ WheelA * TimeDuration * TimeDuration /2;
FBallTheta := FWheelTheta + NumOfAngle[Round.WheelResult];
end;
end;
rsScore:
begin
Result.ParamsCount := 1;
with Result.Params[0] do
begin
FrameTime := TimeSetting.WheelingTimeSet;
TimeDuration := FScoreTimeSetting ;
WheelTheta := FWheelTheta;
WheelA := 0;
WheelV :=0;//0.1;//no change
BallV := 0;//0.1;
BallTheta := WheelTheta + NumOfAngle[Round.WheelResult];
BallHeight := 0;
BallR := 0;
BallA := 0;
FWheelTheta :=FWheelTheta + TimeDuration * WheelV
+ WheelA * TimeDuration * TimeDuration /2;
FBallTheta := FWheelTheta + NumOfAngle[Round.WheelResult];
end;
end;
rsPaused:
begin
Result.ParamsCount := 1;
with Result.Params[0] do
begin
FrameTime := 0;
TimeDuration := 0;
WheelTheta := FWheelTheta;
WheelA := 0;
WheelV :=0.00;
BallV := 0.00;
BallTheta := FBallTheta;
BallHeight := 0;
BallR := 0;
BallA := 0;
FWheelTheta :=FWheelTheta + TimeDuration * WheelV
+ WheelA * TimeDuration * TimeDuration /2;
FBallTheta := FBallTheta + BallV * TimeDuration
+ BallA * TimeDuration * TimeDuration /2;
end;
end;
end;
end;
procedure TTltManager.UpDateWheelParams;
begin
WheelParams.WheelStartTickCount :=GetTickCount - FWheelStartTickCount;
end;
function TTltManager.DoPlayerEdit(APlayerEditInfo : TPlayerEditInfo): TPlayerEditInfo;
var
CPlayer, DPlayer : TPlayer;
I : integer;
APlayerBetInfo : TPlayerBetInfo;
begin
Result := APlayerEditInfo;
case APlayerEditInfo.EditFlag of
efNewID:Result.PlayerInfo.ID := DAGetNewPlayerID;
efCreatePlayer:
begin
CPlayer := TPlayer.Create;
CPlayer.SetPlayerInfo(APlayerEditInfo.PlayerInfo);
CPlayer.Password := APlayerEditInfo.PlayerInfo.Password;
CPlayer.LastActiveTime := Now;
DACreatePlayer(CPlayer);
CPlayer.Free;
end;
efAddMoney:
begin
APlayerEditInfo.PlayerInfo.money := DAReadPlayer(APlayerEditInfo.PlayerInfo.ID).money
+ APlayerEditInfo.PlayerInfo.money;
APlayerEditInfo.EditFlag := efEditPlayer;
DoPlayerEdit(APlayerEditInfo);
end;
efEditPlayer:
begin
CPlayer := TPlayer.Create;
CPlayer.SetPlayerInfo(APlayerEditInfo.PlayerInfo);
CPlayer.Password := APlayerEditInfo.PlayerInfo.Password;
CPlayer.LastActiveTime := Now;
//有金钱设置变动
//记录日志，并发布变动
FillChar(APlayerBetInfo, Sizeof(APlayerBetInfo), #0);
APlayerBetInfo.PreMoney := DAReadPlayer(CPlayer.ID).money;
if APlayerBetInfo.PreMoney <> CPlayer.Money then
begin
APlayerBetInfo.PlayerID := APlayerEditInfo.PlayerInfo.ID;
APlayerBetInfo.Settlement := APlayerEditInfo.PlayerInfo.money;
APlayerBetInfo.RoundNo := Round.No;
APlayerBetInfo.WheelNo := Round.WheelNo;
APlayerBetInfo.Result := -1;
APlayerBetInfo.ResultColor := 0;
APlayerBetInfo.RoundMain := Round.Main;
DASavePlayerBetInfo(APlayerBetInfo);
end;
DAEditPlayer(CPlayer);
CPlayer.Free;
for I := 0 to FPlayerList.Count -1 do
begin
if TPlayer(FPlayerList[i]).ID = APlayerEditInfo.PlayerInfo.ID then
begin
CPlayer := TPlayer(FPlayerList[i]);
DALoadPlayer(CPlayer);
if (CPlayer.Client<>nil) and
(CPlayer.Client.Interpreter<>nil) then
begin
try
CPlayer.Client.Interpreter.CallSetPlayerInfo(CPlayer);
except
end;
end;
end;
end;
end;
efDeletePlayer:
begin
CPlayer := TPlayer.Create;
CPlayer.SetPlayerInfo(APlayerEditInfo.PlayerInfo);
DADeletePlayer(CPlayer);
CPlayer.Free;
for I := 0 to FPlayerList.Count -1 do
begin
if TPlayer(FPlayerList[i]).ID = APlayerEditInfo.PlayerInfo.ID then
begin
CPlayer := TPlayer(FPlayerList[i]);
LogoffPlayer(CPlayer.ID);
end;
end;
end;
end;
end;
function TTltManager.GetPlayerList(APlayerList: TPlayerList): TPlayerList;
var
I : integer;
begin
FillChar(Result, sizeof(Result), #0);
Result.Flag := APlayerList.Flag;
case APlayerList.Flag of
PLFCountOnly:
begin
Result.PlayerCount := GetPlayerCount;
end;
PLFAllPlayer:
begin
Result.PlayerCount := GetPlayerCount;
Result.Size := Result.PlayerCount * sizeof(tplayerinfo);
GetMem(Result.Data, Result.Size);
DAReadPlayers(Result.Data, 0, Result.PlayerCount);
end;
PLFSelectPlayer:
begin
Result.PlayerCount := APlayerList.PlayerCount;
Result.Size := Result.PlayerCount * sizeof(tplayerinfo);
Result.Data := AllocMem(Result.Size);
for i := 0 to Result.PlayerCount-1 do
begin
Result.Data^[i] := DAReadPlayer(APlayerList.Data^[i].ID);
end;
end;
PLFLastChangePlayer:
begin
Result.PlayerCount := GetPlayerCount;
Result.Size := Result.PlayerCount * sizeof(tplayerinfo);
GetMem(Result.Data, Result.Size);
Result.LastUpdate := APlayerList.LastUpdate;
Result.PlayerCount := DAReadLastChangePlayer(Result.Data, Result.LastUpdate);
Result.Size := Result.PlayerCount * sizeof(tplayerinfo);
end;
PLFRoundLength:
begin
end;
end;
end;
function TTltManager.SetOpenColorIndex(AColorIndex : integer): boolean;
var
Num : integer;
begin
Result := State = rsBeforeWheel;
if not Result then Exit;
Num := GetRandomNumByColor(AColorIndex);
SetOpenNumber(Num);
FSpecialNum := true;
Round.Auto := false;
Level2 := 1;
// DoBeforeWheel;
end;
function TTltManager.GetGameParams: TGameParams;
begin
with Result do
begin
BelTime := FBetTimeSetting;
BeforeWheelTime := FBeforeWheelTimeSetting;
TotalValue := self.TotalValue;//总彩池值；
ObjectValue := self.ObjectValue;//期望
Rate := self.Rate; //提成比,游戏难度
Bleed := self.Bleed; //阀值
end;
end;
function TTltManager.SetGameParams(AGameParams: TGameParams): boolean;
begin
Result := false;
DASaveGameParams(AGameParams);
with AGameParams do
begin
FBetTimeSetting := BelTime;
FBeforeWheelTimeSetting := BeforeWheelTime;
FRoundMain := RoundMain;
// Self.TotalValue := TotalValue;
// Self.ObjectValue := ObjectValue;
self.Rate := Rate;
// self.Bleed := Bleed;
end;
FTimeSettingModified := true;
Result := True;
end;
procedure TTltManager.ResetPlayerBet();
var
I : integer;
rltInterpreter : TrltServerInterpreter;
begin
for I :=0 to FPlayerList.Count-1 do
begin
try
with TPlayer(FPlayerList[i]) do
begin
FillChar(Bet, sizeof(Bet), #0);
rltInterpreter := Client.Interpreter;
rltInterpreter.CallSetPlayerInfo(TPlayer(FPlayerList[i]));
end;
except
end;
end;
NeedResetPlayerBet := false;
end;
function TTltManager.SetRoundState(const Value: TRoundState) : boolean;
begin
Result := true;
if Value <> Round.State then
begin
//如果是切换游戏中的状态，则无效
if (Round.State in [rsBeting..rsScore{分数}])
and (Value in [rsBeting..rsScore{分数}]) then
begin
Result := false;
end else
if Value = rsBeting then
begin
NeedResetPlayerBet := true;
InitRound; //重新开始游戏
end else
if Value = rsPaused then
begin
Round.State := rsPaused;//游戏暂停了；
end else
if Value = rsStop then
begin
// do nothing. not support;
Round.State := rsStop;
end else
if Value = rsPauseAtRoundEnd then
begin
FPauseAtRoundEnd := true;
end else
if Value = rsReset then
begin
NeedResetPlayerBet := true;
ResetRound;
end else
Result := false;
end;
end;
procedure TTltManager.ResetRound;
begin
FillChar(Round, Sizeof(Round), #0);
FillChar(RoundScords, Sizeof(RoundScords), #0);
Round.State := rsPaused;
Round.No := 1;
Round.WheelNo := 0;
Level2 := 1;
end;
procedure TTltManager.DoInit;
var
GameParams : TGameParams;
begin
if DAReadGameParams(GameParams) then
SetGameParams(GameParams);
end;
function TTltManager.GetRoundScordInfo(RoundID: integer): TRoundScordInfos;
var
I : integer;
begin
if (RoundID >0) and (RoundID<=Round.No) then
begin
Result := RoundScordInfosArray[RoundID];
end;
end;
function TTltManager.SetPlayerList(APlayerList: TPlayerList): TPlayerList;
var
CPlayer : TPlayer;
I, J : integer;
begin
Result := APlayerList;
CPlayer := TPlayer.Create;
try
for I :=0 to APlayerList.PlayerCount-1 do
begin
CPlayer.SetPlayerInfo(APlayerList.Data^[I]);
CPlayer.Password := APlayerList.Data^[I].Password;
CPlayer.LastActiveTime := APlayerList.Data^[I].LastActiveTime;
if DAEditPlayer(CPlayer)<0 then
DACreatePlayer(CPlayer);
for J := 0 to FPlayerList.Count -1 do
begin
if TPlayer(FPlayerList[j]).ID = APlayerList.Data^[I].ID then
begin
DALoadPlayer(TPlayer(FPlayerList[J]));
end;
end;
end;
finally
CPlayer.Free;
end;
end;
function TTltManager.GetRoundInfoLog(
var AArrayofRoundInfo: TArrayofRoundInfo): integer;
begin
Result := DAGetRoundInfoLog(AArrayofRoundInfo);
end;
function TTltManager.GetPlayerBetInfoLog(
var AArrayofPlayerBetInfo: TArrayofPlayerBetInfo): integer;
begin
Result := DAGetPlayerBetInfoLog(AArrayofPlayerBetInfo);
end;
function TTltManager.ClearPlayerBetInfoLog: boolean;
begin
Result := DAClearPlayerBetInfoLog;
end;
function TTltManager.ClearRoundInfoLog: boolean;
begin
Result := DAClearRoundInfoLog;
TotalValue := 0;
ObjectValue := 0;
end;
function TTltManager.ClearPlayerList: boolean;
begin
Result := DAClearPlayerList;
end;
procedure TTltManager.DoStop;
var
I : integer;
rltInterpreter : TrltServerInterpreter;
begin
//通知所有以连接终端，服务器已经停止，并注销用户；
for i := 0 to FPlayerList.Count -1 do
begin
LogoffPlayer(TPlayer(FPlayerList[0]).ID);
end;
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetRound;
end;
end;
procedure TTltManager.DoPaused;
var
I : integer;
rltInterpreter : TrltServerInterpreter;
begin
for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
begin
try
rltInterpreter := SocketForm.GetrltInterpreter(I);
rltInterpreter.CallSetRound;
except
end;
end;
end;
function TTltManager.CheckAdmin(Tag :integer; AdminStr: String): boolean;
var
GameParams : TGameParams;
begin
Result := false;
case Tag of
1 : begin
//修改密码
DAReadGameParams(GameParams);
GameParams.AdminStr := AdminStr;
Result := true;
end;
0: begin
//校验密码
DAReadGameParams(GameParams);
Result := Trim(GameParams.AdminStr) = Trim(AdminStr);
end;
end;
end;
{ TPlayer }
constructor TPlayer.Create;
begin
State := psNoBody;
end;
function TPlayer.GetPlayerInfo: TPlayerInfo;
begin
with Result do
begin
ID := Self.ID;
password := Self.Password;
UserName := Self.UserName;
Memo := Self.Memo;
money := Self.Money;
State := Self.State;
Move(self.Bet, Bet, sizeof(bet));
// Password := Self.Password;
end;
end;
procedure TPlayer.SetPlayerInfo(PlayerInfo: TPlayerInfo);
begin
ID := PlayerInfo.ID;
Password := PlayerInfo.password;
Memo := PlayerInfo.Memo;
UserName := PlayerInfo.UserName;
Money := PlayerInfo.money;
State := PlayerInfo.State;
end;
{ TTltClient }
procedure TTltClient.AddPlayer(Player: TPlayer);
begin
if PlayerList.IndexOf(Player)>=0 then Exit;
PlayerList.Add(Player);
Player.Client := Self;
end;
constructor TTltClient.Create(manager : TTltManager);
begin
FManager := manager;
PlayerList := TList.Create;
FManager.AddClient(Self);
end;
destructor TTltClient.Destroy;
begin
FManager.RemoveClient(Self);
PlayerList.Free;
inherited;
end;
function TTltClient.HasPlayer(Player: TPlayer): boolean;
begin
Result := PlayerList.IndexOf(Player) >=0;
end;
procedure TTltClient.RemovePlayer(Player: TPlayer);
begin
PlayerList.Remove(Player);
Interpreter.CallLogout(Player.ID);
end;
initialization
DAUInit();
rltManager := TTltManager.Create(nil);
finalization
rltManager.Free;
DAUFinit;
end.