rltgame.pas

一般的数据库管理系统 uses Classes, SConnectEx, TltConst, ExtCtrls, MMSystem, Types, windows, TltLogic , Sy

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