cmain.pas

传奇的登陆器!也是在网上搜索的!不知道好不好用

    stSelectServer: g_CurrentScene := s_SelectServer;
    stSelectCountry: ;
    stSelectChr: g_CurrentScene := s_SelectChr;
    stNewChr: ;
    stLoading: ;
    stLoginNotice: g_CurrentScene := s_LoginNotice;
    stPlayGame: g_CurrentScene := s_Play;
  end;
  if g_CurrentScene <> s_None then OpenScene();
end;

procedure TfrmCMain.ShowSelectServer();
  function GetStatusColor(nStatus: Integer): TColor;
  begin
    case nStatus of //
      0: Result := clDkGray;
      1: Result := clBlue;
      2: Result := clGreen;
      3: Result := clMaroon;
      4: Result := clRed;
      else begin
          Result := clBlack;
        end;
    end; // case
  end;
var
  I: Integer;
begin
  for I := 0 to g_ServerList.Count - 1 do begin
    case I of //
      0: begin
          ButtonServer1.Caption := g_ServerList.Strings[I];
          ButtonServer1.Font.Color := GetStatusColor(Integer(g_ServerList.Objects[I]));
          ButtonServer1.Visible := True;
        end;
      1: begin
          ButtonServer2.Caption := g_ServerList.Strings[I];
          ButtonServer2.Font.Color := GetStatusColor(Integer(g_ServerList.Objects[I]));
          ButtonServer2.Visible := True;
        end;
      2: begin
          ButtonServer3.Caption := g_ServerList.Strings[I];
          ButtonServer3.Font.Color := GetStatusColor(Integer(g_ServerList.Objects[I]));
          ButtonServer3.Visible := True;
        end;
      3: begin
          ButtonServer4.Caption := g_ServerList.Strings[I];
          ButtonServer4.Font.Color := GetStatusColor(Integer(g_ServerList.Objects[I]));
          ButtonServer4.Visible := True;
        end;
      4: begin
          ButtonServer5.Caption := g_ServerList.Strings[I];
          ButtonServer5.Font.Color := GetStatusColor(Integer(g_ServerList.Objects[I]));
          ButtonServer5.Visible := True;
        end;
      5: begin
          ButtonServer6.Caption := g_ServerList.Strings[I];
          ButtonServer6.Font.Color := GetStatusColor(Integer(g_ServerList.Objects[I]));
          ButtonServer6.Visible := True;
        end;
      6: begin
          ButtonServer7.Caption := g_ServerList.Strings[I];
          ButtonServer7.Font.Color := GetStatusColor(Integer(g_ServerList.Objects[I]));
          ButtonServer7.Visible := True;
        end;
    end;
  end;
  {ButtonServer8.Caption:=m_GameZone.sServerName;
  ButtonServer8.Font.Color:=GetStatusColor(Integer(-1));
  ButtonServer8.Visible:=True;}

end;

procedure TfrmCMain.ActionFailed;
begin

end;

procedure TfrmCMain.CheckSpeedHack(dwTime: LongWord);
begin

end;

procedure TfrmCMain.ClientLoginFail(nFailCode: Integer);
begin
  case nFailCode of
    -1: MessageDlg('密码错误！！', [mbOk]);
    -2: MessageDlg('密码输入错误超过3次，此帐号被暂时锁定，请稍候再登录！', [mbOk]);
    -3: MessageDlg('此帐号已经登录或被异常锁定，请稍候再登录！', [mbOk]);
    -4: MessageDlg('这个帐号访问失败！\请使用其他帐号登录，\或者申请付费注册。', [mbOk]);
    -5: MessageDlg('这个帐号被锁定！', [mbOk]);
    else MessageDlg('此帐号不存在或出现未知错误！！', [mbOk]);
  end;
  EditUserAccount.Enabled := True;
  EditUserPassword.Enabled := True;
  g_boSendLogin := False;
end;

procedure TfrmCMain.ClientGetPasswordOK(DefMsg: TDefaultMessage;
  sData: string);
var
  I: Integer;
  sServerName: string;
  sServerStatus: string;
  nCount: Integer;
begin
  sData := DecodeString(sData);
  //  FrmDlg.DMessageDlg (sBody + '/' + IntToStr(Msg.Series), [mbOk]);
  nCount := _MIN(6, DefMsg.Series);
  g_ServerList.Clear;
  for I := 0 to nCount - 1 do begin
    sData := GetValidStr3(sData, sServerName, ['/']);
    sData := GetValidStr3(sData, sServerStatus, ['/']);
    g_ServerList.AddObject(sServerName, TObject(Str_ToInt(sServerStatus, 0)));
  end;
  g_wAvailIDDay := Loword(DefMsg.Recog);
  g_wAvailIDHour := Hiword(DefMsg.Recog);
  g_wAvailIPDay := DefMsg.Param;
  g_wAvailIPHour := DefMsg.Tag;

  if g_wAvailIDDay > 0 then begin
    if g_wAvailIDDay = 1 then
      MessageDlg('您当前ID费用到今天为止。', [mbOk])
    else if g_wAvailIDDay <= 3 then
      MessageDlg('您当前IP费用还剩 ' + IntToStr(g_wAvailIDDay) + ' 天。', [mbOk]);
  end else if g_wAvailIPDay > 0 then begin
    if g_wAvailIPDay = 1 then
      MessageDlg('您当前IP费用到今天为止。', [mbOk])
    else if g_wAvailIPDay <= 3 then
      MessageDlg('您当前IP费用还剩 ' + IntToStr(g_wAvailIPDay) + ' 天。', [mbOk]);
  end else if g_wAvailIPHour > 0 then begin
    if g_wAvailIPHour <= 100 then
      MessageDlg('您当前IP费用还剩 ' + IntToStr(g_wAvailIPHour) + ' 小时。', [mbOk]);
  end else if g_wAvailIDHour > 0 then begin
    MessageDlg('您当前ID费用还剩 ' + IntToStr(g_wAvailIDHour) + ' 小时。', [mbOk]); ;
  end;
  ChangeScene(stSelectServer);
end;


procedure TfrmCMain.ClientGetMyStatus(DefMsg: TDefaultMessage);
begin

end;

procedure TfrmCMain.ClientGetNewMap(DefMsg: TDefaultMessage; sData: string);
var
  sText: string;
begin
  g_sMapTitle := '';
  sText := DecodeString(sData);
  g_sMapName := sText;
  g_PlayScene.SendMsg(DefMsg.Ident, 0,
    DefMsg.Param {x},
    DefMsg.Tag {y},
    DefMsg.Series {darkness},
    0, 0,
    sText {mapname});
end;
////////////////////////////////////////////////////////////////////////////////
function GetCodeMsgSize(X: Double): Integer;
begin
  if INT(X) < X then Result := TRUNC(X) + 1
  else Result := TRUNC(X)
end;
//////////////////////////////////////////////////////////////////////////////////
function TfrmCMain.GetRGB(c256: Byte): TColor;
begin
  Result := RGB(ColorTable[c256].rgbRed, ColorTable[c256].rgbGreen, ColorTable[c256].rgbBlue);
end;

/////////////////////////////////////////////
procedure TfrmCMain.ClientGetObjTurn(DefMsg: TDefaultMessage;
  sData: string);
var
  sBody2: string;
  sBody: string;
  sColor: string;
  CharDesc: TCharDesc;
  Actor: TActor;
begin
  if Length(sData) > GetCodeMsgSize(sizeof(TCharDesc) * 4 / 3) then begin
    sBody := Copy(sData, GetCodeMsgSize(sizeof(TCharDesc) * 4 / 3) + 1, Length(sData));
    sBody := DecodeString(sBody);
    sColor := GetValidStr3(sBody, sBody, ['/']);
  end else sData := '';
  DecodeBuffer(sData, @CharDesc, sizeof(TCharDesc));
  g_PlayScene.SendMsg(DefMsg.Ident,
    DefMsg.Recog,
    DefMsg.Param {x},
    DefMsg.Tag {y},
    DefMsg.Series {dir + light},
    CharDesc.Feature,
    CharDesc.Status,
    '');
  if sBody <> '' then begin
    Actor := g_PlayScene.FindActor(DefMsg.Recog);
    if Actor <> nil then begin
      Actor.m_sDescUserName := GetValidStr3(sBody, Actor.m_sUserName, ['\']);
      //Actor.UserName := sBody;
      Actor.m_nNameColor := GetRGB(Str_ToInt(sColor, 0));
    end;
  end;
end;

procedure TfrmCMain.ClientGetPasswdSuccess(sData: string);
var
  sText: string;
  sSelChrAddr: string;
  sSelChrPort: string;
  sCertification: string;
begin
  sText := DecodeString(sData);
  sText := GetValidStr3(sText, sSelChrAddr, ['/']);
  sText := GetValidStr3(sText, sSelChrPort, ['/']);
  sText := GetValidStr3(sText, sCertification, ['/']);
  m_nCertification := Str_ToInt(sCertification, 0);

  CSocket.Active := False;
  CSocket.Host := '';
  CSocket.Port := 0;
  WaitAndPass(500); //0.5檬悼救 扁促覆
  g_ConnectionStep := cnsSelChr;
  with CSocket do begin
    g_sSelChrAddr := sSelChrAddr;
    g_nSelChrPort := Str_ToInt(sSelChrPort, 0);
    Address := g_sSelChrAddr;
    Port := g_nSelChrPort;
    Active := True;
  end;

end;

procedure TfrmCMain.ClientGetReceiveChrs(sData: string);
  procedure AddChr(sName: string; nJob, nHair, nLevel, nSex: Integer);
  var
    I: Integer;
  begin
    if not g_ChrArr[0].boValid then I := 0
    else if not g_ChrArr[1].boValid then I := 1
    else Exit;
    g_ChrArr[I].UserChr.sName := sName;
    g_ChrArr[I].UserChr.btJob := nJob;
    g_ChrArr[I].UserChr.btHair := nHair;
    g_ChrArr[I].UserChr.wLevel := nLevel;
    g_ChrArr[I].UserChr.btSex := nSex;
    g_ChrArr[I].boValid := True;
  end;
  function GetJobName(nJob: Integer): string;
  begin
    case nJob of
      0: Result := '武士';
      1: Result := '魔法师';
      2: Result := '道士'
      else Result := '未知';
    end;
  end;
  function GetSexName(nSex: Integer): string;
  begin
    case nSex of
      0: Result := '男';
      1: Result := '女';
      else Result := '未知';
    end;
  end;
var
  I: Integer;
  nSelect: Integer;
  sText: string;
  sName: string;
  sJob: string;
  sHair: string;
  sLevel: string;
  sSex: string;
begin
  FillChar(g_ChrArr, sizeof(g_ChrArr), 0);
  EditSelectChrName1.Text := '';
  EditSelectChrLevel1.Text := '';
  EditSelectChrSex1.Text := '';
  EditSelectChrJob1.Text := '';

  EditSelectChrName2.Text := '';
  EditSelectChrLevel2.Text := '';
  EditSelectChrSex2.Text := '';
  EditSelectChrJob2.Text := '';

  sText := DecodeString(sData);
  for I := Low(g_ChrArr) to High(g_ChrArr) do begin
    sText := GetValidStr3(sText, sName, ['/']);
    sText := GetValidStr3(sText, sJob, ['/']);
    sText := GetValidStr3(sText, sHair, ['/']);
    sText := GetValidStr3(sText, sLevel, ['/']);
    sText := GetValidStr3(sText, sSex, ['/']);
    nSelect := 0;
    if (sName <> '') and (sLevel <> '') and (sSex <> '') then begin
      if sName[1] = '*' then begin
        nSelect := I;
        sName := Copy(sName, 2, Length(sName) - 1);
        EditSelectChrCurChr.Text := sName;
      end;
      AddChr(sName, Str_ToInt(sJob, 0), Str_ToInt(sHair, 0), Str_ToInt(sLevel, 0), Str_ToInt(sSex, 0));
    end;
    if nSelect = 0 then begin
      g_ChrArr[0].boFreezeState := False;
      g_ChrArr[0].boSelected := True;
      g_ChrArr[1].boFreezeState := True;
      g_ChrArr[1].boSelected := False;
    end else begin
      g_ChrArr[0].boFreezeState := True;
      g_ChrArr[0].boSelected := False;
      g_ChrArr[1].boFreezeState := False;
      g_ChrArr[1].boSelected := True;
    end;
  end;
  EditSelectChrName1.Text := g_ChrArr[0].UserChr.sName;
  EditSelectChrLevel1.Text := IntToStr(g_ChrArr[0].UserChr.wLevel);
  EditSelectChrSex1.Text := GetSexName(g_ChrArr[0].UserChr.btSex);
  EditSelectChrJob1.Text := GetJobName(g_ChrArr[0].UserChr.btJob);

  EditSelectChrName2.Text := g_ChrArr[1].UserChr.sName;
  EditSelectChrLevel2.Text := IntToStr(g_ChrArr[1].UserChr.wLevel);
  EditSelectChrSex2.Text := GetSexName(g_ChrArr[1].UserChr.btSex);
  EditSelectChrJob2.Text := GetJobName(g_ChrArr[1].UserChr.btJob);
  ChangeScene(stSelectChr);
end;



procedure TfrmCMain.ClientGetReconnect(sData: string);
begin

end;

procedure TfrmCMain.ClientQueryChrFail(nFailCode: Integer);
begin

end;

procedure TfrmCMain.ClientNewChrFail(nFailCode: Integer);
begin
  case nFailCode of
    0: MessageDlg('[错误信息] 输入的角色名称包含非法字符！ 错误代码 = 0', [mbOk]);
    2: MessageDlg('[错误信息] 创建角色名称已被其他人使用！ 错误代码 = 2', [mbOk]);
    3: MessageDlg('[错误信息] 您只能创建二个游戏角色！ 错误代码 = 3', [mbOk]);
    4: MessageDlg('[错误信息] 创建角色时出现错误！ 错误代码 = 4', [mbOk]);
    else MessageDlg('[错误信息] 创建角色时出现未知错误！', [mbOk]);
  end;
end;

procedure TfrmCMain.ClientNewIDFail(nFailCode: Integer);
begin
  case nFailCode of
    0: begin
        MessageDlg('帐号 "' + m_sMakeNewId + '" 已被其他的玩家使用了。'#13'请选择其它帐号名注册。', [mbOk]);
        ButtonPanelNewAccountOK.Enabled := True;
      end;
    -2: begin
        MessageDlg('此帐号名被禁止使用！', [mbOk]);
        ButtonPanelNewAccountOK.Enabled := True;
      end;
    else begin
        MessageDlg('帐号创建失败，请确认帐号是否包括空格、及非法字符！Code: ' + IntToStr(nFailCode), [mbOk]);
        ButtonPanelNewAccountOK.Enabled := True;
      end;
  end;
end;

procedure TfrmCMain.ClientNewIDSuccess;
begin
  MessageBox(Handle, '您的帐号创建成功。'#13'请妥善保管您的帐号和密码，'#13'并且不要因任何原因把帐号和密码告诉任何其他人。', '确认信息', MB_OK);
  ChangeScene(stLogin);
end;

procedure TfrmCMain.ClientObjDigDown(DefMsg: TDefaultMessage);
begin
  g_PlayScene.SendMsg(DefMsg.Ident, DefMsg.Recog, DefMsg.Param {x}, DefMsg.Tag {y}, 0, 0, 0, '');
end;

procedure TfrmCMain.ClientObjDigup(DefMsg: TDefaultMessage; sData: string);
var
  MsgWL: TMessageBodyWL;
  Actor: TActor;
begin
  DecodeBuffer(sData, @MsgWL, sizeof(TMessageBodyWL));
  Actor := g_PlayScene.FindActor(DefMsg.Recog);
  if Actor = nil then
    Actor := g_PlayScene.NewActor(DefMsg.Recog, DefMsg.Param, DefMsg.Tag, DefMsg.Series, MsgWL.lParam1, MsgWL.lParam2);
  Actor.m_nCur