cmain.pas

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

    procedure ClientGetUpdateItem(sData: string);
    procedure ClientGetDelItem(sData: string);
    procedure ClientGetDelItems(sData: string);
    procedure ClientDelDropItem(nItemID: Integer; sData: string);
    procedure ClientGetDropItemFail(nItemID: Integer; sData: string);
    procedure ClientGetShowItem(nItemID, nX, nY, nLooks: Integer; sItemName: string);
    procedure ClientGetHideItem(nItemID, nX, nY: Integer);
    procedure ClientGetTakeOnOK(nItemID: Integer);
    procedure ClientGetTakeOnFail();
    procedure ClientGetTakeOffOK(nItemID: Integer);
    procedure ClientGetTakeOffFail();
    procedure ClientGetSenduseItems(sData: string);
    procedure ClientGetWeightChanged(DefMsg: TDefaultMessage);
    procedure ClientGetGoldChanged(DefMsg: TDefaultMessage);
    procedure ClientGetFeatureChange(DefMsg: TDefaultMessage);
    procedure ClientGetCharStatusChange(DefMsg: TDefaultMessage);
    procedure ClientGetClearObjects();
    procedure ClientGetEatItemOK();
    procedure ClientGetEatItemFail();
    procedure ClientGetAddMagic(sData: string);
    procedure ClientGetMyMagics(sData: string);
    procedure ClientGetDelMagic(nMagicID: Integer);
    procedure ClientGetMagicLevelUp(DefMsg: TDefaultMessage);
    procedure ClientGetDuraChange(DefMsg: TDefaultMessage);
    procedure ClientGetMerchantSay(DefMsg: TDefaultMessage; sData: string);
    procedure ClientGetMerchantClose();
    procedure ClientGetSendGoodsList(DefMsg: TDefaultMessage; sData: string);
    procedure ClientGetSendMakeDrugList(DefMsg: TDefaultMessage; sData: string);
    procedure ClientGetSendUserSell(nMerchant: Integer);
    procedure ClientGetSendUserRepair(nMerchant: Integer);
    procedure ClientGetBuyPrice(DefMsg: TDefaultMessage);
    procedure ClientGetUserSellItemOK();
    procedure ClientGetRepairCost(DefMsg: TDefaultMessage);

    procedure SendLogin(sAccount, sPassWord: string);
    procedure SendQueryChr();
    procedure SendSocket(sSendMsg: string);
    procedure SendClientMessage(nIdent, nRecog, nParam, nTag, nSeries: Integer);
    procedure SendSelectServer(sServerName: string);
    procedure SendSelChr(sChrName: string);
    procedure SendDelChr(sChrName: string);
    procedure SendRunLogin();
    procedure SendSay(sMsg: string);

    procedure Run();
    procedure ClearBag();
    procedure ClearChatBoard();
    function IsGroupMember(sName: string): BOOL;
    procedure ChangeServerClearGameVariables();
    procedure AddChatBoardString(sMsg: string; nFColor, nBColor: Integer);
    procedure AddGuildChat(sMsg: string);
    function AddItemBag(ClientItem: TClientItem): BOOL;
    procedure ArrangeItembag();
    procedure MakeNewChar(nIndex: Integer);
    procedure SelectChrCreateNewChr();
    procedure SendNewChr(sAccount, sChrName, sHair, sJob, sSex: string);
    function CheckUserEntrys: Boolean;
    function NewIdCheckBirthDay: Boolean;
    procedure SendNewAccount(ue: TUserEntry; ua: TUserEntryAdd);
    { Private declarations }
  public

    m_boClose: BOOL;
    m_dwCloseTick: LongWord;

    procedure CreateParams(var Params: TCreateParams); override;
    procedure Open();
    { Public declarations }
  end;


var
  frmCMain: TfrmCMain;

implementation

uses Main, CLogin, HUtil32, EDecode;
{$R *.dfm}

{ TfrmCMain }
procedure TfrmCMain.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.WndParent := 0;
end;

procedure TfrmCMain.Open;
begin
  Caption := m_SelGameZone.sServerName;
  m_dwOpenTick := GetTickCount();
  m_dwMinTick := GetTickCount();
  m_boOpened := False;
  m_boAutoLogin := True;
  m_nAutoChr := 0;
  TimerMain.Enabled := True;
  //Flash.Movie := FalshUrl;
  //Flash.Play;
  Show();
end;

procedure TfrmCMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := cafree;
  m_boClose := True;
  m_dwCloseTick := GetTickCount();
  CSocket.Close;
end;

procedure TfrmCMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if MessageBox(Handle, '是否确认退出?', '确认信息', MB_YESNO + MB_ICONQUESTION) <> ID_YES then begin
    CanClose := False;
    Exit;
  end;
  Application.Restore;
  Application.RestoreTopMosts;
end;

procedure TfrmCMain.FormCreate(Sender: TObject);
begin
  m_boTimerMainBusy := False;
  m_boChatAutoScroll := True;

  g_ConnectionStep := cnsLogin;
  g_CurrentScene := s_None;
  g_boSendLogin := False;
  g_boServerConnected := False;
  m_sSockText := '';
  m_sBufferText := '';
  g_ServerList := TStringList.Create;
  g_PlayScene := TPlayScene.Create;
  m_CharMsgList := TStringList.Create;
  m_CharBkColorList := TList.Create;
  g_ChangeFaceReadyList := TList.Create;
  m_GuildChatMsgList := TStringList.Create;
  g_FreeActorList := TList.Create;

  g_MagicList := TList.Create;
end;

procedure TfrmCMain.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  g_ServerList.Free;
  g_PlayScene.Free;
  m_CharMsgList.Free;
  m_CharBkColorList.Free;
  m_GuildChatMsgList.Free;
  g_FreeActorList.Free;
  for I := 0 to g_MagicList.Count - 1 do begin
    Dispose(pTClientMagic(g_MagicList.Items[I]));
  end;
  g_MagicList.Free;
end;

procedure TfrmCMain.SetTopOrder(Control: TControl);
var
  I: Integer;
  WinControl: TControl;
  TempControl: TControl;
begin
  for I := 0 to ControlCount - 1 do begin
    WinControl := Controls[I];
    if WinControl = Control then begin
      RemoveControl(WinControl);
      InsertControl(WinControl);
      break;
    end;
  end;
end;

procedure TfrmCMain.TimerMainTimer(Sender: TObject);
var
  sData: string;
begin
  m_boTimerMainBusy := True;
  try
    if (not m_boOpened) and (GetTickCount - m_dwOpenTick > 500) then begin
      m_boOpened := True;
      if m_SelGameZone.sGameIPaddr = '' then begin
        CSocket.Host := '127.0.0.1';
      end else begin
        CSocket.Host := m_SelGameZone.sGameIPaddr;
      end;
      CSocket.Port := m_SelGameZone.nGameIPPort;
      CSocket.Active := True;
    end;
    m_sBufferText := m_sBufferText + m_sSockText;
    m_sSockText := '';
    if m_sBufferText <> '' then begin
      while Length(m_sBufferText) >= 2 do begin
        if g_boMapMovingWait then break;
        if Pos('!', m_sBufferText) <= 0 then break;
        m_sBufferText := ArrestStringEx(m_sBufferText, '#', '!', sData);
        if sData = '' then break;
        DecodeMessagePacket(sData);
      end;
    end;
    Run();
  finally
    m_boTimerMainBusy := False;
  end;
end;
procedure TfrmCMain.ActiveCmdTimer(Cmd: TTimerCommand);
begin
  CmdTimer.Enabled := True;
  m_TimerCmd := Cmd;
end;

procedure TfrmCMain.CmdTimerTimer(Sender: TObject);
var
  I: Integer;
begin
  if Sender = CmdTimer then begin

  end else
    if Sender = SelChrWaitTimer then begin
    SelChrWaitTimer.Enabled := False;
    SendQueryChr;
  end else
    if Sender = WaitMsgTimer then begin
    if g_PlayScene.m_MySelf = nil then Exit;
    if g_PlayScene.m_MySelf.ActionFinished then begin
      WaitMsgTimer.Enabled := False;
      case g_WaitingMsg.Ident of
        SM_CHANGEMAP: begin
            g_boMapMovingWait := False;
            g_boMapMoving := False;

            //ClearDropItems;
            //g_PlayScene.CleanObjects;
            g_sMapTitle := '';
            g_PlayScene.m_MySelf.CleanCharMapSetting(g_WaitingMsg.Param, g_WaitingMsg.Tag);
            g_PlayScene.SendMsg(SM_CHANGEMAP, 0,
              g_WaitingMsg.Param {x},
              g_WaitingMsg.Tag {y},
              g_WaitingMsg.Series {darkness},
              0, 0,
              g_sWaitingStr {mapname});
            g_nTargetX := -1;
            g_PlayScene.m_TargetCret := nil;
            g_PlayScene.m_FocusCret := nil;
          end;
      end;
    end;
  end else
    if Sender = MinTimer then begin
    if GetTickCount - m_dwMinTick >= 1000 then begin
      m_dwMinTick := GetTickCount();
      for I := 0 to g_PlayScene.m_ActorList.Count - 1 do begin
        if IsGroupMember(TActor(g_PlayScene.m_ActorList[I]).m_sUserName) then begin
          TActor(g_PlayScene.m_ActorList[I]).m_boGrouped := True;
        end else begin
          TActor(g_PlayScene.m_ActorList[I]).m_boGrouped := False;
        end;
      end;
      for I := g_FreeActorList.Count - 1 downto 0 do begin
        if GetTickCount - TActor(g_FreeActorList[I]).m_dwDeleteTime > 60 * 1000 then begin
          TActor(g_FreeActorList[I]).Free;
          g_FreeActorList.Delete(I);
        end;
      end;
    end;
  end;
end;
procedure TfrmCMain.WaitAndPass(dwMsec: LongWord);
var
  dwStartTick: LongWord;
begin
  dwStartTick := GetTickCount;
  while GetTickCount - dwStartTick < dwMsec do begin
    Application.ProcessMessages;
  end;
end;

procedure TfrmCMain.ProcessMsg(Msg: Pointer);
begin

end;

procedure TfrmCMain.MENU_CONTROL_EXITClick(Sender: TObject);
begin
  if Sender = MENU_CONTROL_EXIT then begin
    Close;
  end;

end;
procedure TfrmCMain.ListBoxActorDblClick(Sender: TObject);
var
  nIndex: Integer;
begin
  nIndex := ListBoxActor.ItemIndex;
  if (nIndex >= 0) and (nIndex < ListBoxActor.Items.Count) then begin
    EditChat.Text := '/' + ListBoxActor.Items.Strings[nIndex] + ' ';
  end;

end;


procedure TfrmCMain.ListBoxActorDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  nIdx: Integer;
  Actor: TActor;
  Color: TColor;
  FColor: TColor;
  BColor: TColor;
begin
  if Control = ListBoxActor then begin
    ListBoxActor.Canvas.FillRect(Rect);
    Actor := TActor(ListBoxActor.Items.Objects[Index]);
    case Actor.m_btRace of //
      RCC_USERHUMAN: Color := clGreen;
      RCC_MERCHANT: Color := clBlue;
      RCC_GUARD: Color := clYellow;
      else Color := clRed;
    end;
    ListBoxActor.Canvas.Font.Color := Color;
    ListBoxActor.Canvas.TextOut(Rect.Left + 5, Rect.top + ((Rect.Bottom - Rect.top) - ListBoxActor.Canvas.TextHeight('A')) div 2, ListBoxActor.Items[Index]);
  end else
    if Control = ListBoxChat then begin
    ListBoxChat.Canvas.FillRect(Rect);
    FColor := TColor(ListBoxChat.Items.Objects[Index]);
    BColor := TColor(m_CharBkColorList.Items[Index]);
    ListBoxChat.Canvas.Font.Color := FColor;
    ListBoxChat.Canvas.Brush.Color := BColor;
    ListBoxChat.Canvas.TextOut(Rect.Left + 5, Rect.top + ((Rect.Bottom - Rect.top) - ListBoxChat.Canvas.TextHeight('A')) div 2, ListBoxChat.Items[Index]);
  end;
end;


procedure TfrmCMain.ListBoxChatDblClick(Sender: TObject);
var
  sLineText: string;
  nPos: Integer;
  nIndex: Integer;
begin
  nIndex := ListBoxChat.ItemIndex;
  if (nIndex < 0) or (nIndex >= ListBoxChat.Items.Count) then Exit;
  sLineText := ListBoxChat.Items.Strings[nIndex];
  EditChat.Text := sLineText;
end;

procedure TfrmCMain.ListBoxChatClick(Sender: TObject);
var
  sLineText: string;
  nPos: Integer;
  nIndex: Integer;
begin
  nIndex := ListBoxChat.ItemIndex;
  if (nIndex < 0) or (nIndex >= ListBoxChat.Items.Count) then Exit;

  sLineText := ListBoxChat.Items.Strings[nIndex];
  if sLineText = '' then Exit;
  nPos := Pos(':', sLineText);
  if nPos > 0 then begin
    sLineText := Copy(sLineText, 1, nPos - 1);
    nPos := Pos(')', sLineText);
    if nPos > 0 then begin
      sLineText := Copy(sLineText, nPos + 1, Length(sLineText) - nPos);
    end;
    EditChat.Text := '/' + sLineText + ' ';
  end else begin
    EditChat.Text := sLineText;
  end;
end;

procedure TfrmCMain.CSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar.Panels[0].Text := '服务器连接成功...';
  g_boServerConnected := True;
  if g_ConnectionStep = cnsLogin then begin
    ChangeScene(stLogin);
  end;
  if g_ConnectionStep = cnsSelChr then begin
    SelChrWaitTimer.Enabled := True;
  end;
  if g_ConnectionStep = cnsPlay then begin
    if not g_boServerChanging then begin
      ClearBag;
      ClearChatBoard;
      ChangeScene(stLoginNotice);
    end else begin
      ChangeServerClearGameVariables;
    end;
    SendRunLogin;