GameOfMir

**hujiacheng** · 10-12-07

About.pas
unit About;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TFormAbout = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
var
FormAbout: TFormAbout;
implementation
{$R *.dfm}
end.

**MentaL**

**hujiacheng** · 10-12-07

AboutUnit.pas
unit AboutUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TFrmAbout = class(TForm)
ButtonOK: TButton;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
GroupBox2: TGroupBox;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
EditProductName: TEdit;
EditVersion: TEdit;
EditUpDateTime: TEdit;
EditProgram: TEdit;
EditWebSite: TEdit;
EditBbsSite: TEdit;
procedure ButtonOKClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure Open();
end;

var
FrmAbout: TFrmAbout;

implementation
uses EncryptUnit, M2Share, Common;
{$R *.dfm}
procedure TFrmAbout.Open();
const
nUseKey = 240621028;
begin
EditProductName.Text := DecodeString_3des(g_sProductName, IntToStr(nUseKey));
EditVersion.Text := Format(DecodeString_3des(g_sVersion, IntToStr(nUseKey)), [0]);
EditUpDateTime.Text := DecodeString_3des(g_sUpDateTime, IntToStr(nUseKey));
EditProgram.Text := DecodeString_3des(g_sProgram, IntToStr(nUseKey));
EditWebSite.Text := DecodeString_3des(g_sWebSite, IntToStr(nUseKey));
EditBbsSite.Text := DecodeString_3des(g_sBbsSite, IntToStr(nUseKey));
ShowModal;
end;

procedure TFrmAbout.ButtonOKClick(Sender: TObject);
begin
Close;
end;

end.

**hujiacheng** · 10-12-07

ActionSpeedConfig.pas
unit ActionSpeedConfig;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin;

type
TfrmActionSpeed = class(TForm)
GroupBox1: TGroupBox;
GroupBox3: TGroupBox;
Label15: TLabel;
EditRunLongHitIntervalTime: TSpinEdit;
GroupBox2: TGroupBox;
Label2: TLabel;
EditActionIntervalTime: TSpinEdit;
CheckBoxControlActionInterval: TCheckBox;
CheckBoxControlRunLongHit: TCheckBox;
GroupBox4: TGroupBox;
Label1: TLabel;
EditRunHitIntervalTime: TSpinEdit;
CheckBoxControlRunHit: TCheckBox;
GroupBox5: TGroupBox;
Label3: TLabel;
EditWalkHitIntervalTime: TSpinEdit;
CheckBoxControlWalkHit: TCheckBox;
ButtonSave: TButton;
ButtonDefault: TButton;
ButtonClose: TButton;
CheckBoxIncremeng: TCheckBox;
GroupBox6: TGroupBox;
Label4: TLabel;
EditRunMagicIntervalTime: TSpinEdit;
CheckBoxControlRunMagic: TCheckBox;
Label5: TLabel;
procedure ButtonCloseClick(Sender: TObject);
procedure ButtonDefaultClick(Sender: TObject);
procedure ButtonSaveClick(Sender: TObject);
procedure CheckBoxControlActionIntervalClick(Sender: TObject);
procedure EditActionIntervalTimeChange(Sender: TObject);
procedure CheckBoxControlRunLongHitClick(Sender: TObject);
procedure EditRunLongHitIntervalTimeChange(Sender: TObject);
procedure CheckBoxControlRunHitClick(Sender: TObject);
procedure EditRunHitIntervalTimeChange(Sender: TObject);
procedure CheckBoxControlWalkHitClick(Sender: TObject);
procedure EditWalkHitIntervalTimeChange(Sender: TObject);
procedure CheckBoxIncremengClick(Sender: TObject);
procedure CheckBoxControlRunMagicClick(Sender: TObject);
procedure EditRunMagicIntervalTimeChange(Sender: TObject);
private
{ Private declarations }
boOpened: Boolean;
boModValued: Boolean;
procedure ModValue();
procedure uModValue();
procedure SaveConfig();
procedure RefSpeedConfig();
public
procedure Open();
{ Public declarations }
end;

var
frmActionSpeed: TfrmActionSpeed;

implementation

uses SDK, M2Share;

{$R *.dfm}

{ TfrmActionSpeed }

procedure TfrmActionSpeed.ModValue;
begin
boModValued := True;
ButtonSave.Enabled := True;

end;

procedure TfrmActionSpeed.uModValue;
begin
boModValued := False;
ButtonSave.Enabled := False;
end;

procedure TfrmActionSpeed.Open;
begin
boOpened := False;
uModValue();
RefSpeedConfig();

boOpened := True;
ShowModal;
end;

procedure TfrmActionSpeed.ButtonCloseClick(Sender: TObject);
resourcestring
sExitMsg = '设置已被修改是否不保存设置退出？';
sExitMsgTitle = '确认信息';
begin
if not boModValued then begin
Close;
exit;
end;
if (MessageBox(Handle, PChar(sExitMsg), PChar(sExitMsgTitle), MB_YESNO + MB_ICONQUESTION) = IDYES) then begin
Close;
end;
end;

procedure TfrmActionSpeed.RefSpeedConfig;
begin
EditActionIntervalTime.Value := g_Config.dwActionIntervalTime;
EditRunLongHitIntervalTime.Value := g_Config.dwRunLongHitIntervalTime;
EditRunHitIntervalTime.Value := g_Config.dwRunHitIntervalTime;
EditWalkHitIntervalTime.Value := g_Config.dwWalkHitIntervalTime;
EditRunMagicIntervalTime.Value := g_Config.dwRunMagicIntervalTime;
CheckBoxControlActionInterval.Checked := g_Config.boControlActionInterval;
CheckBoxControlRunLongHit.Checked := g_Config.boControlRunLongHit;
CheckBoxControlRunHit.Checked := g_Config.boControlRunHit;
CheckBoxControlWalkHit.Checked := g_Config.boControlWalkHit;
CheckBoxControlRunMagic.Checked := g_Config.boControlRunMagic;
end;

procedure TfrmActionSpeed.ButtonDefaultClick(Sender: TObject);
resourcestring
sExitMsg = '是否确认恢复默认设置？';
sExitMsgTitle = '确认信息';
begin
if Application.MessageBox(PChar(sExitMsg), PChar(sExitMsgTitle), MB_YESNO + MB_ICONQUESTION) <> IDYES then begin
exit;
end;
boOpened := False;
ModValue();
g_Config.dwActionIntervalTime := 400;
g_Config.dwRunLongHitIntervalTime := 800;
g_Config.dwRunHitIntervalTime := 800;
g_Config.dwWalkHitIntervalTime := 800;
g_Config.dwRunMagicIntervalTime := 900;
g_Config.boControlActionInterval := True;
g_Config.boControlRunLongHit := True;
g_Config.boControlRunHit := True;
g_Config.boControlWalkHit := True;
g_Config.boControlRunMagic := True;

RefSpeedConfig();
boOpened := True;
end;

procedure TfrmActionSpeed.SaveConfig;
begin
Config.WriteBool('Setup', 'ControlActionInterval', g_Config.boControlActionInterval);
Config.WriteBool('Setup', 'ControlWalkHit', g_Config.boControlWalkHit);
Config.WriteBool('Setup', 'ControlRunLongHit', g_Config.boControlRunLongHit);
Config.WriteBool('Setup', 'ControlRunHit', g_Config.boControlRunHit);
Config.WriteBool('Setup', 'ControlRunMagic', g_Config.boControlRunMagic);

Config.WriteInteger('Setup', 'ActionIntervalTime', g_Config.dwActionIntervalTime);
Config.WriteInteger('Setup', 'RunLongHitIntervalTime', g_Config.dwRunLongHitIntervalTime);
Config.WriteInteger('Setup', 'RunHitIntervalTime', g_Config.dwRunHitIntervalTime);
Config.WriteInteger('Setup', 'WalkHitIntervalTime', g_Config.dwWalkHitIntervalTime);
Config.WriteInteger('Setup', 'RunMagicIntervalTime', g_Config.dwRunMagicIntervalTime);
end;

procedure TfrmActionSpeed.ButtonSaveClick(Sender: TObject);
begin
SaveConfig();
uModValue();
end;

procedure TfrmActionSpeed.CheckBoxIncremengClick(Sender: TObject);
var
nIncrement: Integer;
begin
if CheckBoxIncremeng.Checked then nIncrement := 1
else nIncrement := 10;

EditActionIntervalTime.Increment := nIncrement;
EditRunLongHitIntervalTime.Increment := nIncrement;
EditRunHitIntervalTime.Increment := nIncrement;
EditWalkHitIntervalTime.Increment := nIncrement;
end;
procedure TfrmActionSpeed.CheckBoxControlActionIntervalClick(
Sender: TObject);
var
boStatus: Boolean;
begin
boStatus := CheckBoxControlActionInterval.Checked;
EditActionIntervalTime.Enabled := boStatus;
CheckBoxControlRunLongHit.Enabled := boStatus;
CheckBoxControlRunHit.Enabled := boStatus;
CheckBoxControlWalkHit.Enabled := boStatus;
CheckBoxControlRunMagic.Enabled := boStatus;

CheckBoxControlRunLongHitClick(Sender);
CheckBoxControlRunHitClick(Sender);
CheckBoxControlWalkHitClick(Sender);
CheckBoxControlRunMagicClick(Sender);

if not boOpened then exit;
g_Config.boControlActionInterval := boStatus;
ModValue();
end;

procedure TfrmActionSpeed.EditActionIntervalTimeChange(Sender: TObject);
begin
if not boOpened then exit;
g_Config.dwActionIntervalTime := EditActionIntervalTime.Value;
ModValue();
end;

procedure TfrmActionSpeed.CheckBoxControlRunLongHitClick(Sender: TObject);
var
boStatus: Boolean;
begin
boStatus := CheckBoxControlRunLongHit.Checked and CheckBoxControlRunLongHit.Enabled;

EditRunLongHitIntervalTime.Enabled := boStatus;

if not boOpened then exit;
g_Config.boControlRunLongHit := boStatus;
ModValue();
end;

procedure TfrmActionSpeed.EditRunLongHitIntervalTimeChange(
Sender: TObject);
begin
if not boOpened then exit;
g_Config.dwRunLongHitIntervalTime := EditRunLongHitIntervalTime.Value;
ModValue();
end;

procedure TfrmActionSpeed.CheckBoxControlRunHitClick(Sender: TObject);
var
boStatus: Boolean;
begin
boStatus := CheckBoxControlRunHit.Checked and CheckBoxControlRunHit.Enabled;
EditRunHitIntervalTime.Enabled := boStatus;

if not boOpened then exit;
g_Config.boControlRunHit := boStatus;
ModValue();
end;

procedure TfrmActionSpeed.EditRunHitIntervalTimeChange(Sender: TObject);
begin
if not boOpened then exit;
g_Config.dwRunHitIntervalTime := EditRunHitIntervalTime.Value;
ModValue();
end;

procedure TfrmActionSpeed.CheckBoxControlWalkHitClick(Sender: TObject);
var
boStatus: Boolean;
begin
boStatus := CheckBoxControlWalkHit.Checked and CheckBoxControlWalkHit.Enabled;
EditWalkHitIntervalTime.Enabled := boStatus;

if not boOpened then exit;
g_Config.boControlWalkHit := boStatus;
ModValue();
end;

procedure TfrmActionSpeed.EditWalkHitIntervalTimeChange(Sender: TObject);
begin
if not boOpened then exit;
g_Config.dwWalkHitIntervalTime := EditWalkHitIntervalTime.Value;
ModValue();
end;

procedure TfrmActionSpeed.CheckBoxControlRunMagicClick(Sender: TObject);
var
boStatus: Boolean;
begin
boStatus := CheckBoxControlRunMagic.Checked and CheckBoxControlRunMagic.Enabled;
EditRunMagicIntervalTime.Enabled := boStatus;

if not boOpened then exit;
g_Config.boControlRunMagic := boStatus;
ModValue();
end;

procedure TfrmActionSpeed.EditRunMagicIntervalTimeChange(Sender: TObject);
begin
if not boOpened then exit;
g_Config.dwRunMagicIntervalTime := EditRunMagicIntervalTime.Value;
ModValue();
end;

end.

**hujiacheng** · 10-12-07

AttackSabukWallConfig.pas
unit AttackSabukWallConfig;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, RzEdit, CastleManage, Castle, Guild;

type
TFrmAttackSabukWall = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
EditGuildName: TEdit;
RzDateTimeEditAttackDate: TRzDateTimeEdit;
ButtonOK: TButton;
ListBoxGuild: TListBox;
CheckBoxAll: TCheckBox;
procedure ButtonOKClick(Sender: TObject);
procedure ListBoxGuildClick(Sender: TObject);
procedure CheckBoxAllClick(Sender: TObject);
private
{ Private declarations }
procedure LoadGuildList();
public
{ Public declarations }
procedure Open();
end;

var
FrmAttackSabukWall: TFrmAttackSabukWall;
nStute: Integer;
m_sGuildName: string;
m_AttackDate: TDate;
implementation
uses M2Share;
{$R *.dfm}
procedure TFrmAttackSabukWall.LoadGuildList();
var
i: Integer;
Guild: TGuild;
begin
ListBoxGuild.Items.Clear;
for i := 0 to g_GuildManager.GuildList.Count - 1 do begin
Guild := TGuild(g_GuildManager.GuildList.Items[i]);
ListBoxGuild.Items.AddObject(Guild.sGuildName, TObject(Guild));
end;
end;

procedure TFrmAttackSabukWall.Open();
begin
case nStute of
0: begin
EditGuildName.Text := '';
RzDateTimeEditAttackDate.Date := Date;
end;
1: begin
EditGuildName.Text := m_sGuildName;
RzDateTimeEditAttackDate.Date := m_AttackDate;
end;
end;
LoadGuildList();
ShowModal;
end;

procedure TFrmAttackSabukWall.ButtonOKClick(Sender: TObject);
var
sGuildName: string;
AttackDate: TDate;
i: Integer;
begin
ButtonOK.Enabled := False;
sGuildName := Trim(EditGuildName.Text);
AttackDate := RzDateTimeEditAttackDate.Date;
case nStute of
0: begin
if CheckBoxAll.Checked then begin
if CurCastle = nil then Exit;
{nCount := -1;
frmCastleManage.ListViewAttackSabukWall.Items.Clear;
for i := 0 to CurCastle.m_AttackWarList.Count - 1 do begin
DisPose(pTAttackerInfo(CurCastle.m_AttackWarList.Items[i]));
end;
CurCastle.m_AttackWarList.Clear;}
for i := 0 to ListBoxGuild.Items.Count - 1 do begin
if not frmCastleManage.IsAttackSabukWallOfGuild(ListBoxGuild.Items.Strings[i], AttackDate) then
frmCastleManage.AddAttackSabukWallOfGuild(ListBoxGuild.Items.Strings[i], AttackDate);
end;
end else begin
if not frmCastleManage.IsAttackSabukWallOfGuild(sGuildName, AttackDate) then
if not frmCastleManage.AddAttackSabukWallOfGuild(sGuildName, AttackDate) then Exit;
end;
end;
1: begin
if CheckBoxAll.Checked then begin
if CurCastle = nil then Exit;
{nCount := -1;
frmCastleManage.ListViewAttackSabukWall.Items.Clear;
for i := 0 to CurCastle.m_AttackWarList.Count - 1 do begin
DisPose(pTAttackerInfo(CurCastle.m_AttackWarList.Items[i]));
end;
CurCastle.m_AttackWarList.Clear; }
for i := 0 to ListBoxGuild.Items.Count - 1 do begin
if not frmCastleManage.IsAttackSabukWallOfGuild(ListBoxGuild.Items.Strings[i], AttackDate) then
frmCastleManage.AddAttackSabukWallOfGuild(ListBoxGuild.Items.Strings[i], AttackDate);
end;
end else begin
if not frmCastleManage.ChgAttackSabukWallOfGuild(sGuildName, AttackDate) then Exit;
end;
end;
end;
Close;
end;

procedure TFrmAttackSabukWall.ListBoxGuildClick(Sender: TObject);
begin
try
EditGuildName.Text := ListBoxGuild.Items.Strings[ListBoxGuild.ItemIndex];
except
end;
end;

procedure TFrmAttackSabukWall.CheckBoxAllClick(Sender: TObject);
begin
EditGuildName.Enabled := not CheckBoxAll.Checked;
end;

end.

**hujiacheng** · 10-12-07

BnkEngn.pas
unit BnkEngn;

interface

uses
Windows, Classes, ObjBase, ObjNpc;

type
TOpAction = (o_GetGold, o_SaveGold, o_ViewGold);
TReQuestInfo = record
NPC: TMerchant;
PlayObject: TPlayObject;
OpAction: TOpAction;
nGameGold: Integer;
sAccount: string;
sPassword: string;
end;
pTReQuestInfo = ^TReQuestInfo;
TBankEngine = class(TThread)
m_UserReQuestList: TList;
m_CompleteList: TList;
m_CS: TRTLCriticalSection;
private
{ Private declarations }
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure Lock;
procedure UnLock;
end;

implementation

{ TBankEngine }

constructor TBankEngine.Create(CreateSuspended: Boolean);
begin
inherited;
InitializeCriticalSection(m_CS);
m_UserReQuestList := TList.Create;
m_CompleteList := TList.Create;
end;

destructor TBankEngine.Destroy;
begin
m_UserReQuestList.Free;
m_CompleteList.Free;
DeleteCriticalSection(m_CS);
inherited;
end;

procedure TBankEngine.Execute;
var
i: Integer;
ReQuestInfo: pTReQuestInfo;
begin
while not Terminated do begin
Lock;
try

finally
UnLock;
end;
for i := 0 to m_UserReQuestList.Count - 1 do begin
ReQuestInfo := m_UserReQuestList.Items[i];
case ReQuestInfo.OpAction of //
o_GetGold: ;
o_SaveGold: ;
o_ViewGold: ;
end;
end;
Sleep(1);
end;
end;

procedure TBankEngine.Lock;
begin
EnterCriticalSection(m_CS);
end;

procedure TBankEngine.UnLock;
begin
LeaveCriticalSection(m_CS);
end;

end.

**hujiacheng** · 10-12-07

Castle.pas
unit Castle;

interface
uses
Windows, Classes, SysUtils, IniFiles, Grobal2, ObjBase, ObjMon2, Guild, Envir;
const
MAXCASTLEARCHER = 12;
MAXCALSTEGUARD = 4;
type
TDefenseUnit = record
nMainDoorX: Integer; //0x00
nMainDoorY: Integer; //0x04
sMainDoorName: string; //0x08
boXXX: Boolean; //0x0C
wMainDoorHP: Word; //0x10
MainDoor: TBaseObject;
LeftWall: TBaseObject;
CenterWall: TBaseObject;
RightWall: TBaseObject;
Archer: TBaseObject;
end;
pTDefenseUnit = ^TDefenseUnit;
TObjUnit = record
nX: Integer; //0x0
nY: Integer; //0x4
sName: string; //0x8
// nStatus :Integer; //0x0C
nStatus: Boolean; //0x0C
nHP: Integer; //0x10
BaseObject: TBaseObject; //0x14
end;
pTObjUnit = ^TObjUnit;
TAttackerInfo = record
AttackDate: TDateTime;
sGuildName: string;
Guild: TGUild;
end;
pTAttackerInfo = ^TAttackerInfo;
TUserCastle = class
m_MapCastle: TEnvirnoment; //0x4 城堡所在地图
m_MapPalace: TEnvirnoment; //0x8 皇宫所在地图
m_MapSecret: TEnvirnoment; //0xC 密道所在地图
m_DoorStatus: pTDoorStatus; //0x10 皇宫门状态
m_sMapName: string; //0x14 城堡所在地图名
m_sName: string; //0x18 城堡名称
m_sOwnGuild: string; //0x1C 所属行会名称
m_MasterGuild: TGUild; //0x20 所属行会
m_sHomeMap: string; //0x24 行会回城点地图
m_nHomeX: Integer; //0x28 行会回城点X
m_nHomeY: Integer; //0x2C 行会回城点Y
m_ChangeDate: TDateTime; //0x30
m_WarDate: TDateTime; //0x38
m_boStartWar: Boolean; //0x40 是否开始攻城
m_boUnderWar: Boolean; //0x41 是否正在攻城
m_boShowOverMsg: Boolean; //0x42 是否已显示攻城结束信息
m_dwStartCastleWarTick: LongWord; //0x44
m_dwSaveTick: LongWord; //0x48
m_AttackWarList: TList; //0x4C
m_AttackGuildList: TList; //0x50
m_MainDoor: TObjUnit; //0x54
m_LeftWall: TObjUnit; //0x6C
m_CenterWall: TObjUnit; //0x84
m_RightWall: TObjUnit; //0x9C
m_Guard: array[0..MAXCALSTEGUARD - 1] of TObjUnit; //0xB4
m_Archer: array[0..MAXCASTLEARCHER - 1] of TObjUnit; //0x114 0x264
m_IncomeToday: TDateTime; //0x238
m_nTotalGold: Integer; //0x240
m_nTodayIncome: Integer; //0x244
m_nWarRangeX: Integer; //攻城区域范围X
m_nWarRangeY: Integer; //攻城区域范围Y
m_boStatus: Boolean;
m_sPalaceMap: string; //皇宫所在地图
m_sSecretMap: string; //密道所在地图
m_nPalaceDoorX: Integer; //皇宫座标X
m_nPalaceDoorY: Integer; //皇宫座标Y
m_sConfigDir: string;
m_EnvirList: TStringList;

m_nTechLevel: Integer; //科技等级
m_nPower: Integer; //电力量
private
procedure LoadAttackSabukWall();
procedure SaveConfigFile();
procedure LoadConfig();
procedure SaveAttackSabukWall();
function InAttackerList(Guild: TGUild): Boolean;
procedure SetTechLevel(nLevel: Integer);
procedure SetPower(nPower: Integer);
function m_nChiefItemCount: Integer;
public
constructor Create(sCastleDir: string);
destructor Destroy; override;
procedure Initialize();
procedure Run();
procedure Save();
function InCastleWarArea(Envir: TEnvirnoment; nX, nY: Integer): Boolean;
function IsMember(Cert: TBaseObject): Boolean;
function IsMasterGuild(Guild: TGUild): Boolean;
function IsAttackGuild(Guild: TGUild): Boolean;
function IsAttackAllyGuild(Guild: TGUild): Boolean;
function IsDefenseGuild(Guild: TGUild): Boolean;
function IsDefenseAllyGuild(Guild: TGUild): Boolean;

function CanGetCastle(Guild: TGUild): Boolean;
procedure GetCastle(Guild: TGUild);
procedure StartWallconquestWar;
procedure StopWallconquestWar();
function InPalaceGuildCount(): Integer;
function GetHomeX(): Integer;
function GetHomeY(): Integer;
function GetMapName(): string;
function AddAttackerInfo(Guild: TGUild): Boolean;
function CheckInPalace(nX, nY: Integer; Cert: TBaseObject): Boolean;
function GetWarDate(): string;
function GetAttackWarList(): string;
procedure IncRateGold(nGold: Integer);
function WithDrawalGolds(PlayObject: TPlayObject; nGold: Integer): Integer;
function ReceiptGolds(PlayObject: TPlayObject; nGold: Integer): Integer;
procedure MainDoorControl(boClose: Boolean);
function RepairDoor(): Boolean;
function RepairWall(nWallIndex: Integer): Boolean;
property nTechLevel: Integer read m_nTechLevel write SetTechLevel;
property nPower: Integer read m_nPower write SetPower;
end;

TCastleManager = class
private

CriticalSection: TRTLCriticalSection;
protected

public
m_CastleList: TList;
constructor Create();
destructor Destroy; override;
procedure LoadCastleList();
procedure SaveCastleList();
procedure Initialize();
procedure Lock;
procedure UnLock;
procedure Run();
procedure Save();
function Find(sCASTLENAME: string): TUserCastle;
function GetCastle(nIndex: Integer): TUserCastle;
function InCastleWarArea(BaseObject: TBaseObject): TUserCastle; overload;
function InCastleWarArea(Envir: TEnvirnoment; nX, nY: Integer): TUserCastle; overload;
function IsCastleMember(BaseObject: TBaseObject): TUserCastle;
function IsCastlePalaceEnvir(Envir: TEnvirnoment): TUserCastle;
function IsCastleEnvir(Envir: TEnvirnoment): TUserCastle;
procedure GetCastleGoldInfo(List: TStringList);
procedure GetCastleNameList(List: TStringList);
procedure IncRateGold(nGold: Integer);
end;
implementation

uses UsrEngn, M2Share, HUtil32;

{ TUserCastle }
constructor TUserCastle.Create(sCastleDir: string); //0048E438
begin
m_MasterGuild := nil;
m_sHomeMap := g_Config.sCastleHomeMap {'3'};
m_nHomeX := g_Config.nCastleHomeX {644};
m_nHomeY := g_Config.nCastleHomeY {290};
m_sName := g_Config.sCASTLENAME {'沙巴克'};

m_sConfigDir := sCastleDir;
m_sPalaceMap := '0150';
m_sSecretMap := 'D701';
m_MapCastle := nil;
m_DoorStatus := nil;
m_boStartWar := False;
m_boUnderWar := False;
m_boShowOverMsg := False;
m_AttackWarList := TList.Create;
m_AttackGuildList := TList.Create;
m_dwSaveTick := 0;
m_nWarRangeX := g_Config.nCastleWarRangeX;
m_nWarRangeY := g_Config.nCastleWarRangeY;
m_EnvirList := TStringList.Create;
end;
destructor TUserCastle.Destroy; //0048E51C
var
i: Integer;
begin
for i := 0 to m_AttackWarList.Count - 1 do begin
DisPose(pTAttackerInfo(m_AttackWarList.Items[i]));
end;
m_AttackWarList.Free;
m_AttackGuildList.Free;
m_EnvirList.Free;
inherited;
end;
procedure TUserCastle.Initialize; //0048E564
var
i: Integer;
ObjUnit: pTObjUnit;
Door: pTDoorInfo;
begin
LoadConfig();
LoadAttackSabukWall();
if g_MapManager.GetMapOfServerIndex(m_sMapName) = nServerIndex then begin
//m_MapPalace:=EnvirList.FindMap('0150');
m_MapPalace := g_MapManager.FindMap(m_sPalaceMap);
if m_MapPalace = nil then begin
MainOutMessage(format('皇宫地图%s没找到！！！', [m_sPalaceMap]));
end;
m_MapSecret := g_MapManager.FindMap(m_sSecretMap);
if m_MapSecret = nil then begin
MainOutMessage(format('密道地图%s没找到！！！', [m_sSecretMap]));
//ShowMessage('0150 没有找到地图...');
end;
m_MapCastle := g_MapManager.FindMap(m_sMapName);
if m_MapCastle <> nil then begin
m_MainDoor.BaseObject := UserEngine.RegenMonsterByName(m_sMapName, m_MainDoor.nX, m_MainDoor.nY, m_MainDoor.sName);
if m_MainDoor.BaseObject <> nil then begin
m_MainDoor.BaseObject.m_WAbil.HP := m_MainDoor.nHP;
m_MainDoor.BaseObject.m_Castle := Self;

// if MainDoor.nStatus <> 0 then begin
if m_MainDoor.nStatus then begin
TCastleDoor(m_MainDoor.BaseObject).Open;
end;
// MainOutMessage(format('Name:%s Map:%s X:%d Y:%d HP:%d',[MainDoor.BaseObject.m_sCharName,MainDoor.BaseObject.m_sMapName,MainDoor.BaseObject.m_nCurrX,MainDoor.BaseObject.m_nCurrY,MainDoor.BaseObject.m_Wabil.HP]));
end else begin
MainOutMessage('[错误信息] 城堡初始化城门失败，检查怪物数据库里有没城门的设置: ' + m_MainDoor.sName);
end;

m_LeftWall.BaseObject := UserEngine.RegenMonsterByName(m_sMapName, m_LeftWall.nX, m_LeftWall.nY, m_LeftWall.sName);
if m_LeftWall.BaseObject <> nil then begin
m_LeftWall.BaseObject.m_WAbil.HP := m_LeftWall.nHP;
m_LeftWall.BaseObject.m_Castle := Self;
//MainOutMessage('m_LeftWall.BaseObject.m_WAbil.HP '+IntToStr(m_LeftWall.BaseObject.m_WAbil.HP));
// MainOutMessage(format('Name:%s Map:%s X:%d Y:%d HP:%d',[LeftWall.BaseObject.m_sCharName,LeftWall.BaseObject.m_sMapName,LeftWall.BaseObject.m_nCurrX,LeftWall.BaseObject.m_nCurrY,LeftWall.BaseObject.m_Wabil.HP]));
end else begin
MainOutMessage('[错误信息] 城堡初始化左城墙失败，检查怪物数据库里有没左城墙的设置: ' + m_LeftWall.sName);
end;

m_CenterWall.BaseObject := UserEngine.RegenMonsterByName(m_sMapName, m_CenterWall.nX, m_CenterWall.nY, m_CenterWall.sName);
if m_CenterWall.BaseObject <> nil then begin
m_CenterWall.BaseObject.m_WAbil.HP := m_CenterWall.nHP;
m_CenterWall.BaseObject.m_Castle := Self;
// MainOutMessage(format('Name:%s Map:%s X:%d Y:%d HP:%d',[CenterWall.BaseObject.m_sCharName,CenterWall.BaseObject.m_sMapName,CenterWall.BaseObject.m_nCurrX,CenterWall.BaseObject.m_nCurrY,CenterWall.BaseObject.m_Wabil.HP]));
end else begin
MainOutMessage('[错误信息] 城堡初始化中城墙失败，检查怪物数据库里有没中城墙的设置: ' + m_CenterWall.sName);
end;

m_RightWall.BaseObject := UserEngine.RegenMonsterByName(m_sMapName, m_RightWall.nX, m_RightWall.nY, m_RightWall.sName);
if m_RightWall.BaseObject <> nil then begin
m_RightWall.BaseObject.m_WAbil.HP := m_RightWall.nHP;
m_RightWall.BaseObject.m_Castle := Self;
// MainOutMessage(format('Name:%s Map:%s X:%d Y:%d HP:%d',[RightWall.BaseObject.m_sCharName,RightWall.BaseObject.m_sMapName,RightWall.BaseObject.m_nCurrX,RightWall.BaseObject.m_nCurrY,RightWall.BaseObject.m_Wabil.HP]));
end else begin
MainOutMessage('[错误信息] 城堡初始化右城墙失败，检查怪物数据库里有没右城墙的设置: ' + m_RightWall.sName);
end;
for i := Low(m_Archer) to High(m_Archer) do begin
ObjUnit := @m_Archer[i];
if ObjUnit.nHP <= 0 then Continue;
ObjUnit.BaseObject := UserEngine.RegenMonsterByName(m_sMapName, ObjUnit.nX, ObjUnit.nY, ObjUnit.sName);
if ObjUnit.BaseObject <> nil then begin
ObjUnit.BaseObject.m_WAbil.HP := m_Archer[i].nHP;
ObjUnit.BaseObject.m_Castle := Self;
TGuardUnit(ObjUnit.BaseObject).m_nX550 := ObjUnit.nX;
TGuardUnit(ObjUnit.BaseObject).m_nY554 := ObjUnit.nY;
TGuardUnit(ObjUnit.BaseObject).m_nDirection := 3;
end else begin
//MainOutMessage('[错误信息] UserCastle.Initialize Archer -> UnitObj = nil');
MainOutMessage('[错误信息] 城堡初始化弓箭手失败，检查怪物数据库里有没弓箭手的设置: ' + ObjUnit.sName);
end;
end;
for i := Low(m_Guard) to High(m_Guard) do begin
ObjUnit := @m_Guard[i];
if ObjUnit.nHP <= 0 then Continue;
ObjUnit.BaseObject := UserEngine.RegenMonsterByName(m_sMapName, ObjUnit.nX, ObjUnit.nY, ObjUnit.sName);
if ObjUnit.BaseObject <> nil then begin
ObjUnit.BaseObject.m_WAbil.HP := m_Guard[i].nHP;
end else begin
MainOutMessage('[错误信息] 城堡初始化守卫失败(检查怪物数据库里有没守卫怪物)');
//MainOutMessage('[错误信息] UserCastle.Initialize Guard -> UnitObj = nil');
end;
end;
for i := 0 to m_MapCastle.m_DoorList.Count - 1 do begin
Door := m_MapCastle.m_DoorList.Items[i];
if (abs(Door.nX - m_nPalaceDoorX {631}) <= 3) and (abs(Door.nY - m_nPalaceDoorY {274}) <= 3) then begin
m_DoorStatus := Door.Status;
end;
end;
end else begin
MainOutMessage(format('[错误信息] 城堡所在地图不存在(检查地图配置文件里是否有地图%s的设置)', [m_sMapName]));
//MainOutMessage('[错误信息] TUserCastle.Initialize CastleMap -> nil');
end;
end;
end;
procedure TUserCastle.LoadConfig();
var
sFileName, sConfigFile: string;
CastleConf: TIniFile;
i: Integer;
ObjUnit: pTObjUnit;
sMapList, sMAP: string;
begin
if not DirectoryExists(g_Config.sCastleDir + m_sConfigDir) then begin
CreateDir(g_Config.sCastleDir + m_sConfigDir);
end;
sConfigFile := 'SabukW.txt';
sFileName := g_Config.sCastleDir + m_sConfigDir + '\' + sConfigFile;
CastleConf := TIniFile.Create(sFileName);
if CastleConf <> nil then begin
m_sName := CastleConf.ReadString('Setup', 'CastleName', m_sName);
m_sOwnGuild := CastleConf.ReadString('Setup', 'OwnGuild', '');
m_ChangeDate := CastleConf.ReadDateTime('Setup', 'ChangeDate', Now);
m_WarDate := CastleConf.ReadDateTime('Setup', 'WarDate', Now);
m_IncomeToday := CastleConf.ReadDateTime('Setup', 'IncomeToday', Now);
m_nTotalGold := CastleConf.ReadInteger('Setup', 'TotalGold', 0);
m_nTodayIncome := CastleConf.ReadInteger('Setup', 'TodayIncome', 0);

sMapList := CastleConf.ReadString('Defense', 'CastleMapList', '');
if sMapList <> '' then begin
while (sMapList <> '') do begin
sMapList := GetValidStr3(sMapList, sMAP, [',']);
if sMAP = '' then break;
m_EnvirList.Add(sMAP);
end;
end;
for i := 0 to m_EnvirList.Count - 1 do begin
m_EnvirList.Objects[i] := g_MapManager.FindMap(m_EnvirList.Strings[i]);
end;

m_sMapName := CastleConf.ReadString('Defense', 'CastleMap', '3');
m_sHomeMap := CastleConf.ReadString('Defense', 'CastleHomeMap', m_sHomeMap);
m_nHomeX := CastleConf.ReadInteger('Defense', 'CastleHomeX', m_nHomeX);
m_nHomeY := CastleConf.ReadInteger('Defense', 'CastleHomeY', m_nHomeY);
m_nWarRangeX := CastleConf.ReadInteger('Defense', 'CastleWarRangeX', m_nWarRangeX);
m_nWarRangeY := CastleConf.ReadInteger('Defense', 'CastleWarRangeY', m_nWarRangeY);
m_sPalaceMap := CastleConf.ReadString('Defense', 'CastlePlaceMap', m_sPalaceMap);
m_sSecretMap := CastleConf.ReadString('Defense', 'CastleSecretMap', m_sSecretMap);
m_nPalaceDoorX := CastleConf.ReadInteger('Defense', 'CastlePalaceDoorX', 631);
m_nPalaceDoorY := CastleConf.ReadInteger('Defense', 'CastlePalaceDoorY', 274);

m_MainDoor.nX := CastleConf.ReadInteger('Defense', 'MainDoorX', 672);
m_MainDoor.nY := CastleConf.ReadInteger('Defense', 'MainDoorY', 330);
m_MainDoor.sName := CastleConf.ReadString('Defense', 'MainDoorName', 'MainDoor');
m_MainDoor.nStatus := CastleConf.ReadBool('Defense', 'MainDoorOpen', True);
m_MainDoor.nHP := CastleConf.ReadInteger('Defense', 'MainDoorHP', 2000);
if m_MainDoor.nHP <= 0 then m_MainDoor.nHP := 2000;
m_MainDoor.BaseObject := nil;

m_LeftWall.nX := CastleConf.ReadInteger('Defense', 'LeftWallX', 624);
m_LeftWall.nY := CastleConf.ReadInteger('Defense', 'LeftWallY', 278);
m_LeftWall.sName := CastleConf.ReadString('Defense', 'LeftWallName', 'LeftWall');
m_LeftWall.nHP := CastleConf.ReadInteger('Defense', 'LeftWallHP', 2000);
if m_LeftWall.nHP <= 0 then m_LeftWall.nHP := 2000;
m_LeftWall.BaseObject := nil;

m_CenterWall.nX := CastleConf.ReadInteger('Defense', 'CenterWallX', 627);
m_CenterWall.nY := CastleConf.ReadInteger('Defense', 'CenterWallY', 278);
m_CenterWall.sName := CastleConf.ReadString('Defense', 'CenterWallName', 'CenterWall');
m_CenterWall.nHP := CastleConf.ReadInteger('Defense', 'CenterWallHP', 2000);
if m_CenterWall.nHP <= 0 then m_CenterWall.nHP := 2000;
m_CenterWall.BaseObject := nil;

m_RightWall.nX := CastleConf.ReadInteger('Defense', 'RightWallX', 634);
m_RightWall.nY := CastleConf.ReadInteger('Defense', 'RightWallY', 271);
m_RightWall.sName := CastleConf.ReadString('Defense', 'RightWallName', 'RightWall');
m_RightWall.nHP := CastleConf.ReadInteger('Defense', 'RightWallHP', 2000);
if m_RightWall.nHP <= 0 then m_RightWall.nHP := 2000;
m_RightWall.BaseObject := nil;

for i := Low(m_Archer) to High(m_Archer) do begin
ObjUnit := @m_Archer[i];
ObjUnit.nX := CastleConf.ReadInteger('Defense', 'Archer_' + IntToStr(i + 1) + '_X', 0);
ObjUnit.nY := CastleConf.ReadInteger('Defense', 'Archer_' + IntToStr(i + 1) + '_Y', 0);
ObjUnit.sName := CastleConf.ReadString('Defense', 'Archer_' + IntToStr(i + 1) + '_Name', '弓箭手');
ObjUnit.nHP := CastleConf.ReadInteger('Defense', 'Archer_' + IntToStr(i + 1) + '_HP', 2000);
ObjUnit.BaseObject := nil;
end;

for i := Low(m_Guard) to High(m_Guard) do begin
ObjUnit := @m_Guard[i];
ObjUnit.nX := CastleConf.ReadInteger('Defense', 'Guard_' + IntToStr(i + 1) + '_X', 0);
ObjUnit.nY := CastleConf.ReadInteger('Defense', 'Guard_' + IntToStr(i + 1) + '_Y', 0);
ObjUnit.sName := CastleConf.ReadString('Defense', 'Guard_' + IntToStr(i + 1) + '_Name', '守卫');
ObjUnit.nHP := CastleConf.ReadInteger('Defense', 'Guard_' + IntToStr(i + 1) + '_HP', 2000);
ObjUnit.BaseObject := nil;
end;
CastleConf.Free;
end;
m_MasterGuild := g_GuildManager.FindGuild(m_sOwnGuild);
end;

procedure TUserCastle.SaveConfigFile();
var
CastleConf: TIniFile;
ObjUnit: pTObjUnit;
sFileName, sConfigFile: string;
sMapList: string;
i: Integer;
begin
if not DirectoryExists(g_Config.sCastleDir + m_sConfigDir) then begin
CreateDir(g_Config.sCastleDir + m_sConfigDir);
end;
if g_MapManager.GetMapOfServerIndex(m_sMapName) <> nServerIndex then Exit;
sConfigFile := 'SabukW.txt';
sFileName := g_Config.sCastleDir + m_sConfigDir + '\' + sConfigFile;
CastleConf := TIniFile.Create(sFileName);
if CastleConf <> nil then begin
if m_sName <> '' then CastleConf.WriteString('Setup', 'CastleName', m_sName);
if m_sOwnGuild <> '' then CastleConf.WriteString('Setup', 'OwnGuild', m_sOwnGuild);
CastleConf.WriteDateTime('Setup', 'ChangeDate', m_ChangeDate);
CastleConf.WriteDateTime('Setup', 'WarDate', m_WarDate);
CastleConf.WriteDateTime('Setup', 'IncomeToday', m_IncomeToday);
if m_nTotalGold <> 0 then CastleConf.WriteInteger('Setup', 'TotalGold', m_nTotalGold);
if m_nTodayIncome <> 0 then CastleConf.WriteInteger('Setup', 'TodayIncome', m_nTodayIncome);

for i := 0 to m_EnvirList.Count - 1 do begin
sMapList := sMapList + m_EnvirList.Strings[i] + ',';
end;
if sMapList <> '' then CastleConf.WriteString('Defense', 'CastleMapList', sMapList);

if m_sMapName <> '' then CastleConf.WriteString('Defense', 'CastleMap', m_sMapName);
if m_sHomeMap <> '' then CastleConf.WriteString('Defense', 'CastleHomeMap', m_sHomeMap);
if m_nHomeX <> 0 then CastleConf.WriteInteger('Defense', 'CastleHomeX', m_nHomeX);
if m_nHomeY <> 0 then CastleConf.WriteInteger('Defense', 'CastleHomeY', m_nHomeY);
if m_nWarRangeX <> 0 then CastleConf.WriteInteger('Defense', 'CastleWarRangeX', m_nWarRangeX);
if m_nWarRangeY <> 0 then CastleConf.WriteInteger('Defense', 'CastleWarRangeY', m_nWarRangeY);

if m_sPalaceMap <> '' then CastleConf.WriteString('Defense', 'CastlePlaceMap', m_sPalaceMap);
if m_sSecretMap <> '' then CastleConf.WriteString('Defense', 'CastleSecretMap', m_sSecretMap);
if m_nPalaceDoorX <> 0 then CastleConf.WriteInteger('Defense', 'CastlePalaceDoorX', m_nPalaceDoorX);
if m_nPalaceDoorY <> 0 then CastleConf.WriteInteger('Defense', 'CastlePalaceDoorY', m_nPalaceDoorY);

if m_MainDoor.nX <> 0 then CastleConf.WriteInteger('Defense', 'MainDoorX', m_MainDoor.nX);
if m_MainDoor.nY <> 0 then CastleConf.WriteInteger('Defense', 'MainDoorY', m_MainDoor.nY);
if m_MainDoor.sName <> '' then CastleConf.WriteString('Defense', 'MainDoorName', m_MainDoor.sName);

if m_MainDoor.BaseObject <> nil then begin
CastleConf.WriteBool('Defense', 'MainDoorOpen', m_MainDoor.nStatus);
CastleConf.WriteInteger('Defense', 'MainDoorHP', m_MainDoor.BaseObject.m_WAbil.HP);
end;

if m_LeftWall.nX <> 0 then CastleConf.WriteInteger('Defense', 'LeftWallX', m_LeftWall.nX);
if m_LeftWall.nY <> 0 then CastleConf.WriteInteger('Defense', 'LeftWallY', m_LeftWall.nY);
if m_LeftWall.sName <> '' then CastleConf.WriteString('Defense', 'LeftWallName', m_LeftWall.sName);

if m_LeftWall.BaseObject <> nil then begin
CastleConf.WriteInteger('Defense', 'LeftWallHP', m_LeftWall.BaseObject.m_WAbil.HP);
end;

if m_CenterWall.nX <> 0 then CastleConf.WriteInteger('Defense', 'CenterWallX', m_CenterWall.nX);
if m_CenterWall.nY <> 0 then CastleConf.WriteInteger('Defense', 'CenterWallY', m_CenterWall.nY);
if m_CenterWall.sName <> '' then CastleConf.WriteString('Defense', 'CenterWallName', m_CenterWall.sName);

if m_CenterWall.BaseObject <> nil then begin
CastleConf.WriteInteger('Defense', 'CenterWallHP', m_CenterWall.BaseObject.m_WAbil.HP);
end;

if m_RightWall.nX <> 0 then CastleConf.WriteInteger('Defense', 'RightWallX', m_RightWall.nX);
if m_RightWall.nY <> 0 then CastleConf.WriteInteger('Defense', 'RightWallY', m_RightWall.nY);
if m_RightWall.sName <> '' then CastleConf.WriteString('Defense', 'RightWallName', m_RightWall.sName);
if m_RightWall.BaseObject <> nil then begin
CastleConf.WriteInteger('Defense', 'RightWallHP', m_RightWall.BaseObject.m_WAbil.HP);
end;
for i := Low(m_Archer) to High(m_Archer) do begin
ObjUnit := @m_Archer[i];
if ObjUnit.nX <> 0 then CastleConf.WriteInteger('Defense', 'Archer_' + IntToStr(i + 1) + '_X', ObjUnit.nX);
if ObjUnit.nY <> 0 then CastleConf.WriteInteger('Defense', 'Archer_' + IntToStr(i + 1) + '_Y', ObjUnit.nY);
if ObjUnit.sName <> '' then CastleConf.WriteString('Defense', 'Archer_' + IntToStr(i + 1) + '_Name', ObjUnit.sName);
if ObjUnit.BaseObject <> nil then begin
CastleConf.WriteInteger('Defense', 'Archer_' + IntToStr(i + 1) + '_HP', ObjUnit.BaseObject.m_WAbil.HP);
end else begin
CastleConf.WriteInteger('Defense', 'Archer_' + IntToStr(i + 1) + '_HP', 0);
end;
end;

for i := Low(m_Guard) to High(m_Guard) do begin
ObjUnit := @m_Guard[i];
if ObjUnit.nX <> 0 then CastleConf.WriteInteger('Defense', 'Guard_' + IntToStr(i + 1) + '_X', ObjUnit.nX);
if ObjUnit.nY <> 0 then CastleConf.WriteInteger('Defense', 'Guard_' + IntToStr(i + 1) + '_Y', ObjUnit.nY);
if ObjUnit.sName <> '' then CastleConf.WriteString('Defense', 'Guard_' + IntToStr(i + 1) + '_Name', ObjUnit.sName);
if ObjUnit.BaseObject <> nil then begin
CastleConf.WriteInteger('Defense', 'Guard_' + IntToStr(i + 1) + '_HP', ObjUnit.BaseObject.m_WAbil.HP);
end else begin
CastleConf.WriteInteger('Defense', 'Guard_' + IntToStr(i + 1) + '_HP', 0);
end;
end;
CastleConf.Free;
end;

end;
procedure TUserCastle.LoadAttackSabukWall();
var
i: Integer;
sFileName, sConfigFile: string;
LoadList: TStringList;
sData: string;
s20, sGuildName: string;
Guild: TGUild;
AttackerInfo: pTAttackerInfo;
begin
// sFileName:=g_Config.sCastleDir + 'AttackSabukWall.txt';
if not DirectoryExists(g_Config.sCastleDir + m_sConfigDir) then begin
CreateDir(g_Config.sCastleDir + m_sConfigDir);
end;
sConfigFile := 'AttackSabukWall.txt';
sFileName := g_Config.sCastleDir + m_sConfigDir + '\' + sConfigFile;
if FileExists(sFileName) then begin
LoadList := TStringList.Create;
try
LoadList.LoadFromFile(sFileName);
for i := 0 to m_AttackWarList.Count - 1 do begin
DisPose(pTAttackerInfo(m_AttackWarList.Items[i]));
end;
m_AttackWarList.Clear;
for i := 0 to LoadList.Count - 1 do begin
sData := LoadList.Strings[i];
s20 := GetValidStr3(sData, sGuildName, [' ', #9]);
Guild := g_GuildManager.FindGuild(sGuildName);
if Guild <> nil then begin
New(AttackerInfo);
ArrestStringEx(s20, '"', '"', s20);
try
AttackerInfo.AttackDate := StrToDate(s20);
except
AttackerInfo.AttackDate := Now();
end;
AttackerInfo.sGuildName := sGuildName;
AttackerInfo.Guild := Guild;
m_AttackWarList.Add(AttackerInfo);
end;

end;
except
MainOutMessage('[Error] UserCastle.LoadAttackSabukWall');
end;
LoadList.Free;
end;
end;
procedure TUserCastle.SaveAttackSabukWall();
var
i: Integer;
sFileName, sConfigFile: string;
LoadLis: TStringList;
AttackerInfo: pTAttackerInfo;
begin
if not DirectoryExists(g_Config.sCastleDir + m_sConfigDir) then begin
CreateDir(g_Config.sCastleDir + m_sConfigDir);
end;
sConfigFile := 'AttackSabukWall.txt';
sFileName := g_Config.sCastleDir + m_sConfigDir + '\' + sConfigFile;
LoadLis := TStringList.Create;
for i := 0 to m_AttackWarList.Count - 1 do begin
AttackerInfo := m_AttackWarList.Items[i];
LoadLis.Add(AttackerInfo.sGuildName + ' "' + DateToStr(AttackerInfo.AttackDate) + '"');
end;
try
LoadLis.SaveToFile(sFileName);
except
MainOutMessage('保存攻城信息失败: ' + sFileName);
end;
LoadLis.Free;
end;
procedure TUserCastle.Run; //0048FE4C
{$IF SoftVersion <> VERDEMO}
var
i: Integer;
Year, Month, Day, Hour, Min, Sec, MSec: Word;
wYear, wMonth, wDay: Word;
AttackerInfo: pTAttackerInfo;
s20: string;
{$IFEND}
resourcestring
sWarStartMsg = '[%s 攻城战已经开始]';
sWarStopTimeMsg = '[%s 攻城战离结束还有%d分钟]';
sExceptionMsg = '[Exception] TUserCastle::Run';
begin
try
if nServerIndex <> g_MapManager.GetMapOfServerIndex(m_sMapName) then Exit;
{$IF SoftVersion <> VERDEMO}
DecodeDate(Now, Year, Month, Day);
DecodeDate(m_IncomeToday, wYear, wMonth, wDay);
if (Year <> wYear) or (Month <> wMonth) or (Day <> wDay) then begin
m_nTodayIncome := 0;
m_IncomeToday := Now();
m_boStartWar := False;
end;
if not m_boStartWar and (not m_boUnderWar) then begin
DecodeTime(Time, Hour, Min, Sec, MSec);
if Hour = g_Config.nStartCastlewarTime {20} then begin
m_boStartWar := True; ;
m_AttackGuildList.Clear;
for i := m_AttackWarList.Count - 1 downto 0 do begin
if m_AttackWarList.Count <= 0 then break;
AttackerInfo := m_AttackWarList.Items[i];
DecodeDate(AttackerInfo.AttackDate, wYear, wMonth, wDay);
if (Year = wYear) and (Month = wMonth) and (Day = wDay) then begin
m_boUnderWar := True;
m_boShowOverMsg := False;
m_WarDate := Now();
m_dwStartCastleWarTick := GetTickCount();
m_AttackGuildList.Add(AttackerInfo.Guild);
DisPose(AttackerInfo);
m_AttackWarList.Delete(i);
end;
end;
if m_boUnderWar then begin
m_AttackGuildList.Add(m_MasterGuild);
StartWallconquestWar();
SaveAttackSabukWall();
UserEngine.SendServerGroupMsg(SS_212, nServerIndex, '');
s20 := format(sWarStartMsg, [m_sName]);
UserEngine.SendBroadCastMsgExt(s20, t_System);
UserEngine.SendServerGroupMsg(SS_204, nServerIndex, s20);
MainOutMessage(s20);
MainDoorControl(True);
end;
end;
end;
for i := Low(m_Guard) to High(m_Guard) do begin
if (m_Guard[i].BaseObject <> nil) and (m_Guard[i].BaseObject.m_boGhost) then begin
m_Guard[i].BaseObject := nil;
end;
end;
for i := Low(m_Archer) to High(m_Archer) do begin
if (m_Archer[i].BaseObject <> nil) and (m_Archer[i].BaseObject.m_boGhost) then begin
m_Archer[i].BaseObject := nil;
end;
end;
if m_boUnderWar then begin
if m_LeftWall.BaseObject <> nil then m_LeftWall.BaseObject.m_boStoneMode := False;
if m_CenterWall.BaseObject <> nil then m_CenterWall.BaseObject.m_boStoneMode := False;
if m_RightWall.BaseObject <> nil then m_RightWall.BaseObject.m_boStoneMode := False;
if not m_boShowOverMsg then begin //00490181
if (GetTickCount - m_dwStartCastleWarTick) > (g_Config.dwCastleWarTime - g_Config.dwShowCastleWarEndMsgTime) {3 * 60 * 60 * 1000 - 10 * 60 * 1000} then begin
m_boShowOverMsg := True;
s20 := format(sWarStopTimeMsg, [m_sName, g_Config.dwShowCastleWarEndMsgTime div (60 * 1000)]);
UserEngine.SendBroadCastMsgExt(s20, t_System);
UserEngine.SendServerGroupMsg(SS_204, nServerIndex, s20);
MainOutMessage(s20);
end;
end;
if (GetTickCount - m_dwStartCastleWarTick) > g_Config.dwCastleWarTime {3 * 60 * 60 * 1000} then begin
StopWallconquestWar();
end;
end else begin
if m_LeftWall.BaseObject <> nil then m_LeftWall.BaseObject.m_boStoneMode := True;
if m_CenterWall.BaseObject <> nil then m_CenterWall.BaseObject.m_boStoneMode := True;
if m_RightWall.BaseObject <> nil then m_RightWall.BaseObject.m_boStoneMode := True;
end;
{$IFEND}
except
MainOutMessage(sExceptionMsg);
end;
end;

procedure TUserCastle.Save;
begin
SaveConfigFile();
SaveAttackSabukWall();
end;

function TUserCastle.InCastleWarArea(Envir: TEnvirnoment; nX, nY: Integer): Boolean; //004910F4
var
i: Integer;
begin
Result := False;
if (Envir = m_MapCastle) and
(abs(m_nHomeX - nX) < m_nWarRangeX {100}) and
(abs(m_nHomeY - nY) < m_nWarRangeY {100}) then begin
Result := True;
Exit;
end;
if (Envir = m_MapPalace) or (Envir = m_MapSecret) then begin
Result := True;
Exit;
end;
//增加取得城堡所有地图列表
for i := 0 to m_EnvirList.Count - 1 do begin
if m_EnvirList.Objects[i] = Envir then begin
Result := True;
break;
end;
end;
end;

function TUserCastle.IsMember(Cert: TBaseObject): Boolean; //00490438
begin
Result := IsMasterGuild(TGUild(Cert.m_MyGuild));
end;

//检查是否为攻城方行会的联盟行会
function TUserCastle.IsAttackAllyGuild(Guild: TGUild): Boolean;
var
i: Integer;
AttackGuild: TGUild;
begin
Result := False;
for i := 0 to m_AttackGuildList.Count - 1 do begin
AttackGuild := TGUild(m_AttackGuildList.Items[i]);
if (AttackGuild <> m_MasterGuild) and AttackGuild.IsAllyGuild(Guild) then begin
Result := True;
break;
end;
end;
end;
//检查是否为攻城方行会
function TUserCastle.IsAttackGuild(Guild: TGUild): Boolean; //00491160
var
i: Integer;
AttackGuild: TGUild;
begin
Result := False;
for i := 0 to m_AttackGuildList.Count - 1 do begin
AttackGuild := TGUild(m_AttackGuildList.Items[i]);
if (AttackGuild <> m_MasterGuild) and (AttackGuild = Guild) then begin
Result := True;
break;
end;
end;
end;

function TUserCastle.CanGetCastle(Guild: TGUild): Boolean; //004911D0
var
i: Integer;
List14: TList;
PlayObject: TPlayObject;
begin
Result := False;
if (GetTickCount - m_dwStartCastleWarTick) > g_Config.dwGetCastleTime {10 * 60 * 1000} then begin
List14 := TList.Create;
UserEngine.GetMapRageHuman(m_MapPalace, 0, 0, 1000, List14);
Result := True;
for i := 0 to List14.Count - 1 do begin
PlayObject := TPlayObject(List14.Items[i]);
if not PlayObject.m_boDeath and (PlayObject.m_MyGuild <> Guild) then begin
Result := False;
break;
end;
end;
List14.Free;
end;
end;

procedure TUserCastle.GetCastle(Guild: TGUild);
var
OldGuild: TGUild;
s10: string;
resourcestring
sGetCastleMsg = '[%s 已被 %s 占领]';
begin
OldGuild := m_MasterGuild;
m_MasterGuild := Guild;
m_sOwnGuild := Guild.sGuildName;
m_ChangeDate := Now();
SaveConfigFile();
if OldGuild <> nil then OldGuild.RefMemberName;
if m_MasterGuild <> nil then m_MasterGuild.RefMemberName;
s10 := format(sGetCastleMsg, [m_sName, m_sOwnGuild]);
UserEngine.SendBroadCastMsgExt(s10, t_System);
UserEngine.SendServerGroupMsg(SS_204, nServerIndex, s10);
MainOutMessage(s10);
end;

procedure TUserCastle.StartWallconquestWar; //00491074
var
ListC: TList;
i: Integer;
PlayObject: TPlayObject;
begin
ListC := TList.Create;
UserEngine.GetMapRageHuman(m_MapPalace, m_nHomeX, m_nHomeY, 100, ListC);
for i := 0 to ListC.Count - 1 do begin
PlayObject := TPlayObject(ListC.Items[i]);
PlayObject.RefShowName();
end;
ListC.Free;
end;

procedure TUserCastle.StopWallconquestWar;
var
i: Integer;
ListC: TList;
PlayObject: TPlayObject;
s14: string;
resourcestring
sWallWarStop = '[%s 攻城战已经结束]';
begin
m_boUnderWar := False;
m_AttackGuildList.Clear;
{ListC := TList.Create;
//UserEngine.GetMapOfRangeHumanCount(m_MapCastle, m_nHomeX, m_nHomeY, 100);
UserEngine.GetMapRageHuman(m_MapPalace, m_nHomeX, m_nHomeY, 100, ListC);
for i := 0 to ListC.Count - 1 do begin
PlayObject := TPlayObject(ListC.Items[i]);
PlayObject.ChangePKStatus(False);
if PlayObject.m_MyGuild <> m_MasterGuild then
PlayObject.MapRandomMove(PlayObject.m_sHomeMap, 0);
end;
ListC.Free; }
s14 := format(sWallWarStop, [m_sName]);
UserEngine.SendBroadCastMsgExt(s14, t_System);
UserEngine.SendServerGroupMsg(SS_204, nServerIndex, s14);
MainOutMessage(s14);
end;

function TUserCastle.InPalaceGuildCount: Integer; //修正GM在皇宫不提示攻城结束
{var
i: Integer;
ListC: TList;
PlayObject: TPlayObject;
OldGuild: TGUild;
nCount: Integer;}
begin
{Result := 0;
OldGuild := nil;
nCount := 0;
ListC := TList.Create;
UserEngine.GetMapRageHuman(m_MapPalace, 0, 0, 1000, ListC);
for i := 0 to ListC.Count - 1 do begin
PlayObject := TPlayObject(ListC.Items[i]);
if (not PlayObject.m_boDeath) and ((OldGuild = nil) or (OldGuild <> TGUild(PlayObject.m_MyGuild))) and (PlayObject.m_btPermission < 10) then begin
OldGuild := TGUild(PlayObject.m_MyGuild);
Inc(nCount);
end;
end;
ListC.Free;
Result := nCount; }
Result := m_AttackGuildList.Count;
end;

function TUserCastle.IsDefenseAllyGuild(Guild: TGUild): Boolean;
begin
Result := False;
if not m_boUnderWar then Exit; //如果未开始攻城，则无效
if m_MasterGuild <> nil then
Result := m_MasterGuild.IsAllyGuild(Guild);
end;

//检查是否为守城方行会
function TUserCastle.IsDefenseGuild(Guild: TGUild): Boolean;
begin
Result := False;
if not m_boUnderWar then Exit; //如果未开始攻城，则无效
if Guild = m_MasterGuild then Result := True;
end;

function TUserCastle.IsMasterGuild(Guild: TGUild): Boolean; //00490400
begin
Result := False;
if (m_MasterGuild <> nil) and (m_MasterGuild = Guild) then
Result := True;
end;

function TUserCastle.GetHomeX: Integer; //004902B0
begin
Result := (m_nHomeX - 4) + Random(9);
end;

function TUserCastle.GetHomeY: Integer; //004902D8
begin
Result := (m_nHomeY - 4) + Random(9);
end;

function TUserCastle.GetMapName: string; //00490290
begin
Result := m_sMapName;
end;

function TUserCastle.CheckInPalace(nX, nY: Integer; Cert: TBaseObject): Boolean; //490300
var
ObjUnit: pTObjUnit;
begin
Result := IsMasterGuild(TGUild(Cert.m_MyGuild));
if Result then Exit;
ObjUnit := @m_LeftWall;
if (ObjUnit.BaseObject <> nil) and
(ObjUnit.BaseObject.m_boDeath) and
(ObjUnit.BaseObject.m_nCurrX = nX) and
(ObjUnit.BaseObject.m_nCurrY = nY) then begin
Result := True;
end;
ObjUnit := @m_CenterWall;
if (ObjUnit.BaseObject <> nil) and
(ObjUnit.BaseObject.m_boDeath) and
(ObjUnit.BaseObject.m_nCurrX = nX) and
(ObjUnit.BaseObject.m_nCurrY = nY) then begin
Result := True;
end;
ObjUnit := @m_RightWall;
if (ObjUnit.BaseObject <> nil) and
(ObjUnit.BaseObject.m_boDeath) and
(ObjUnit.BaseObject.m_nCurrX = nX) and
(ObjUnit.BaseObject.m_nCurrY = nY) then begin
Result := True;
end;
end;

function TUserCastle.GetWarDate: string;
var
AttackerInfo: pTAttackerInfo;
Year: Word;
Month: Word;
Day: Word;
resourcestring
sMsg = '%d年%d月%d日';
begin
Result := '';
if m_AttackWarList.Count <= 0 then Exit;
AttackerInfo := m_AttackWarList.Items[0];
DecodeDate(AttackerInfo.AttackDate, Year, Month, Day);
Result := format(sMsg, [Year, Month, Day]);
end;

function TUserCastle.GetAttackWarList: string;
var
i, n10: Integer;
AttackerInfo: pTAttackerInfo;
Year, Month, Day: Word;
wYear, wMonth, wDay: Word;
s20: string;
begin
Result := '';
wYear := 0;
wMonth := 0;
wDay := 0;
n10 := 0;
for i := 0 to m_AttackWarList.Count - 1 do begin
AttackerInfo := m_AttackWarList.Items[i];
DecodeDate(AttackerInfo.AttackDate, Year, Month, Day);
if (Year <> wYear) or (Month <> wMonth) or (Day <> wDay) then begin
wYear := Year;
wMonth := Month;
wDay := Day;
if Result <> '' then
Result := Result + '\';
Result := Result + IntToStr(wYear) + '年' + IntToStr(wMonth) + '月' + IntToStr(wDay) + '日\';
n10 := 0;
end;
if n10 > 40 then begin
Result := Result + '\';
n10 := 0;
end;
s20 := '"' + AttackerInfo.sGuildName + '"';
Inc(n10, Length(s20));
Result := Result + s20;
end; // for
end;

procedure TUserCastle.IncRateGold(nGold: Integer); //004904C4
var
nInGold: Integer;
begin
nInGold := ROUND(nGold * (g_Config.nCastleTaxRate / 100) {0.05});
if (m_nTodayIncome + nInGold) <= g_Config.nCastleOneDayGold then begin
Inc(m_nTodayIncome, nInGold);
end else begin
if m_nTodayIncome >= g_Config.nCastleOneDayGold then begin
nInGold := 0;
end else begin
nInGold := g_Config.nCastleOneDayGold - m_nTodayIncome;
m_nTodayIncome := g_Config.nCastleOneDayGold;
end;
end;
if nInGold > 0 then begin
if (m_nTotalGold + nInGold) < g_Config.nCastleGoldMax then begin
Inc(m_nTotalGold, nInGold);
end else begin
m_nTotalGold := g_Config.nCastleGoldMax;
end;
end;
if (GetTickCount - m_dwSaveTick) > 10 * 60 * 1000 then begin
m_dwSaveTick := GetTickCount();
if g_boGameLogGold then
AddGameDataLog('23' + #9 +
'0' + #9 +
'0' + #9 +
'0' + #9 +
'autosave' + #9 +
sSTRING_GOLDNAME + #9 +
IntToStr(m_nTotalGold) + #9 +
'1' + #9 +
'0');
end;
end;

function TUserCastle.WithDrawalGolds(PlayObject: TPlayObject; nGold: Integer): Integer; //0049066C
begin
Result := -1;
if nGold <= 0 then begin
Result := -4;
Exit;
end;
if (m_MasterGuild = PlayObject.m_MyGuild) and (PlayObject.m_nGuildRankNo = 1) and (nGold > 0) then begin
if (nGold > 0) and (nGold <= m_nTotalGold) then begin
if (PlayObject.m_nGold + nGold) <= PlayObject.m_nGoldMax then begin
Dec(m_nTotalGold, nGold);
PlayObject.IncGold(nGold);
//004907C8
if g_boGameLogGold then
AddGameDataLog('22' + #9 +
PlayObject.m_sMapName + #9 +
IntToStr(PlayObject.m_nCurrX) + #9 +
IntToStr(PlayObject.m_nCurrY) + #9 +
PlayObject.m_sCharName + #9 +
sSTRING_GOLDNAME + #9 +
IntToStr(nGold) + #9 +
'1' + #9 +
'0');
PlayObject.GoldChanged;
Result := 1;
end else Result := -3;
end else Result := -2;
end;
end;

function TUserCastle.ReceiptGolds(PlayObject: TPlayObject; nGold: Integer): Integer; //00490864
begin
Result := -1;
if nGold <= 0 then begin
Result := -4;
Exit;
end;
if (m_MasterGuild = PlayObject.m_MyGuild) and (PlayObject.m_nGuildRankNo = 1) and (nGold > 0) then begin
if (nGold <= PlayObject.m_nGold) then begin
if (m_nTotalGold + nGold) <= g_Config.nCastleGoldMax then begin
Dec(PlayObject.m_nGold, nGold);
Inc(m_nTotalGold, nGold);
if g_boGameLogGold then
AddGameDataLog('23' + #9 +
PlayObject.m_sMapName + #9 +
IntToStr(PlayObject.m_nCurrX) + #9 +
IntToStr(PlayObject.m_nCurrY) + #9 +
PlayObject.m_sCharName + #9 +
sSTRING_GOLDNAME + #9 +
IntToStr(nGold) + #9 +
'1' + #9 +
'0');
PlayObject.GoldChanged;
Result := 1;
end else Result := -3;
end else Result := -2;
end;
end;

procedure TUserCastle.MainDoorControl(boClose: Boolean); //00490460
begin
if (m_MainDoor.BaseObject <> nil) and not m_MainDoor.BaseObject.m_boGhost then begin
if boClose then begin
if TCastleDoor(m_MainDoor.BaseObject).m_boOpened then TCastleDoor(m_MainDoor.BaseObject).Close;
end else begin
if not TCastleDoor(m_MainDoor.BaseObject).m_boOpened then TCastleDoor(m_MainDoor.BaseObject).Open;
end;
end;
end;

function TUserCastle.RepairDoor(): Boolean; //00490A70
var
CastleDoor: pTObjUnit;
begin
Result := False;
CastleDoor := @m_MainDoor;
if (CastleDoor.BaseObject = nil) or
(m_boUnderWar) or
(CastleDoor.BaseObject.m_WAbil.HP >= CastleDoor.BaseObject.m_WAbil.MaxHP) then begin
Exit;
end;
if not CastleDoor.BaseObject.m_boDeath then begin
if (GetTickCount - CastleDoor.BaseObject.m_dwStruckTick) > 60 * 1000 then begin
CastleDoor.BaseObject.m_WAbil.HP := CastleDoor.BaseObject.m_WAbil.MaxHP;
TCastleDoor(CastleDoor.BaseObject).RefStatus();
Result := True;
end;
end else begin
if (GetTickCount - CastleDoor.BaseObject.m_dwStruckTick) > 60 * 1000 then begin
CastleDoor.BaseObject.m_WAbil.HP := CastleDoor.BaseObject.m_WAbil.MaxHP;
CastleDoor.BaseObject.m_boDeath := False;
TCastleDoor(CastleDoor.BaseObject).m_boOpened := False;
TCastleDoor(CastleDoor.BaseObject).RefStatus();
Result := True;
end;
end;
end;

function TUserCastle.RepairWall(nWallIndex: Integer): Boolean; //00490B78
var
Wall: TBaseObject;
begin
Result := False;
Wall := nil;
case nWallIndex of
1: Wall := m_LeftWall.BaseObject;
2: Wall := m_CenterWall.BaseObject;
3: Wall := m_RightWall.BaseObject;
end;
if (Wall = nil) or
(m_boUnderWar) or
(Wall.m_WAbil.HP >= Wall.m_WAbil.MaxHP) then begin
Exit;
end;
if not Wall.m_boDeath then begin
if (GetTickCount - Wall.m_dwStruckTick) > 60 * 1000 then begin
Wall.m_WAbil.HP := Wall.m_WAbil.MaxHP;
TWallStructure(Wall).RefStatus();
Result := True;
end;
end else begin
if (GetTickCount - Wall.m_dwStruckTick) > 60 * 1000 then begin
Wall.m_WAbil.HP := Wall.m_WAbil.MaxHP;
Wall.m_boDeath := False;
TWallStructure(Wall).RefStatus();
Result := True;
end;
end;
end;
function TUserCastle.AddAttackerInfo(Guild: TGUild): Boolean; //00490CD8
var
AttackerInfo: pTAttackerInfo;
begin
Result := False;
if InAttackerList(Guild) then Exit;
New(AttackerInfo);
AttackerInfo.AttackDate := AddDateTimeOfDay(Now, g_Config.nStartCastleWarDays);
AttackerInfo.sGuildName := Guild.sGuildName;
AttackerInfo.Guild := Guild;
m_AttackWarList.Add(AttackerInfo);
SaveAttackSabukWall();
UserEngine.SendServerGroupMsg(SS_212, nServerIndex, '');
Result := True;
end;

function TUserCastle.InAttackerList(Guild: TGUild): Boolean; //00490C84
var
i: Integer;
begin
Result := False;
for i := 0 to m_AttackWarList.Count - 1 do begin
if pTAttackerInfo(m_AttackWarList.Items[i]).Guild = Guild then begin
Result := True;
break;
end;
end;
end;

function TUserCastle.m_nChiefItemCount: Integer;
begin

end;

procedure TUserCastle.SetPower(nPower: Integer);
begin
m_nPower := nPower;
end;

procedure TUserCastle.SetTechLevel(nLevel: Integer);
begin
m_nTechLevel := nLevel;
end;

{ TCastleManager }

constructor TCastleManager.Create;
begin
m_CastleList := TList.Create;
InitializeCriticalSection(CriticalSection);
end;

destructor TCastleManager.Destroy;
var
i: Integer;
UserCastle: TUserCastle;
begin
for i := 0 to m_CastleList.Count - 1 do begin
UserCastle := TUserCastle(m_CastleList.Items[i]);
UserCastle.Save;
UserCastle.Free;
end;
m_CastleList.Free;
DeleteCriticalSection(CriticalSection);
inherited;
end;

function TCastleManager.Find(sCASTLENAME: string): TUserCastle;
var
i: Integer;
Castle: TUserCastle;
begin
Result := nil;
for i := 0 to m_CastleList.Count - 1 do begin
Castle := TUserCastle(m_CastleList.Items[i]);
if CompareText(Castle.m_sName, sCASTLENAME) = 0 then begin
Result := Castle;
break;
end;
end;
end;

//取得角色所在座标的城堡
function TCastleManager.InCastleWarArea(
BaseObject: TBaseObject): TUserCastle;
var
i: Integer;
Castle: TUserCastle;
begin
Result := nil;
for i := 0 to m_CastleList.Count - 1 do begin
Castle := TUserCastle(m_CastleList.Items[i]);
if Castle.InCastleWarArea(BaseObject.m_PEnvir, BaseObject.m_nCurrX, BaseObject.m_nCurrY) then begin
Result := Castle;
break;
end;
end;
end;

function TCastleManager.InCastleWarArea(Envir: TEnvirnoment; nX,
nY: Integer): TUserCastle;
var
i: Integer;
Castle: TUserCastle;
begin
Result := nil;
for i := 0 to m_CastleList.Count - 1 do begin
Castle := TUserCastle(m_CastleList.Items[i]);
if Castle.InCastleWarArea(Envir, nX, nY) then begin
Result := Castle;
break;
end;
end;
end;

procedure TCastleManager.Initialize;
var
i: Integer;
Castle: TUserCastle;
begin
if m_CastleList.Count <= 0 then begin
Castle := TUserCastle.Create(g_Config.sCastleDir);
m_CastleList.Add(Castle);
Castle.Initialize;
Castle.m_sConfigDir := '0';
Castle.m_EnvirList.Add('0151');
Castle.m_EnvirList.Add('0152');
Castle.m_EnvirList.Add('0153');
Castle.m_EnvirList.Add('0154');
Castle.m_EnvirList.Add('0155');
Castle.m_EnvirList.Add('0156');
for i := 0 to Castle.m_EnvirList.Count - 1 do begin
Castle.m_EnvirList.Objects[i] := g_MapManager.FindMap(Castle.m_EnvirList.Strings[i]);
end;
Save();
Exit;
end;

for i := 0 to m_CastleList.Count - 1 do begin
Castle := TUserCastle(m_CastleList.Items[i]);
Castle.Initialize;
end;
end;
//城堡皇宫所在地图
function TCastleManager.IsCastlePalaceEnvir(Envir: TEnvirnoment): TUserCastle;
var
i: Integer;
Castle: TUserCastle;
begin
Result := nil;
for i := 0 to m_CastleList.Count - 1 do begin
Castle := TUserCastle(m_CastleList.Items[i]);
if Castle.m_MapPalace = Envir then begin
Result := Castle;
break;
end;
end;
end;
//城堡所在地图
function TCastleManager.IsCastleEnvir(Envir: TEnvirnoment): TUserCastle;
var
i: Integer;
Castle: TUserCastle;
begin
Result := nil;
for i := 0 to m_CastleList.Count - 1 do begin
Castle := TUserCastle(m_CastleList.Items[i]);
if Castle.m_MapCastle = Envir then begin
Result := Castle;
break;
end;
end;
end;

function TCastleManager.IsCastleMember(
BaseObject: TBaseObject): TUserCastle;
var
i: Integer;
Castle: TUserCastle;
begin
Result := nil;
for i := 0 to m_CastleList.Count - 1 do begin
Castle := TUserCastle(m_CastleList.Items[i]);
if Castle.IsMember(BaseObject) then begin
Result := Castle;
break;
end;
end;
end;

procedure TCastleManager.Run;
var
i: Integer;
UserCastle: TUserCastle;
begin
Lock;
try
for i := 0 to m_CastleList.Count - 1 do begin
UserCastle := TUserCastle(m_CastleList.Items[i]);
UserCastle.Run;
end;
finally
UnLock;
end;
end;

procedure TCastleManager.GetCastleGoldInfo(List: TStringList);
var
i: Integer;
Castle: TUserCastle;
begin
for i := 0 to m_CastleList.Count - 1 do begin
Castle := TUserCastle(m_CastleList.Items[i]);
List.Add(format(g_sGameCommandSbkGoldShowMsg, [Castle.m_sName, Castle.m_nTotalGold, Castle.m_nTodayIncome]));
end;
end;

procedure TCastleManager.Save;
var
i: Integer;
Castle: TUserCastle;
begin
SaveCastleList();
for i := 0 to m_CastleList.Count - 1 do begin
Castle := TUserCastle(m_CastleList.Items[i]);
Castle.Save;
end;
end;

procedure TCastleManager.LoadCastleList;
var
LoadList: TStringList;
Castle: TUserCastle;
sCastleDir: string;
i: Integer;
begin
if FileExists(g_Config.sCastleFile) then begin
LoadList := TStringList.Create;
LoadList.LoadFromFile(g_Config.sCastleFile);
for i := 0 to LoadList.Count - 1 do begin
sCastleDir := Trim(LoadList.Strings[i]);
if sCastleDir <> '' then begin
Castle := TUserCastle.Create(sCastleDir);
m_CastleList.Add(Castle);
end;
end;
LoadList.Free;
MainOutMessage('已读取 ' + IntToStr(m_CastleList.Count) + '个城堡信息...');
end else begin
MainOutMessage('城堡列表文件未找到！！！');
end;
end;

procedure TCastleManager.SaveCastleList;
var
i: Integer;
LoadList: TStringList;
begin
if not DirectoryExists(g_Config.sCastleDir) then begin
CreateDir(g_Config.sCastleDir);
end;
LoadList := TStringList.Create;
for i := 0 to m_CastleList.Count - 1 do begin
LoadList.Add(IntToStr(i));
end;
LoadList.SaveToFile(g_Config.sCastleFile);
LoadList.Free;
end;

function TCastleManager.GetCastle(nIndex: Integer): TUserCastle;
begin
Result := nil;
if (nIndex >= 0) and (nIndex < m_CastleList.Count) then
Result := TUserCastle(m_CastleList.Items[nIndex]);
end;

procedure TCastleManager.GetCastleNameList(List: TStringList);
var
i: Integer;
Castle: TUserCastle;
begin
for i := 0 to m_CastleList.Count - 1 do begin
Castle := TUserCastle(m_CastleList.Items[i]);
List.Add(Castle.m_sName);
end;
end;

procedure TCastleManager.IncRateGold(nGold: Integer);
var
i: Integer;
Castle: TUserCastle;
begin
Lock;
try
for i := 0 to m_CastleList.Count - 1 do begin
Castle := TUserCastle(m_CastleList.Items[i]);
Castle.IncRateGold(nGold);
end;
finally
UnLock;
end;
end;

procedure TCastleManager.Lock;
begin
EnterCriticalSection(CriticalSection);
end;

procedure TCastleManager.UnLock;
begin
LeaveCriticalSection(CriticalSection);
end;

end.

**hujiacheng** · 10-12-07

CastleManage.pas
unit CastleManage;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, Spin, Guild, Castle;

type
TfrmCastleManage = class(TForm)
GroupBox1: TGroupBox;
ListViewCastle: TListView;
GroupBox2: TGroupBox;
PageControlCastle: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
GroupBox3: TGroupBox;
Label2: TLabel;
EditOwenGuildName: TEdit;
GroupBox4: TGroupBox;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
EditCastleName: TEdit;
EditCastleOfGuild: TEdit;
EditHomeMap: TEdit;
Label1: TLabel;
Label3: TLabel;
EditTotalGold: TSpinEdit;
EditTodayIncome: TSpinEdit;
Label7: TLabel;
EditTechLevel: TSpinEdit;
Label8: TLabel;
EditPower: TSpinEdit;
TabSheet3: TTabSheet;
GroupBox5: TGroupBox;
ListViewGuard: TListView;
ButtonRefresh: TButton;
TabSheet4: TTabSheet;
GroupBox6: TGroupBox;
ListViewAttackSabukWall: TListView;
ButtonAttackAd: TButton;
ButtonAttackEdit: TButton;
ButtonAttackDel: TButton;
ButtonAttackR: TButton;
Label9: TLabel;
Label10: TLabel;
EditTunnelMap: TEdit;
Label11: TLabel;
EditPalace: TEdit;
SpinEditNomeX: TSpinEdit;
SpinEditNomeY: TSpinEdit;
ButtonSave: TButton;
procedure ListViewCastleClick(Sender: TObject);
procedure ButtonRefreshClick(Sender: TObject);
procedure ButtonAttackAdClick(Sender: TObject);
procedure ButtonAttackEditClick(Sender: TObject);
procedure ListViewAttackSabukWallClick(Sender: TObject);
procedure ButtonAttackRClick(Sender: TObject);
procedure ButtonAttackDelClick(Sender: TObject);
procedure ButtonSaveClick(Sender: TObject);
private
procedure RefCastleList;
procedure RefCastleInfo;
procedure RefCastleAttackSabukWall;
{ Private declarations }
public
procedure Open();
function InListOfGuildName(sGuildName: string): TGuild;
function AddAttackSabukWallOfGuild(sGuildName: string; AttackSabukWall: TDate): Boolean;
function ChgAttackSabukWallOfGuild(sGuildName: string; AttackSabukWall: TDate): Boolean;
function IsAttackSabukWallOfGuild(sGuildName: string; AttackDate: TDate): Boolean;
{ Public declarations }
end;

var
frmCastleManage: TfrmCastleManage;
nCount: Integer;
CurCastle: TUserCastle;
implementation

uses AttackSabukWallConfig, M2Share;

{$R *.dfm}
var
boRefing: Boolean;
SelAttackGuildInfo: pTAttackerInfo;
{ TfrmCastleManage }

procedure TfrmCastleManage.Open;
begin
nCount := 0;
ButtonSave.Enabled := True;
SelAttackGuildInfo := nil;
RefCastleList();
ShowModal;
end;

procedure TfrmCastleManage.RefCastleInfo;
var
i, ii: Integer;
ListItem: TListItem;
ObjUnit: pTObjUnit;
begin
if CurCastle = nil then Exit;
boRefing := True;
if CurCastle.m_MasterGuild = nil then EditOwenGuildName.Text := ''
else EditOwenGuildName.Text := CurCastle.m_MasterGuild.sGuildName;
EditTotalGold.Value := CurCastle.m_nTotalGold;
EditTodayIncome.Value := CurCastle.m_nTodayIncome;
EditTechLevel.Value := CurCastle.m_nTechLevel;
EditPower.Value := CurCastle.m_nPower;
ListViewGuard.Clear;
ListItem := ListViewGuard.Items.Add;
ListItem.Caption := '0';
if CurCastle.m_MainDoor.BaseObject <> nil then begin
ListItem.SubItems.Add(CurCastle.m_MainDoor.BaseObject.m_sCharName);
ListItem.SubItems.Add(format('%d:%d', [CurCastle.m_MainDoor.BaseObject.m_nCurrX, CurCastle.m_MainDoor.BaseObject.m_nCurrY]));
ListItem.SubItems.Add(format('%d/%d', [CurCastle.m_MainDoor.BaseObject.m_WAbil.HP, CurCastle.m_MainDoor.BaseObject.m_WAbil.MaxHP]));
if CurCastle.m_MainDoor.BaseObject.m_boDeath then begin
ListItem.SubItems.Add('损坏');
end else
if (CurCastle.m_DoorStatus <> nil) and CurCastle.m_DoorStatus.boOpened then begin
ListItem.SubItems.Add('开启');
end else begin
ListItem.SubItems.Add('关闭');
end;
end else begin
ListItem.SubItems.Add(CurCastle.m_MainDoor.sName);
ListItem.SubItems.Add(format('%d:%d', [CurCastle.m_MainDoor.nX, CurCastle.m_MainDoor.nY]));
ListItem.SubItems.Add(format('%d/%d', [0, 0]));
end;

ListItem := ListViewGuard.Items.Add;
ListItem.Caption := '1';
if CurCastle.m_LeftWall.BaseObject <> nil then begin
ListItem.SubItems.Add(CurCastle.m_LeftWall.BaseObject.m_sCharName);
ListItem.SubItems.Add(format('%d:%d', [CurCastle.m_LeftWall.BaseObject.m_nCurrX, CurCastle.m_LeftWall.BaseObject.m_nCurrY]));
ListItem.SubItems.Add(format('%d/%d', [CurCastle.m_LeftWall.BaseObject.m_WAbil.HP, CurCastle.m_LeftWall.BaseObject.m_WAbil.MaxHP]));
end else begin
ListItem.SubItems.Add(CurCastle.m_LeftWall.sName);
ListItem.SubItems.Add(format('%d:%d', [CurCastle.m_LeftWall.nX, CurCastle.m_LeftWall.nY]));
ListItem.SubItems.Add(format('%d/%d', [0, 0]));
end;

ListItem := ListViewGuard.Items.Add;
ListItem.Caption := '2';
if CurCastle.m_CenterWall.BaseObject <> nil then begin
ListItem.SubItems.Add(CurCastle.m_CenterWall.BaseObject.m_sCharName);
ListItem.SubItems.Add(format('%d:%d', [CurCastle.m_CenterWall.BaseObject.m_nCurrX, CurCastle.m_CenterWall.BaseObject.m_nCurrY]));
ListItem.SubItems.Add(format('%d/%d', [CurCastle.m_CenterWall.BaseObject.m_WAbil.HP, CurCastle.m_CenterWall.BaseObject.m_WAbil.MaxHP]));
end else begin
ListItem.SubItems.Add(CurCastle.m_CenterWall.sName);
ListItem.SubItems.Add(format('%d:%d', [CurCastle.m_CenterWall.nX, CurCastle.m_CenterWall.nY]));
ListItem.SubItems.Add(format('%d/%d', [0, 0]));
end;

ListItem := ListViewGuard.Items.Add;
ListItem.Caption := '3';
if CurCastle.m_RightWall.BaseObject <> nil then begin
ListItem.SubItems.Add(CurCastle.m_RightWall.BaseObject.m_sCharName);
ListItem.SubItems.Add(format('%d:%d', [CurCastle.m_RightWall.BaseObject.m_nCurrX, CurCastle.m_RightWall.BaseObject.m_nCurrY]));
ListItem.SubItems.Add(format('%d/%d', [CurCastle.m_RightWall.BaseObject.m_WAbil.HP, CurCastle.m_RightWall.BaseObject.m_WAbil.MaxHP]));
end else begin
ListItem.SubItems.Add(CurCastle.m_RightWall.sName);
ListItem.SubItems.Add(format('%d:%d', [CurCastle.m_RightWall.nX, CurCastle.m_RightWall.nY]));
ListItem.SubItems.Add(format('%d/%d', [0, 0]));
end;
for i := Low(CurCastle.m_Archer) to High(CurCastle.m_Archer) do begin
ObjUnit := @CurCastle.m_Archer[i];
ListItem := ListViewGuard.Items.Add;
ListItem.Caption := IntToStr(i + 4);
if ObjUnit.BaseObject <> nil then begin
ListItem.SubItems.Add(ObjUnit.BaseObject.m_sCharName);
ListItem.SubItems.Add(format('%d:%d', [ObjUnit.BaseObject.m_nCurrX, ObjUnit.BaseObject.m_nCurrY]));
ListItem.SubItems.Add(format('%d/%d', [ObjUnit.BaseObject.m_WAbil.HP, ObjUnit.BaseObject.m_WAbil.MaxHP]));
end else begin
ListItem.SubItems.Add(ObjUnit.sName);
ListItem.SubItems.Add(format('%d:%d', [ObjUnit.nX, ObjUnit.nY]));
ListItem.SubItems.Add(format('%d/%d', [0, 0]));
end;
end;
for ii := Low(CurCastle.m_Guard) to High(CurCastle.m_Guard) do begin
ObjUnit := @CurCastle.m_Guard[ii];
ListItem := ListViewGuard.Items.Add;
ListItem.Caption := IntToStr(i + 4);
if ObjUnit.BaseObject <> nil then begin
ListItem.SubItems.Add(ObjUnit.BaseObject.m_sCharName);
ListItem.SubItems.Add(format('%d:%d', [ObjUnit.BaseObject.m_nCurrX, ObjUnit.BaseObject.m_nCurrY]));
ListItem.SubItems.Add(format('%d/%d', [ObjUnit.BaseObject.m_WAbil.HP, ObjUnit.BaseObject.m_WAbil.MaxHP]));
end else begin
ListItem.SubItems.Add(ObjUnit.sName);
ListItem.SubItems.Add(format('%d:%d', [ObjUnit.nX, ObjUnit.nY]));
ListItem.SubItems.Add(format('%d/%d', [0, 0]));
end;
end;
EditCastleName.Text := CurCastle.m_sName;
if CurCastle.m_MasterGuild <> nil then
EditCastleOfGuild.Text := CurCastle.m_MasterGuild.sGuildName
else EditCastleOfGuild.Text := '';
EditPalace.Text := CurCastle.m_sPalaceMap;
EditHomeMap.Text := CurCastle.m_sHomeMap;
SpinEditNomeX.Value := CurCastle.m_nHomeX;
SpinEditNomeY.Value := CurCastle.m_nHomeY;
EditTunnelMap.Text := CurCastle.m_sSecretMap;
RefCastleAttackSabukWall;
boRefing := False;
end;

procedure TfrmCastleManage.RefCastleList;
var
i: Integer;
UserCastle: TUserCastle;
ListItem: TListItem;
begin
g_CastleManager.Lock;
try
for i := 0 to g_CastleManager.m_CastleList.Count - 1 do begin
UserCastle := TUserCastle(g_CastleManager.m_CastleList.Items[i]);
ListItem := ListViewCastle.Items.Add;
ListItem.Caption := IntToStr(i);
ListItem.SubItems.AddObject(UserCastle.m_sConfigDir, UserCastle);
ListItem.SubItems.Add(UserCastle.m_sName)
end;
finally
g_CastleManager.UnLock;
end;
end;

procedure TfrmCastleManage.RefCastleAttackSabukWall;
var
i: Integer;
ListItem: TListItem;
AttackerInfo, NewAttackerInfo: pTAttackerInfo;
begin
nCount := 0;
ListViewAttackSabukWall.Items.Clear;
ListViewAttackSabukWall.Items.BeginUpdate;
try
for i := 0 to CurCastle.m_AttackWarList.Count - 1 do begin
AttackerInfo := pTAttackerInfo(CurCastle.m_AttackWarList.Items[i]);
ListItem := ListViewAttackSabukWall.Items.Add;
if AttackerInfo <> nil then begin
ListItem.Caption := IntToStr(nCount);
ListItem.SubItems.AddObject(AttackerInfo.sGuildName, TObject(AttackerInfo));
ListItem.SubItems.Add(DateToStr(AttackerInfo.AttackDate));
Inc(nCount);
end;
end;
finally
ListViewAttackSabukWall.Items.EndUpdate;
end;
end;

procedure TfrmCastleManage.ListViewCastleClick(Sender: TObject);
var
ListItem: TListItem;
begin
ListItem := ListViewCastle.Selected;
if ListItem = nil then Exit;
CurCastle := TUserCastle(ListItem.SubItems.Objects[0]);
RefCastleInfo();
end;

procedure TfrmCastleManage.ButtonRefreshClick(Sender: TObject);
begin
RefCastleInfo();
end;

function TfrmCastleManage.InListOfGuildName(sGuildName: string): TGuild;
var
i: Integer;
Guild: TGuild;
begin
Result := nil;
for i := 0 to g_GuildManager.GuildList.Count - 1 do begin
Guild := TGuild(g_GuildManager.GuildList.Items[i]);
if CompareText(sGuildName, Guild.sGuildName) = 0 then begin
Result := Guild;
break;
end;
end;
end;

function TfrmCastleManage.AddAttackSabukWallOfGuild(sGuildName: string; AttackSabukWall: TDate): Boolean;
var
AttackerInfo: pTAttackerInfo;
Guild: TGuild;
ListItem: TListItem;
begin
Result := False;
Guild := nil;
Guild := InListOfGuildName(sGuildName);
if Guild = nil then begin
Application.MessageBox('输入的行会名不存在！！！', '提示信息', MB_ICONQUESTION);
Exit;
end;
if CurCastle = nil then Exit;
New(AttackerInfo);
AttackerInfo.AttackDate := AttackSabukWall;
AttackerInfo.sGuildName := sGuildName;
AttackerInfo.Guild := Guild;
CurCastle.m_AttackWarList.Add(AttackerInfo);
ListViewAttackSabukWall.Items.BeginUpdate;
try
ListItem := ListViewAttackSabukWall.Items.Add;
Inc(nCount);
ListItem.Caption := IntToStr(nCount);
ListItem.SubItems.AddObject(AttackerInfo.sGuildName, TObject(AttackerInfo));
ListItem.SubItems.Add(DateToStr(AttackerInfo.AttackDate));
CurCastle.Save;
Result := True;
finally
ListViewAttackSabukWall.Items.EndUpdate;
end;
end;
function TfrmCastleManage.IsAttackSabukWallOfGuild(sGuildName: string; AttackDate: TDate): Boolean;
var
i: Integer;
ListItem: TListItem;
AttackerInfo: pTAttackerInfo;
begin
Result := False;
for i := 0 to ListViewAttackSabukWall.Items.Count - 1 do begin
ListItem := ListViewAttackSabukWall.Items.Item[i];
AttackerInfo := pTAttackerInfo(ListItem.SubItems.Objects[0]);
if (CompareText(sGuildName, AttackerInfo.sGuildName) = 0) and (AttackerInfo.AttackDate = AttackDate) then begin
Result := True;
break;
end;
end;
end;

function TfrmCastleManage.ChgAttackSabukWallOfGuild(sGuildName: string; AttackSabukWall: TDate): Boolean;
var
AttackerInfo: pTAttackerInfo;
Guild: TGuild;
ListItem: TListItem;
i: Integer;
boFound: Boolean;
begin
Result := False;
Guild := nil;
boFound := False;
Guild := InListOfGuildName(sGuildName);
if Guild = nil then begin
Application.MessageBox('输入的行会名不存在！！！', '提示信息', MB_ICONQUESTION);
Exit;
end;
if CurCastle = nil then Exit;
for i := 0 to ListViewAttackSabukWall.Items.Count - 1 do begin
ListItem := ListViewAttackSabukWall.Items.Item[i];
AttackerInfo := pTAttackerInfo(ListItem.SubItems.Objects[0]);
if CompareText(sGuildName, AttackerInfo.sGuildName) = 0 then begin
AttackerInfo.AttackDate := AttackSabukWall;
AttackerInfo.sGuildName := sGuildName;
ListItem.SubItems.Strings[0] := sGuildName;
ListItem.SubItems.Strings[1] := DateToStr(AttackSabukWall);
CurCastle.Save;
boFound := True;
Result := True;
break;
end;
end;
if not boFound then Result := AddAttackSabukWallOfGuild(sGuildName, AttackSabukWall);
end;

procedure TfrmCastleManage.ButtonAttackAdClick(Sender: TObject);
begin
FrmAttackSabukWall := TFrmAttackSabukWall.Create(Owner);
FrmAttackSabukWall.Caption := '增加攻城申请';
nStute := 0;
FrmAttackSabukWall.Top := frmCastleManage.Top - 50;
FrmAttackSabukWall.Left := frmCastleManage.Left + 150;
FrmAttackSabukWall.Open();
FrmAttackSabukWall.Free;
end;

procedure TfrmCastleManage.ButtonAttackEditClick(Sender: TObject);
begin
if CurCastle = nil then Exit;
if SelAttackGuildInfo = nil then Exit;
FrmAttackSabukWall := TFrmAttackSabukWall.Create(Owner);
FrmAttackSabukWall.Caption := '编辑攻城申请';
nStute := 1;
FrmAttackSabukWall.Top := frmCastleManage.Top - 50;
FrmAttackSabukWall.Left := frmCastleManage.Left + 150;
m_sGuildName := SelAttackGuildInfo.sGuildName;
m_AttackDate := SelAttackGuildInfo.AttackDate;
FrmAttackSabukWall.Open();
FrmAttackSabukWall.Free;
end;

procedure TfrmCastleManage.ListViewAttackSabukWallClick(Sender: TObject);
var
ListItem: TListItem;
begin
try
ListItem := ListViewAttackSabukWall.Selected;
SelAttackGuildInfo := pTAttackerInfo(ListItem.SubItems.Objects[0]);
except
SelAttackGuildInfo := nil;
end;
end;

procedure TfrmCastleManage.ButtonAttackRClick(Sender: TObject);
begin
if CurCastle = nil then Exit;
RefCastleAttackSabukWall;
end;

procedure TfrmCastleManage.ButtonAttackDelClick(Sender: TObject);
var
i: Integer;
AttackerInfo: pTAttackerInfo;
begin
if CurCastle = nil then Exit;
if SelAttackGuildInfo = nil then Exit;
if Application.MessageBox(PChar('是否确认删除此行会攻城申请？' + #10#10 +
'行会名称：' + SelAttackGuildInfo.sGuildName + #10 +
'攻城时间：' + DateToStr(SelAttackGuildInfo.AttackDate)), '确认信息', MB_YESNO + MB_ICONQUESTION) = IDYES then begin
for i := 0 to CurCastle.m_AttackWarList.Count - 1 do begin
AttackerInfo := pTAttackerInfo(CurCastle.m_AttackWarList.Items[i]);
if AttackerInfo = SelAttackGuildInfo then begin
CurCastle.m_AttackWarList.Delete(i);
CurCastle.Save;
break;
end;
end;
try
ListViewAttackSabukWall.DeleteSelected;
except
end;
end;
end;

procedure TfrmCastleManage.ButtonSaveClick(Sender: TObject);
begin
if CurCastle = nil then Exit;
CurCastle.m_sHomeMap := EditHomeMap.Text;
CurCastle.m_sPalaceMap := EditPalace.Text;
CurCastle.m_sHomeMap := EditHomeMap.Text;
CurCastle.m_nHomeX := SpinEditNomeX.Value;
CurCastle.m_nHomeY := SpinEditNomeY.Value;
CurCastle.m_sSecretMap := EditTunnelMap.Text;
CurCastle.Save;
ButtonSave.Enabled := False;
end;

end.

**hujiacheng** · 10-12-07

ConfigMerchant.pas
unit ConfigMerchant;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin, ObjNpc;

type
TfrmConfigMerchant = class(TForm)
GroupBoxNPC: TGroupBox;
Label2: TLabel;
EditScriptName: TEdit;
Label3: TLabel;
EditMapName: TEdit;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
EditShowName: TEdit;
Label7: TLabel;
Label8: TLabel;
CheckBoxOfCastle: TCheckBox;
ComboBoxDir: TComboBox;
EditImageIdx: TSpinEdit;
EditX: TSpinEdit;
EditY: TSpinEdit;
GroupBoxScript: TGroupBox;
MemoScript: TMemo;
ButtonScriptSave: TButton;
GroupBox3: TGroupBox;
CheckBoxBuy: TCheckBox;
CheckBoxSell: TCheckBox;
CheckBoxStorage: TCheckBox;
CheckBoxGetback: TCheckBox;
CheckBoxMakedrug: TCheckBox;
CheckBoxUpgradenow: TCheckBox;
CheckBoxGetbackupgnow: TCheckBox;
CheckBoxRepair: TCheckBox;
CheckBoxS_repair: TCheckBox;
ButtonReLoadNpc: TButton;
ButtonSave: TButton;
CheckBoxDenyRefStatus: TCheckBox;
Label9: TLabel;
EditPriceRate: TSpinEdit;
Label10: TLabel;
EditMapDesc: TEdit;
CheckBoxSendMsg: TCheckBox;
CheckBoxAutoMove: TCheckBox;
Label11: TLabel;
EditMoveTime: TSpinEdit;
ButtonClearTempData: TButton;
ButtonViewData: TButton;
GroupBox1: TGroupBox;
ListBoxMerChant: TListBox;
procedure ListBoxMerChantClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ButtonSaveClick(Sender: TObject);
procedure CheckBoxDenyRefStatusClick(Sender: TObject);
procedure EditXChange(Sender: TObject);
procedure EditYChange(Sender: TObject);
procedure EditShowNameChange(Sender: TObject);
procedure EditImageIdxChange(Sender: TObject);
procedure CheckBoxOfCastleClick(Sender: TObject);
procedure CheckBoxBuyClick(Sender: TObject);
procedure CheckBoxSellClick(Sender: TObject);
procedure CheckBoxGetbackClick(Sender: TObject);
procedure CheckBoxStorageClick(Sender: TObject);
procedure CheckBoxUpgradenowClick(Sender: TObject);
procedure CheckBoxGetbackupgnowClick(Sender: TObject);
procedure CheckBoxRepairClick(Sender: TObject);
procedure CheckBoxS_repairClick(Sender: TObject);
procedure CheckBoxMakedrugClick(Sender: TObject);
procedure EditPriceRateChange(Sender: TObject);
procedure ButtonScriptSaveClick(Sender: TObject);
procedure ButtonReLoadNpcClick(Sender: TObject);
procedure EditScriptNameChange(Sender: TObject);
procedure EditMapNameChange(Sender: TObject);
procedure ComboBoxDirChange(Sender: TObject);
procedure MemoScriptChange(Sender: TObject);
procedure CheckBoxSendMsgClick(Sender: TObject);
procedure CheckBoxAutoMoveClick(Sender: TObject);
procedure EditMoveTimeChange(Sender: TObject);
procedure ButtonClearTempDataClick(Sender: TObject);
private
SelMerchant: TMerchant;
boOpened: Boolean;
boModValued: Boolean;
procedure ModValue();
procedure uModValue();
procedure RefListBoxMerChant();
procedure ClearMerchantData();
procedure LoadScriptFile();
procedure ChangeScriptAllowAction();
{ Private declarations }
public
procedure Open();
{ Public declarations }
end;

var
frmConfigMerchant: TfrmConfigMerchant;

implementation

uses UsrEngn, M2Share;

{$R *.dfm}

{ TfrmConfigMerchant }
procedure TfrmConfigMerchant.ModValue;
begin
ButtonSave.Enabled := True;
ButtonScriptSave.Enabled := True;
end;

procedure TfrmConfigMerchant.uModValue;
begin
ButtonSave.Enabled := False;
ButtonScriptSave.Enabled := False;
end;

procedure TfrmConfigMerchant.Open;
begin
boOpened := False;
uModValue();
CheckBoxDenyRefStatus.Checked := False;
SelMerchant := nil;
RefListBoxMerChant;

boOpened := True;
ShowModal;
end;

procedure TfrmConfigMerchant.ButtonClearTempDataClick(Sender: TObject);
begin
if Application.MessageBox(PChar('是否确认清除NPC临时数据？'), '确认信息', MB_YESNO + MB_ICONQUESTION) = mrYes then begin
ClearMerchantData();
end;
end;

procedure TfrmConfigMerchant.ButtonSaveClick(Sender: TObject);
var
i: Integer;
SaveList: TStringList;
Merchant: TMerchant;
sMerchantFile: string;
sIsCastle: string;
sCanMove: string;
begin
sMerchantFile := g_Config.sEnvirDir + 'Merchant.txt';
SaveList := TStringList.Create;
UserEngine.m_MerchantList.Lock;
try
for i := 0 to UserEngine.m_MerchantList.Count - 1 do begin
Merchant := TMerchant(UserEngine.m_MerchantList.Items[i]);
if Merchant.m_sMapName = '0' then Continue;

if Merchant.m_boCastle then sIsCastle := '1'
else sIsCastle := '0';
if Merchant.m_boCanMove then sCanMove := '1'
else sCanMove := '0';

SaveList.Add(Merchant.m_sScript + #9 +
Merchant.m_sMapName + #9 +
IntToStr(Merchant.m_nCurrX) + #9 +
IntToStr(Merchant.m_nCurrY) + #9 +
Merchant.m_sCharName + #9 +
IntToStr(Merchant.m_nFlag) + #9 +
IntToStr(Merchant.m_wAppr) + #9 +
sIsCastle + #9 +
sCanMove + #9 +
IntToStr(Merchant.m_dwMoveTime)
)
end;
SaveList.SaveToFile(sMerchantFile);
finally
UserEngine.m_MerchantList.UnLock;
end;
SaveList.Free;
uModValue();
end;

procedure TfrmConfigMerchant.ClearMerchantData;
var
i: Integer;
Merchant: TMerchant;
begin
UserEngine.m_MerchantList.Lock;
try
for i := 0 to UserEngine.m_MerchantList.Count - 1 do begin
Merchant := TMerchant(UserEngine.m_MerchantList.Items[i]);
Merchant.ClearData();
end;
finally
UserEngine.m_MerchantList.UnLock;
end;
end;

procedure TfrmConfigMerchant.RefListBoxMerChant;
var
i: Integer;
Merchant: TMerchant;
begin
UserEngine.m_MerchantList.Lock;
try
for i := 0 to UserEngine.m_MerchantList.Count - 1 do begin
Merchant := TMerchant(UserEngine.m_MerchantList.Items[i]);
if (Merchant.m_sMapName = '0') and (Merchant.m_nCurrX = 0) and (Merchant.m_nCurrY = 0) then Continue;
ListBoxMerChant.Items.AddObject(Merchant.m_sCharName + ' - ' + Merchant.m_sMapName + ' (' + IntToStr(Merchant.m_nCurrX) + ':' + IntToStr(Merchant.m_nCurrY) + ')', Merchant);
end;
finally
UserEngine.m_MerchantList.UnLock;
end;

end;

procedure TfrmConfigMerchant.ListBoxMerChantClick(Sender: TObject);
var
nSelIndex: Integer;
begin
CheckBoxDenyRefStatus.Checked := False;
uModValue();
boOpened := False;
nSelIndex := ListBoxMerChant.ItemIndex;
if nSelIndex < 0 then exit;
SelMerchant := TMerchant(ListBoxMerChant.Items.Objects[nSelIndex]);
EditScriptName.Text := SelMerchant.m_sScript;
EditMapName.Text := SelMerchant.m_sMapName;
EditMapDesc.Text := SelMerchant.m_PEnvir.sMapDesc;
EditX.Value := SelMerchant.m_nCurrX;
EditY.Value := SelMerchant.m_nCurrY;
EditShowName.Text := SelMerchant.m_sCharName;
ComboBoxDir.ItemIndex := SelMerchant.m_nFlag;
EditImageIdx.Value := SelMerchant.m_wAppr;
CheckBoxOfCastle.Checked := SelMerchant.m_boCastle;
CheckBoxAutoMove.Checked := SelMerchant.m_boCanMove;
EditMoveTime.Value := SelMerchant.m_dwMoveTime;

CheckBoxBuy.Checked := SelMerchant.m_boBuy;
CheckBoxSell.Checked := SelMerchant.m_boSell;
CheckBoxGetback.Checked := SelMerchant.m_boGetback;
CheckBoxStorage.Checked := SelMerchant.m_boStorage;
CheckBoxUpgradenow.Checked := SelMerchant.m_boUpgradenow;
CheckBoxGetbackupgnow.Checked := SelMerchant.m_boGetBackupgnow;
CheckBoxRepair.Checked := SelMerchant.m_boRepair;
CheckBoxS_repair.Checked := SelMerchant.m_boS_repair;
CheckBoxMakedrug.Checked := SelMerchant.m_boMakeDrug;
CheckBoxSendMsg.Checked := SelMerchant.m_boSendmsg;

EditPriceRate.Value := SelMerchant.m_nPriceRate;
MemoScript.Clear;
ButtonReLoadNpc.Enabled := False;
LoadScriptFile();

GroupBoxNPC.Enabled := True;
GroupBoxScript.Enabled := True;

boOpened := True;
end;

procedure TfrmConfigMerchant.FormCreate(Sender: TObject);
begin
ComboBoxDir.Items.Add('0');
ComboBoxDir.Items.Add('1');
ComboBoxDir.Items.Add('2');
ComboBoxDir.Items.Add('3');
ComboBoxDir.Items.Add('4');
ComboBoxDir.Items.Add('5');
ComboBoxDir.Items.Add('6');
ComboBoxDir.Items.Add('7');
end;

procedure TfrmConfigMerchant.CheckBoxDenyRefStatusClick(Sender: TObject);
begin
if SelMerchant <> nil then begin
SelMerchant.m_boDenyRefStatus := CheckBoxDenyRefStatus.Checked;
end;
end;

procedure TfrmConfigMerchant.EditXChange(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_nCurrX := EditX.Value;
ModValue();
end;

procedure TfrmConfigMerchant.EditYChange(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_nCurrY := EditY.Value;
ModValue();
end;

procedure TfrmConfigMerchant.EditShowNameChange(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_sCharName := Trim(EditShowName.Text);
ModValue();
end;

procedure TfrmConfigMerchant.EditImageIdxChange(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_wAppr := EditImageIdx.Value;
ModValue();
end;

procedure TfrmConfigMerchant.EditScriptNameChange(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_sScript := Trim(EditScriptName.Text);
ModValue();
end;

procedure TfrmConfigMerchant.EditMapNameChange(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_sMapName := Trim(EditMapName.Text);
ModValue();
end;

procedure TfrmConfigMerchant.ComboBoxDirChange(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_nFlag := ComboBoxDir.ItemIndex;
ModValue();
end;

procedure TfrmConfigMerchant.CheckBoxOfCastleClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boCastle := CheckBoxOfCastle.Checked;
ModValue();
end;

procedure TfrmConfigMerchant.CheckBoxAutoMoveClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boCanMove := CheckBoxAutoMove.Checked;
ModValue();
end;

procedure TfrmConfigMerchant.EditMoveTimeChange(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_dwMoveTime := EditMoveTime.Value;
ModValue();
end;

procedure TfrmConfigMerchant.LoadScriptFile;
var
i: Integer;
sScriptFile: string;
LoadList: TStringList;
LineText: string;
boNoHeader: Boolean;
begin
if SelMerchant = nil then exit;
sScriptFile := g_Config.sEnvirDir + 'Market_Def\' + SelMerchant.m_sScript + '-' + SelMerchant.m_sMapName + '.txt';
MemoScript.Visible := False;
LineText := '(';
if SelMerchant.m_boBuy then LineText := LineText + sBUY + ' ';
if SelMerchant.m_boSell then LineText := LineText + sSELL + ' ';
if SelMerchant.m_boMakeDrug then LineText := LineText + sMAKEDURG + ' ';
if SelMerchant.m_boStorage then LineText := LineText + sSTORAGE + ' ';
if SelMerchant.m_boGetback then LineText := LineText + sGETBACK + ' ';
if SelMerchant.m_boUpgradenow then LineText := LineText + sUPGRADENOW + ' ';
if SelMerchant.m_boGetBackupgnow then LineText := LineText + sGETBACKUPGNOW + ' ';
if SelMerchant.m_boRepair then LineText := LineText + sREPAIR + ' ';
if SelMerchant.m_boS_repair then LineText := LineText + sSUPERREPAIR + ' ';
if SelMerchant.m_boSendmsg then LineText := LineText + sSL_SENDMSG + ' ';

if SelMerchant.m_boBuyOff then LineText := LineText + sBUYOFF + ' ';
if SelMerchant.m_boSellOff then LineText := LineText + sSELLOFF + ' ';
if SelMerchant.m_boGetSellGold then LineText := LineText + sGETSELLGOLD + ' ';

LineText := LineText + ')';
MemoScript.Lines.Add(LineText);
LineText := '%' + IntToStr(SelMerchant.m_nPriceRate);
MemoScript.Lines.Add(LineText);
for i := 0 to SelMerchant.m_ItemTypeList.Count - 1 do begin
LineText := '+' + IntToStr(Integer(SelMerchant.m_ItemTypeList.Items[i]));
MemoScript.Lines.Add(LineText);
end;
if FileExists(sScriptFile) then begin
LoadList := TStringList.Create;
LoadList.LoadFromFile(sScriptFile);
boNoHeader := False;
for i := 0 to LoadList.Count - 1 do begin
LineText := LoadList.Strings[i];
if (LineText = '') or (LineText[1] = ';') then Continue;

if (LineText[1] = '[') or (LineText[1] = '#') then boNoHeader := True;
if boNoHeader then begin
MemoScript.Lines.Add(LineText);
end;

end;
LoadList.Free;
end;
MemoScript.Visible := True;
end;

procedure TfrmConfigMerchant.ChangeScriptAllowAction;
var
LineText: string;
begin
if (SelMerchant = nil) or (MemoScript.Lines.Count <= 0) then exit;
LineText := '(';
if SelMerchant.m_boBuy then LineText := LineText + sBUY + ' ';
if SelMerchant.m_boSell then LineText := LineText + sSELL + ' ';
if SelMerchant.m_boMakeDrug then LineText := LineText + sMAKEDURG + ' ';
if SelMerchant.m_boStorage then LineText := LineText + sSTORAGE + ' ';
if SelMerchant.m_boGetback then LineText := LineText + sGETBACK + ' ';
if SelMerchant.m_boUpgradenow then LineText := LineText + sUPGRADENOW + ' ';
if SelMerchant.m_boGetBackupgnow then LineText := LineText + sGETBACKUPGNOW + ' ';
if SelMerchant.m_boRepair then LineText := LineText + sREPAIR + ' ';
if SelMerchant.m_boS_repair then LineText := LineText + sSUPERREPAIR + ' ';
if SelMerchant.m_boSendmsg then LineText := LineText + sSL_SENDMSG + ' ';
LineText := LineText + ')';
MemoScript.Lines[0] := LineText;
end;

procedure TfrmConfigMerchant.CheckBoxBuyClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boBuy := CheckBoxBuy.Checked;
ModValue();
ChangeScriptAllowAction();
end;

procedure TfrmConfigMerchant.CheckBoxSellClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boSell := CheckBoxSell.Checked;
ModValue();
ChangeScriptAllowAction();
end;

procedure TfrmConfigMerchant.CheckBoxGetbackClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boGetback := CheckBoxGetback.Checked;
ModValue();
ChangeScriptAllowAction();
end;

procedure TfrmConfigMerchant.CheckBoxStorageClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boStorage := CheckBoxStorage.Checked;
ModValue();
ChangeScriptAllowAction();
end;

procedure TfrmConfigMerchant.CheckBoxUpgradenowClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boUpgradenow := CheckBoxUpgradenow.Checked;
ModValue();
ChangeScriptAllowAction();
end;

procedure TfrmConfigMerchant.CheckBoxGetbackupgnowClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boGetBackupgnow := CheckBoxGetbackupgnow.Checked;
ModValue();
ChangeScriptAllowAction();
end;

procedure TfrmConfigMerchant.CheckBoxRepairClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boRepair := CheckBoxRepair.Checked;
ModValue();
ChangeScriptAllowAction();
end;

procedure TfrmConfigMerchant.CheckBoxS_repairClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boS_repair := CheckBoxS_repair.Checked;
ModValue();
ChangeScriptAllowAction();
end;

procedure TfrmConfigMerchant.CheckBoxMakedrugClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boMakeDrug := CheckBoxMakedrug.Checked;
ModValue();
ChangeScriptAllowAction();
end;

procedure TfrmConfigMerchant.CheckBoxSendMsgClick(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
SelMerchant.m_boSendmsg := CheckBoxSendMsg.Checked;
ModValue();
ChangeScriptAllowAction();
end;

procedure TfrmConfigMerchant.EditPriceRateChange(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;

SelMerchant.m_nPriceRate := EditPriceRate.Value;
MemoScript.Lines[1] := '%' + IntToStr(SelMerchant.m_nPriceRate);
ModValue();

end;

procedure TfrmConfigMerchant.ButtonScriptSaveClick(Sender: TObject);
var
sScriptFile: string;
begin
sScriptFile := g_Config.sEnvirDir + 'Market_Def\' + SelMerchant.m_sScript + '-' + SelMerchant.m_sMapName + '.txt';
MemoScript.Lines.SaveToFile(sScriptFile);
uModValue();
ButtonReLoadNpc.Enabled := True;
end;

procedure TfrmConfigMerchant.ButtonReLoadNpcClick(Sender: TObject);
begin
if (SelMerchant = nil) then exit;
try
EnterCriticalSection(ProcessHumanCriticalSection);
SelMerchant.ClearScript;
SelMerchant.LoadNpcScript;
finally
LeaveCriticalSection(ProcessHumanCriticalSection);
end;
ButtonReLoadNpc.Enabled := False;
end;

procedure TfrmConfigMerchant.MemoScriptChange(Sender: TObject);
begin
if not boOpened or (SelMerchant = nil) then exit;
ModValue();
end;

end.

**hujiacheng** · 10-12-07

ConfigMonGen.pas
unit ConfigMonGen;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TfrmConfigMonGen = class(TForm)
ListBoxMonGen: TListBox;
private
{ Private declarations }
public
procedure Open();
{ Public declarations }
end;

var
frmConfigMonGen: TfrmConfigMonGen;

implementation

uses UsrEngn, M2Share, Grobal2;

{$R *.dfm}

{ TfrmConfigMonGen }

procedure TfrmConfigMonGen.Open;
var
i: Integer;
MonGen: pTMonGenInfo;
begin
for i := 0 to UserEngine.m_MonGenList.Count - 1 do begin
MonGen := UserEngine.m_MonGenList.Items[i];
ListBoxMonGen.Items.AddObject(MonGen.sMapName + '(' + IntToStr(MonGen.nX) + ':' + IntToStr(MonGen.nY) + ')' + ' - ' + MonGen.sMonName, TObject(MonGen));
end;
Self.ShowModal;
end;

end.

**hujiacheng** · 10-12-07

unit EDcode;

interface

uses
Windows, SysUtils, {Classes, Hutil32,} Grobal2, M2Share;
const
OLDMODE = 0; //老版本编码
NEWMODE = 1; //新版本编码
ENDECODEMODE = OLDMODE;
function EncodeMessage(sMsg: TDefaultMessage): string;
function DecodeMessage(Str: string): TDefaultMessage;
function EncodeString(Str: string): string;
function DeCodeString(Str: string): string;
function EncodeBuffer(Buf: PChar; bufsize: Integer): string;
procedure DecodeBuffer(Src: string; Buf: PChar; bufsize: Integer);
procedure Decode6BitBuf(sSource: PChar; pBuf: PChar; nSrcLen, nBufLen: Integer);
procedure Encode6BitBuf(pSrc, pDest: PChar; nSrcLen, nDestLen: Integer);
function MakeDefaultMsg(wIdent: Word; nRecog: Integer; wParam, wTag, wSeries: Word): TDefaultMessage;
//var
// CSEncode: TRTLCriticalSection;

implementation
var
n4CEEF4: Integer = $408D4D;
n4CEEF8: Integer = $0C08BA52E;
w4CEF00: Word = $8D34;
DecodeBitMasks: array[0..255] of Byte = (
$2A, $E7, $18, $6F, $63, $9D, $48, $EA, $39, $CD, $38, $B8, $A0, $AB, $E0, $10,
$35, $99, $37, $09, $C0, $69, $B2, $A4, $67, $88, $50, $34, $7F, $FC, $0B, $BE,
$0C, $44, $59, $B6, $5B, $9C, $65, $D6, $94, $EB, $C4, $3B, $03, $3C, $C9, $3E,
$6B, $9A, $D4, $F6, $C3, $4D, $11, $24, $AA, $FF, $4A, $ED, $95, $93, $D9, $46,
$5F, $96, $87, $30, $BA, $CA, $CB, $FA, $8A, $1A, $68, $5C, $AC, $07, $40, $60,
$29, $70, $57, $53, $41, $12, $DE, $1D, $64, $14, $97, $72, $FB, $8D, $2B, $08,
$CF, $F4, $3A, $00, $C5, $91, $56, $A9, $9E, $71, $BC, $A3, $AF, $A6, $55, $DA,
$79, $BB, $33, $A5, $25, $15, $7D, $EE, $C1, $2C, $C7, $D0, $19, $D8, $5A, $E8,
$85, $FD, $2F, $6A, $78, $45, $DB, $B5, $F5, $1E, $04, $75, $B0, $7A, $20, $F2,
$DF, $D3, $83, $F3, $54, $90, $A2, $C6, $0F, $80, $36, $4E, $C8, $01, $82, $76,
$A1, $2E, $84, $86, $0E, $47, $8F, $E1, $F9, $7C, $C2, $74, $DC, $26, $22, $CE,
$2D, $4F, $BF, $0D, $73, $27, $21, $B3, $98, $1F, $89, $EC, $FE, $52, $0A, $8C,
$9F, $A8, $E5, $E6, $06, $8B, $CC, $F7, $5E, $E3, $7B, $D2, $05, $49, $13, $E9,
$66, $B7, $AD, $B4, $F8, $A7, $1C, $F1, $02, $7E, $6E, $17, $62, $4C, $77, $8E,
$DD, $F0, $43, $28, $6D, $61, $B9, $D7, $BD, $3D, $9B, $92, $16, $EF, $51, $23,
$E2, $B1, $81, $31, $32, $58, $D1, $5D, $D5, $6C, $4B, $E4, $AE, $42, $1B, $3F
);

n4CEEFC: Integer = $408D97;

EncodeBitMasks: array[0..255] of Byte = (
$8C, $87, $0D, $85, $D4, $64, $63, $E5, $BA, $7E, $B8, $68, $9D, $9F, $F5, $BC,
$A0, $E3, $3A, $22, $19, $21, $39, $78, $EE, $27, $36, $15, $74, $C7, $97, $C9,
$CE, $E2, $7B, $4C, $98, $A1, $C2, $59, $41, $C0, $1E, $2E, $95, $EB, $DE, $69,
$1D, $5B, $53, $DA, $F4, $0A, $4F, $BB, $B7, $24, $33, $0F, $C8, $84, $29, $89,
$3C, $1C, $08, $49, $C6, $FE, $CC, $23, $3E, $E1, $4E, $8B, $13, $E7, $1A, $5D,
$CF, $B1, $47, $8F, $D8, $72, $4B, $93, $6E, $73, $4D, $94, $DD, $82, $14, $A7,
$03, $F9, $F1, $C5, $8D, $79, $2A, $C4, $DC, $60, $5F, $D7, $62, $B5, $E9, $B3,
$B6, $12, $A8, $32, $D9, $C3, $6A, $75, $4A, $A2, $0C, $26, $91, $5A, $AD, $6D,
$44, $10, $B4, $46, $1B, $66, $81, $20, $FD, $7F, $88, $25, $9C, $71, $D3, $E6,
$80, $E4, $FA, $42, $9B, $37, $01, $FC, $DB, $45, $6B, $FB, $56, $F0, $AF, $9A,
$BF, $AB, $D6, $CD, $02, $F2, $7C, $AA, $B2, $92, $FF, $57, $2F, $86, $A6, $7D,
$35, $17, $34, $D5, $0E, $65, $09, $05, $28, $CA, $48, $31, $8E, $2D, $DF, $52,
$F6, $1F, $A4, $50, $76, $40, $18, $04, $8A, $16, $2B, $AE, $43, $3F, $D0, $CB,
$6C, $55, $54, $96, $99, $30, $67, $5E, $2C, $AC, $E0, $7A, $E8, $58, $90, $BE,
$A5, $6F, $B0, $70, $EC, $61, $5C, $06, $3B, $77, $C1, $07, $EA, $A9, $F8, $11,
$BD, $F3, $00, $ED, $83, $EF, $3D, $A3, $51, $9E, $38, $F7, $0B, $B9, $D2, $D1
);
//var
// EncBuf,TempBuf:PChar;
function MakeDefaultMsg(wIdent: Word; nRecog: Integer; wParam, wTag, wSeries: Word): TDefaultMessage;
begin
Result.Recog := nRecog;
Result.Ident := wIdent;
Result.Param := wParam;
Result.Tag := wTag;
Result.Series := wSeries;
end;
{$IF USECODE = USEREMOTECODE}
procedure Encode6BitBuf(pSrc, pDest: PChar; nSrcLen, nDestLen: Integer);
var
Proc: procedure(pSrc, pDest: PChar; nSrcLen, nDestLen: Integer);
begin
Proc := Pointer(g_Config.Encode6BitBuf);
Proc(pSrc, pDest, nSrcLen, nDestLen);
end;
{$ELSE}
procedure Encode6BitBuf(pSrc, pDest: PChar; nSrcLen, nDestLen: Integer);
var
i: Integer;
nRestCount: Integer;
nDestPos: Integer;
btMade: Byte;
btCh: Byte;
btRest: Byte;
begin
nRestCount := 0;
btRest := 0;
nDestPos := 0;
for i := 0 to nSrcLen - 1 do begin
if nDestPos >= nDestLen then break;
btCh := Byte(pSrc[i]);
{$IF ENDECODEMODE = NEWMODE}
btCh := (EncodeBitMasks[btCh] xor n4CEEFC) xor n4CEEF4;
btCh := btCh xor (Hibyte(LoWord(n4CEEF8)) + LoByte(LoWord(n4CEEF8)));
{$IFEND}
btMade := Byte((btRest or (btCh shr (2 + nRestCount))) and $3F);
btRest := Byte(((btCh shl (8 - (2 + nRestCount))) shr 2) and $3F);
Inc(nRestCount, 2);

if nRestCount < 6 then begin
pDest[nDestPos] := Char(btMade + $3C);
Inc(nDestPos);
end else begin
if nDestPos < nDestLen - 1 then begin
pDest[nDestPos] := Char(btMade + $3C);
pDest[nDestPos + 1] := Char(btRest + $3C);
Inc(nDestPos, 2);
end else begin
pDest[nDestPos] := Char(btMade + $3C);
Inc(nDestPos);
end;
nRestCount := 0;
btRest := 0;
end;
end;
if nRestCount > 0 then begin
pDest[nDestPos] := Char(btRest + $3C);
Inc(nDestPos);
end;
pDest[nDestPos] := #0;
end;
{$IFEND}
{
procedure Decode6BitBuf (sSource:PChar;pBuf:PChar;nSrcLen,nBufLen:Integer);
var
Proc:procedure (sSource:PChar;pBuf:PChar;nSrcLen,nBufLen:Integer);
begin
Proc:=Pointer(g_Config.Encode6BitBuf);
if assigned(Proc) then
Proc(sSource,pBuf,nSrcLen,nBufLen);
end;
}
procedure Decode6BitBuf(sSource: PChar; pBuf: PChar; nSrcLen, nBufLen: Integer);
const
Masks: array[2..6] of Byte = ($FC, $F8, $F0, $E0, $C0);
//($FE, $FC, $F8, $F0, $E0, $C0, $80, $00);
var
i, {nLen,} nBitPos, nMadeBit, nBufPos: Integer;
btCh, btTmp, btByte: Byte;
begin
// nLen:= Length (sSource);
nBitPos := 2;
nMadeBit := 0;
nBufPos := 0;
btTmp := 0;
for i := 0 to nSrcLen - 1 do begin
if Integer(sSource[i]) - $3C >= 0 then
btCh := Byte(sSource[i]) - $3C
else begin
nBufPos := 0;
break;
end;
if nBufPos >= nBufLen then break;
if (nMadeBit + 6) >= 8 then begin
btByte := Byte(btTmp or ((btCh and $3F) shr (6 - nBitPos)));
{$IF ENDECODEMODE = NEWMODE}
btByte := btByte xor (Hibyte(LoWord(n4CEEF8)) + LoByte(LoWord(n4CEEF8)));
btByte := btByte xor LoByte(LoWord(n4CEEF4));
btByte := DecodeBitMasks[btByte] xor LoByte(w4CEF00);
{$IFEND}
pBuf[nBufPos] := Char(btByte);
Inc(nBufPos);
nMadeBit := 0;
if nBitPos < 6 then Inc(nBitPos, 2)
else begin
nBitPos := 2;
Continue;
end;
end;
btTmp := Byte(Byte(btCh shl nBitPos) and Masks[nBitPos]); // #### ##--
Inc(nMadeBit, 8 - nBitPos);
end;
pBuf[nBufPos] := #0;

{
nLen:= Length (sSource);
nBitPos:= 2;
nMadeBit:= 0;
nBufPos:= 0;
btTmp:= 0;
for I:= 1 to nLen do begin
if Integer(sSource[I]) - $3C >= 0 then
btCh := Byte(sSource[I]) - $3C
else begin
nBufPos := 0;
break;
end;
if nBufPos >= nBufLen then break;
if (nMadeBit + 6) >= 8 then begin
btByte := Byte(btTmp or ((btCh and $3F) shr (6- nBitPos)));
pBuf[nBufPos] := Char(btByte);
Inc(nBufPos);
nMadeBit := 0;
if nBitPos < 6 then Inc (nBitPos, 2)
else begin
nBitPos := 2;
continue;
end;
end;
btTmp:= Byte (Byte(btCh shl nBitPos) and Masks[nBitPos]); // #### ##--
Inc(nMadeBit, 8 - nBitPos);
end;
pBuf[nBufPos] := #0;
}
end;

function DecodeMessage(Str: string): TDefaultMessage;
var
EncBuf: array[0..BUFFERSIZE - 1] of Char;
Msg: TDefaultMessage;
begin
Decode6BitBuf(PChar(Str), @EncBuf, Length(Str), SizeOf(EncBuf));
Move(EncBuf, Msg, SizeOf(TDefaultMessage));
Result := Msg;
{
try
EnterCriticalSection (CSencode);
Decode6BitBuf (str, EncBuf, 1024);
Move (EncBuf^, msg, sizeof(TDefaultMessage));
Result := msg;
finally
LeaveCriticalSection (CSencode);
end;
}
end;

function DeCodeString(Str: string): string;
var
EncBuf: array[0..BUFFERSIZE - 1] of Char;
begin
Decode6BitBuf(PChar(Str), @EncBuf, Length(Str), SizeOf(EncBuf));
Result := StrPas(EncBuf);
{
try
EnterCriticalSection (CSencode);
Decode6BitBuf (str, EncBuf, BUFFERSIZE);
Result := StrPas (EncBuf); //error, 1, 2, 3,...
finally
LeaveCriticalSection (CSencode);
end;}
end;

procedure DecodeBuffer(Src: string; Buf: PChar; bufsize: Integer);
var
EncBuf: array[0..BUFFERSIZE - 1] of Char;
begin
Decode6BitBuf(PChar(Src), @EncBuf, Length(Src), SizeOf(EncBuf));
Move(EncBuf, Buf^, bufsize);
{
try
EnterCriticalSection (CSencode);
Decode6BitBuf (src, EncBuf, BUFFERSIZE);
Move (EncBuf^, buf^, bufsize);
finally
LeaveCriticalSection (CSencode);
end;
}
end;

function EncodeMessage(sMsg: TDefaultMessage): string;
var
EncBuf, TempBuf: array[0..BUFFERSIZE - 1] of Char;
begin
Move(sMsg, TempBuf, SizeOf(TDefaultMessage));
Encode6BitBuf(@TempBuf, @EncBuf, SizeOf(TDefaultMessage), SizeOf(EncBuf));
Result := StrPas(EncBuf);
{
EnterCriticalSection(CSencode);
try
Move (smsg, TempBuf^, sizeof(TDefaultMessage));
Encode6BitBuf(TempBuf, EncBuf, sizeof(TDefaultMessage), 1024);
Result:=StrPas(EncBuf); //Error: 1, 2, 3, 4, 5, 6, 7, 8, 9
finally
LeaveCriticalSection(CSencode);
end;
}
end;

function EncodeString(Str: string): string;
var
EncBuf: array[0..BUFFERSIZE - 1] of Char;
begin
Encode6BitBuf(PChar(Str), @EncBuf, Length(Str), SizeOf(EncBuf));
Result := StrPas(EncBuf);
{
EnterCriticalSection(CSencode);
try
Encode6BitBuf(PChar(str), EncBuf, Length(str), BUFFERSIZE);
Result:=StrPas(EncBuf);
finally
LeaveCriticalSection(CSencode);
end;
}
end;

function EncodeBuffer(Buf: PChar; bufsize: Integer): string;
var
EncBuf, TempBuf: array[0..BUFFERSIZE - 1] of Char;
begin
if bufsize < BUFFERSIZE then begin
Move(Buf^, TempBuf, bufsize);
Encode6BitBuf(@TempBuf, @EncBuf, bufsize, SizeOf(EncBuf));
Result := StrPas(EncBuf);
end else Result := '';
{
EnterCriticalSection (CSencode);
try
if bufsize < BUFFERSIZE then begin
Move (buf^, TempBuf^, bufsize);
Encode6BitBuf (TempBuf, EncBuf, bufsize, BUFFERSIZE);
Result := StrPas (EncBuf);
end else Result := '';
finally
LeaveCriticalSection (CSencode);
end;
}
end;

initialization
begin
// GetMem (EncBuf, 10240 + 100); //BUFFERSIZE + 100);
// GetMem (TempBuf, 10240); //2048);
// InitializeCriticalSection (CSEncode);
end;

finalization
begin
// FreeMem (EncBuf, BUFFERSIZE + 100);
// FreeMem (TempBuf, 2048);
// DeleteCriticalSection (CSEncode);
end;

end.

**hujiacheng** · 10-12-07

unit EncryptUnit;

interface
uses
Windows, SysUtils, Classes, DES;
function CalcFileCRC(sFileName: string): Integer;
function CalcBufferCRC(Buffer: PChar; nSize: Integer): Integer;
function Base64EncodeStr(const Value: string): string;
{ Encode a string into Base64 format }
function Base64DecodeStr(const Value: string): string;
{ Decode a Base64 format string }
function Base64Encode(pInput: Pointer; pOutput: Pointer; Size: LongInt): LongInt;
{ Encode a lump of raw data (output is (4/3) times bigger than input) }
function Base64Decode(pInput: Pointer; pOutput: Pointer; Size: LongInt): LongInt;
{ Decode a lump of raw data }

function EncodeString_3des(Source, Key: string): string;
function DecodeString_3des(Source, Key: string): string;
function EncodeInfo(smsg: string): string;
function DecodeInfo(smsg: string): string;
function GetUniCode(Msg: string): Integer;
implementation
uses EDcode, HUtil32;
{$I des.inc}
const
B64: array[0..63] of Byte = (65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,
81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108,
109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 48, 49, 50, 51, 52, 53,
54, 55, 56, 57, 43, 47);
Key: array[0..2, 0..7] of Byte = (($FF, $FE, $FF, $FE, $FF, $FE, $FF, $FF), ($FF, $FE, $FF, $FE, $FF, $FE, $FF, $FF), ($FF, $FE, $FF, $FE, $FF, $FE, $FF, $FF));
function Base64Encode(pInput: Pointer; pOutput: Pointer; Size: LongInt): LongInt;
var
i, iptr, optr: Integer;
Input, Output: PByteArray;
begin
Input := PByteArray(pInput); Output := PByteArray(pOutput);
iptr := 0; optr := 0;
for i := 1 to (Size div 3) do begin
Output^[optr + 0] := B64[Input^[iptr] shr 2];
Output^[optr + 1] := B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr + 1] shr 4)];
Output^[optr + 2] := B64[((Input^[iptr + 1] and 15) shl 2) + (Input^[iptr + 2] shr 6)];
Output^[optr + 3] := B64[Input^[iptr + 2] and 63];
Inc(optr, 4); Inc(iptr, 3);
end;
case (Size mod 3) of
1: begin
Output^[optr + 0] := B64[Input^[iptr] shr 2];
Output^[optr + 1] := B64[(Input^[iptr] and 3) shl 4];
Output^[optr + 2] := Byte('=');
Output^[optr + 3] := Byte('=');
end;
2: begin
Output^[optr + 0] := B64[Input^[iptr] shr 2];
Output^[optr + 1] := B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr + 1] shr 4)];
Output^[optr + 2] := B64[(Input^[iptr + 1] and 15) shl 2];
Output^[optr + 3] := Byte('=');
end;
end;
Result := ((Size + 2) div 3) * 4;
end;

function Base64EncodeStr(const Value: string): string;
begin
setlength(Result, ((Length(Value) + 2) div 3) * 4);
Base64Encode(@Value[1], @Result[1], Length(Value));
end;

function Base64Decode(pInput: Pointer; pOutput: Pointer; Size: LongInt): LongInt;
var
i, J, iptr, optr: Integer;
Temp: array[0..3] of Byte;
Input, Output: PByteArray;
begin
Input := PByteArray(pInput); Output := PByteArray(pOutput);
iptr := 0; optr := 0;
Result := 0;
for i := 1 to (Size div 4) do begin
for J := 0 to 3 do begin
case Input^[iptr] of
65..90: Temp[J] := Input^[iptr] - Ord('A');
97..122: Temp[J] := Input^[iptr] - Ord('a') + 26;
48..57: Temp[J] := Input^[iptr] - Ord('0') + 52;
43: Temp[J] := 62;
47: Temp[J] := 63;
61: Temp[J] := $FF;
end;
Inc(iptr);
end;
Output^[optr] := (Temp[0] shl 2) or (Temp[1] shr 4);
Result := optr + 1;
if (Temp[2] <> $FF) and (Temp[3] = $FF) then begin
Output^[optr + 1] := (Temp[1] shl 4) or (Temp[2] shr 2);
Result := optr + 2;
Inc(optr)
end
else if (Temp[2] <> $FF) then begin
Output^[optr + 1] := (Temp[1] shl 4) or (Temp[2] shr 2);
Output^[optr + 2] := (Temp[2] shl 6) or Temp[3];
Result := optr + 3;
Inc(optr, 2);
end;
Inc(optr);
end;
end;

function Base64DecodeStr(const Value: string): string;
begin
setlength(Result, (Length(Value) div 4) * 3);
setlength(Result, Base64Decode(@Value[1], @Result[1], Length(Value)));
end;

function CalcFileCRC(sFileName: string): Integer;
var
i: Integer;
nFileHandle: Integer;
nFileSize, nBuffSize: Integer;
Buffer: PChar;
INT: ^Integer;
nCrc: Integer;
begin
Result := 0;
if not FileExists(sFileName) then Exit;
nFileHandle := FileOpen(sFileName, fmOpenRead or fmShareDenyNone);
if nFileHandle = 0 then
Exit;
nFileSize := FileSeek(nFileHandle, 0, 2);
nBuffSize := (nFileSize div 4) * 4;
GetMem(Buffer, nBuffSize);
FillChar(Buffer^, nBuffSize, 0);
FileSeek(nFileHandle, 0, 0);
FileRead(nFileHandle, Buffer^, nBuffSize);
FileClose(nFileHandle);
INT := Pointer(Buffer);
nCrc := 0;
Exception.Create(IntToStr(SizeOf(Integer)));
for i := 0 to nBuffSize div 4 - 1 do begin
nCrc := nCrc xor INT^;
INT := Pointer(Integer(INT) + 4);
end;
FreeMem(Buffer);
Result := nCrc;
end;

function CalcBufferCRC(Buffer: PChar; nSize: Integer): Integer;
var
i: Integer;
INT: ^Integer;
nCrc: Integer;
begin
INT := Pointer(Buffer);
nCrc := 0;
for i := 0 to nSize div 4 - 1 do begin
nCrc := nCrc xor INT^;
INT := Pointer(Integer(INT) + 4);
end;
Result := nCrc;
end;

function Chinese2UniCode(AiChinese: string): Integer;
var
ch, cl: string[2];
a: array[1..2] of Char;
begin
StringToWideChar(Copy(AiChinese, 1, 2), @(a[1]), 2);
ch := IntToHex(Integer(a[2]), 2);
cl := IntToHex(Integer(a[1]), 2);
Result := StrToInt('$' + ch + cl);
end;

function GetUniCode(Msg: string): Integer;
var
i: Integer;
begin
Result := -1;
for i := 1 to Length(Msg) do begin
Result := Result + Chinese2UniCode(Msg[i]) * i;
end;
end;

function DecodeString_3des(Source, Key: string): string;
var
Decode: TDCP_3des;
begin
try
Result := '';
Decode := TDCP_3des.Create(nil);
Decode.InitStr(Key);
Decode.Reset;
Result := Decode.DecryptString(Source);
Decode.Reset;
Decode.Free;
except
Result := '';
end;
end;

function EncodeString_3des(Source, Key: string): string;
var
Encode: TDCP_3des;
begin
try
Result := '';
Encode := TDCP_3des.Create(nil);
Encode.InitStr(Key);
Encode.Reset;
Result := Encode.EncryptString(Source);
Encode.Reset;
Encode.Free;
except
Result := '';
end;
end;

function DecodeInfo(smsg: string): string;
var
i: Integer;
sEncodeStr, sEncodeUniCode: string;
nEncodeStr, nEncodeUniCode: Integer;
Str, sDecodeStr, sDecodeUniCode: string;
begin
Result := '';
Str := DecodeString_3des(smsg, '');
i := Pos('|', Str);
if i <= 0 then Exit;
sEncodeStr := Copy(Str, 1, i - 1);
sEncodeUniCode := Copy(Str, i + 1, Length(Str) - i);
sDecodeStr := DecodeString_3des(sEncodeStr, sEncodeUniCode);
sDecodeUniCode := DecodeString(sEncodeUniCode);
nEncodeUniCode := Str_ToInt(sDecodeUniCode, 0);
nEncodeStr := GetUniCode(sDecodeStr);
if nEncodeUniCode <> nEncodeStr then Exit;
Result := sDecodeStr;
end;

function EncodeInfo(smsg: string): string;
var
sEncodeStr, sEncodeUniCode: string;
nEncodeStr: Integer;
begin
nEncodeStr := GetUniCode(smsg);
sEncodeUniCode := EncodeString(IntToStr(nEncodeStr));
sEncodeStr := EncodeString_3des(smsg, sEncodeUniCode);
Result := EncodeString_3des(sEncodeStr + '|' + sEncodeUniCode, '');
end;

end.

**hujiacheng** · 10-12-07

unit EngineRegister;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, svMain, IniFiles, RzButton, Mask, RzEdit;

type
TFrmRegister = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
EditUserName: TRzEdit;
EditRegisterName: TRzEdit;
EditRegisterCode: TRzEdit;
RzBitBtnRegister: TRzBitBtn;
procedure RzBitBtnRegisterClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure Open();
end;

var
FrmRegister: TFrmRegister;

implementation
uses M2Share, SDK;
{$R *.dfm}
procedure TFrmRegister.Open();
var
sRegisterName: string;
begin
try
if (nGetRegisterName >= 0) and Assigned(PlugProcArray[nGetRegisterName].nProcAddr) then begin
if PlugProcArray[nGetRegisterName].nCheckCode = 3 then begin
sRegisterName := Trim(StrPas(TGetStrProc(PlugProcArray[nGetRegisterName].nProcAddr)));
end;
end;
EditRegisterName.Text := Trim(sRegisterName);
except
end;
ShowModal;
end;

procedure TFrmRegister.RzBitBtnRegisterClick(Sender: TObject);
type
TGetLicense = function(nSearchMode: Integer; var nDay: Integer; var nUserCount: Integer): Integer; stdcall;
var
sRegisterName, sUserName, sRegisterCode: string;
nRegister, nM2Crc, nDay, nUserCount: Integer;
begin
sRegisterName := EditRegisterName.Text;
sUserName := Trim(EditUserName.Text);
sRegisterCode := Trim(EditRegisterCode.Text);
if (sRegisterName <> '') and (sUserName <> '') and (sRegisterCode <> '') then begin
if (nStartRegister >= 0) and Assigned(PlugProcArray[nStartRegister].nProcAddr) then begin
if PlugProcArray[nStartRegister].nCheckCode = 4 then begin
nRegister := TStartRegister(PlugProcArray[nStartRegister].nProcAddr)(PChar(sRegisterCode), PChar(sUserName));
case nRegister of
1, 2: begin
if (g_nGetLicenseInfo >= 0) and Assigned(PlugProcArray[g_nGetLicenseInfo].nProcAddr) and (PlugProcArray[g_nGetLicenseInfo].nCheckCode = 2) then begin
nM2Crc := TGetLicense(PlugProcArray[g_nGetLicenseInfo].nProcAddr)(1, nDay, nUserCount);
{if (nStartModule >= 0) and Assigned(PlugProcArray[nStartModule].nProcAddr) then begin
if PlugProcArray[nStartModule].nCheckCode = 1 then begin
TStartProc(PlugProcArray[nStartModule].nProcAddr);
end;
end; }
end;
end;
end;
end;
end;
end;
Close;
end;

end.

**hujiacheng** · 10-12-07

unit Envir;

interface

uses
Windows, SysUtils, Classes, Grobal2;
type
TMapHeader = packed record
wWidth: Word;
wHeight: Word;
sTitle: string[16];
UpdateDate: TDateTime;
Reserved: array[0..22] of Char;
end;
TMapUnitInfo = packed record
wBkImg: Word; //32768 $8000 为禁止移动区域
wMidImg: Word;
wFrImg: Word;
btDoorIndex: Byte; //$80 (巩娄), 巩狼侥喊牢郸胶
btDoorOffset: Byte; //摧腮巩狼弊覆狼惑措困摹, $80 (凯覆/摧塞(扁夯))
btAniFrame: Byte; //$80(Draw Alpha) + 橇贰烙荐
btAniTick: Byte;
btArea: Byte; //瘤开沥焊
btLight: Byte; //0..1..4 堡盔瓤苞
end;
pTMapUnitInfo = ^TMapUnitInfo;
TMap = array[0..1000 * 1000 - 1] of TMapUnitInfo;
pTMap = ^TMap;
TMapCellinfo = record
chFlag: Byte;
bt1: Byte;
bt2: Byte;
bt3: Byte;
ObjList: TList;
boListDisPose: Boolean;
end;
pTMapCellinfo = ^TMapCellinfo;
PTEnvirnoment = ^TEnvirnoment;
TEnvirnoment = class
sMapName: string; //0x4
sMapDesc: string;
sMainMapName: string; //0x4
sSubMapName: string; //0x4
m_boMainMap: Boolean; //0x25
MapCellArray: array of TMapCellinfo; //0x0C
nMinMap: Integer; //0x10
nServerIndex: Integer; //0x14
nRequestLevel: Integer; //0x18 进入本地图所需等级
m_nWidth: Integer; //0x1C
m_nHeight: Integer; //0x20
m_boDARK: Boolean; //0x24
m_boDAY: Boolean; //0x25
m_boDarkness: Boolean;
m_boDayLight: Boolean;
m_DoorList: TList; //0x28
bo2C: Boolean;
m_boSAFE: Boolean; //0x2D
m_boFightZone: Boolean; //0x2E
m_boFight3Zone: Boolean; //0x2F //行会战争地图
m_boQUIZ: Boolean; //0x30
m_boNORECONNECT: Boolean; //0x31
m_boNEEDHOLE: Boolean; //0x32
m_boNORECALL: Boolean; //0x33
m_boNOGUILDRECALL: Boolean;
m_boNODEARRECALL: Boolean;
m_boNOMASTERRECALL: Boolean;
m_boNORANDOMMOVE: Boolean; //0x34
m_boNODRUG: Boolean; //0x35
m_boMINE: Boolean; //0x36
m_boNOPOSITIONMOVE: Boolean; //0x37
sNoReconnectMap: string; //0x38
QuestNPC: TObject; //0x3C
nNEEDSETONFlag: Integer; //0x40
nNeedONOFF: Integer; //0x44
m_QuestList: TList; //0x48
m_boRUNHUMAN: Boolean; //可以穿人
m_boRUNMON: Boolean; //可以穿怪
m_boINCHP: Boolean; //自动加HP值
m_boIncGameGold: Boolean; //自动减游戏币
m_boINCGAMEPOINT: Boolean; //自动加点
m_boDECHP: Boolean; //自动减HP值
m_boDecGameGold: Boolean; //自动减游戏币
m_boDECGAMEPOINT: Boolean; //自动减点
m_boMUSIC: Boolean; //音乐
m_boEXPRATE: Boolean; //杀怪经验倍数
m_boPKWINLEVEL: Boolean; //PK得等级
m_boPKWINEXP: Boolean; //PK得经验
m_boPKLOSTLEVEL: Boolean; //PK丢等级
m_boPKLOSTEXP: Boolean; //PK丢经验
m_nPKWINLEVEL: Integer; //PK得等级数
m_nPKLOSTLEVEL: Integer; //PK丢等级
m_nPKWINEXP: Integer; //PK得经验数
m_nPKLOSTEXP: Integer; //PK丢经验
m_nDECHPTIME: Integer; //减HP间隔时间
m_nDECHPPOINT: Integer; //一次减点数
m_nINCHPTIME: Integer; //加HP间隔时间
m_nINCHPPOINT: Integer; //一次加点数
m_nDECGAMEGOLDTIME: Integer; //减游戏币间隔时间
m_nDecGameGold: Integer; //一次减数量
m_nDECGAMEPOINTTIME: Integer; //减游戏点间隔时间
m_nDECGAMEPOINT: Integer; //一次减数量
m_nINCGAMEGOLDTIME: Integer; //加游戏币间隔时间
m_nIncGameGold: Integer; //一次加数量
m_nINCGAMEPOINTTIME: Integer; //加游戏币间隔时间
m_nINCGAMEPOINT: Integer; //一次加数量
m_nMUSICID: Integer; //音乐ID
m_nEXPRATE: Integer; //经验倍率
m_nMonCount: Integer;
m_nHumCount: Integer;

m_boUnAllowStdItems: Boolean; //是否不允许使用物品
m_UnAllowStdItemsList: TGStringList; //不允许使用物品列表
m_boAutoMakeMonster: Boolean;
private
procedure Initialize(nWidth, nHeight: Integer);
public
constructor Create();
destructor Destroy; override;
function AddToMap(nX, nY: Integer; btType: Byte; pRemoveObject: TObject): Pointer;
function CanWalk(nX, nY: Integer; boFlag: Boolean): Boolean;
function CanWalkOfItem(nX, nY: Integer; boFlag, boItem: Boolean): Boolean;
function CanWalkEx(nX, nY: Integer; boFlag: Boolean): Boolean;
function CanFly(nSX, nSY, nDX, nDY: Integer): Boolean;
function MoveToMovingObject(nCX, nCY: Integer; Cert: TObject; nX, nY: Integer; boFlag: Boolean): Integer;
function GetItem(nX, nY: Integer): PTMapItem;
function DeleteFromMap(nX, nY: Integer; btType: Byte; pRemoveObject: TObject): Integer;
function IsCheapStuff(): Boolean;
procedure AddDoorToMap;
function AddToMapMineEvent(nX, nY: Integer; nType: Integer; Event: TObject): TObject;
function LoadMapData(sMapFile: string): Boolean;
function CreateQuest(nFlag, nValue: Integer; s24, s28, s2C: string; boGrouped: Boolean): Boolean;
function GetMapCellInfo(nX, nY: Integer; var MapCellInfo: pTMapCellinfo): Boolean;
function GetXYObjCount(nX, nY: Integer): Integer;
function GetNextPosition(sX, sY, nDir, nFlag: Integer; var snx: Integer; var sny: Integer): Boolean;
function sub_4B5FC8(nX, nY: Integer): Boolean;
procedure VerifyMapTime(nX, nY: Integer; BaseObject: TObject);
function CanSafeWalk(nX, nY: Integer): Boolean;
function ArroundDoorOpened(nX, nY: Integer): Boolean;
function GetMovingObject(nX, nY: Integer; boFlag: Boolean): Pointer;
function GetQuestNPC(BaseObject: TObject; sCharName, sStr: string; boFlag: Boolean): TObject;
function GetItemEx(nX, nY: Integer; var nCount: Integer): Pointer;
function GetDoor(nX, nY: Integer): pTDoorInfo;
function IsValidObject(nX, nY: Integer; nRage: Integer; BaseObject: TObject): Boolean;
function GetRangeBaseObject(nX, nY: Integer; nRage: Integer; boFlag: Boolean; BaseObjectList: TList): Integer;
function GeTBaseObjects(nX, nY: Integer; boFlag: Boolean; BaseObjectList: TList): Integer;
function GetEvent(nX, nY: Integer): TObject;
procedure SetMapXYFlag(nX, nY: Integer; boFlag: Boolean);
function GetXYHuman(nMapX, nMapY: Integer): Boolean;
function GetEnvirInfo(): string;
function AllowStdItems(sItemName: string): Boolean; overload;
function AllowStdItems(nItemIdx: Integer): Boolean; overload;
procedure AddObject(nType: Integer);
procedure DelObjectCount(BaseObject: TObject);
property MonCount: Integer read m_nMonCount;
property HumCount: Integer read m_nHumCount;

end;
TMapManager = class(TGList) //004B52B0
private
public
constructor Create();
destructor Destroy; override;
procedure LoadMapDoor();
function AddMapInfo(sMapName, sMainMapName, sMapDesc: string; nServerNumber: Integer; MapFlag: pTMapFlag; QuestNPC: TObject): TEnvirnoment;
function GetMapInfo(nServerIdx: Integer; sMapName: string): TEnvirnoment;
function AddMapRoute(sSMapNO: string; nSMapX, nSMapY: Integer; sDMapNO: string; nDMapX, nDMapY: Integer): Boolean;
function GetMapOfServerIndex(sMapName: string): Integer;
function FindMap(sMapName: string): TEnvirnoment;
function GetMainMap(Envir: TEnvirnoment): string;
procedure ReSetMinMap();
procedure Run();
procedure ProcessMapDoor();
procedure MakeSafePkZone();
end;
implementation

uses ObjBase, ObjNpc, M2Share, Event, ObjMon, HUtil32, Castle;

{ TEnvirList }

//004B7038
procedure TMapManager.MakeSafePkZone();
var
nX, nY: Integer;
SafeEvent: TSafeEvent;
nMinX, nMaxX, nMinY, nMaxY: Integer;
nRange, nType, nTime, nPoint: Integer;
I: Integer;
StartPoint: pTStartPoint;
Envir: TEnvirnoment;
begin
g_StartPointList.Lock;
for I := 0 to g_StartPointList.Count - 1 do begin
StartPoint := pTStartPoint(g_StartPointList.Objects[I]);
if (StartPoint <> nil) and (StartPoint.m_nType > 0) then begin
Envir := FindMap(StartPoint.m_sMapName);
if Envir <> nil then begin
nMinX := StartPoint.m_nCurrX - StartPoint.m_nRange;
nMaxX := StartPoint.m_nCurrX + StartPoint.m_nRange;
nMinY := StartPoint.m_nCurrY - StartPoint.m_nRange;
nMaxY := StartPoint.m_nCurrY + StartPoint.m_nRange;
for nX := nMinX to nMaxX do begin
for nY := nMinY to nMaxY do begin
if ((nX < nMaxX) and (nY = nMinY)) or
((nY < nMaxY) and (nX = nMinX)) or
(nX = nMaxX) or (nY = nMaxY) then begin
SafeEvent := TSafeEvent.Create(Envir, nX, nY, StartPoint.m_nType);
g_EventManager.AddEvent(SafeEvent);
end;
end;
end;
end;
end;
end;
end;

function TMapManager.AddMapInfo(sMapName, sMainMapName, sMapDesc: string; nServerNumber: Integer; MapFlag: pTMapFlag; QuestNPC: TObject): TEnvirnoment;
var
Envir: TEnvirnoment;
I: Integer;
nStd: Integer;
TempList: TStringList;
begin
Result := nil;
Envir := TEnvirnoment.Create;
Envir.sMapName := sMapName;
Envir.sMainMapName := sMainMapName;
Envir.sSubMapName := sMapName;
Envir.sMapDesc := sMapDesc;
if sMainMapName <> '' then Envir.m_boMainMap := True;
Envir.nServerIndex := nServerNumber;
Envir.m_boSAFE := MapFlag.boSAFE;
Envir.m_boFightZone := MapFlag.boFIGHT;
Envir.m_boFight3Zone := MapFlag.boFIGHT3;
Envir.m_boDARK := MapFlag.boDARK;
Envir.m_boDAY := MapFlag.boDAY;
Envir.m_boQUIZ := MapFlag.boQUIZ;
Envir.m_boNORECONNECT := MapFlag.boNORECONNECT;
Envir.m_boNEEDHOLE := MapFlag.boNEEDHOLE;
Envir.m_boNORECALL := MapFlag.boNORECALL;
Envir.m_boNOGUILDRECALL := MapFlag.boNOGUILDRECALL;
Envir.m_boNODEARRECALL := MapFlag.boNODEARRECALL;
Envir.m_boNOMASTERRECALL := MapFlag.boNOMASTERRECALL;
Envir.m_boNORANDOMMOVE := MapFlag.boNORANDOMMOVE;
Envir.m_boNODRUG := MapFlag.boNODRUG;
Envir.m_boMINE := MapFlag.boMINE;
Envir.m_boNOPOSITIONMOVE := MapFlag.boNOPOSITIONMOVE;

Envir.m_boRUNHUMAN := MapFlag.boRUNHUMAN; //可以穿人
Envir.m_boRUNMON := MapFlag.boRUNMON; //可以穿怪
Envir.m_boDECHP := MapFlag.boDECHP; //自动减HP值
Envir.m_boINCHP := MapFlag.boINCHP; //自动加HP值
Envir.m_boDecGameGold := MapFlag.boDECGAMEGOLD; //自动减游戏币
Envir.m_boDECGAMEPOINT := MapFlag.boDECGAMEPOINT; //自动减游戏币
Envir.m_boIncGameGold := MapFlag.boINCGAMEGOLD; //自动加游戏币
Envir.m_boINCGAMEPOINT := MapFlag.boINCGAMEPOINT; //自动加游戏点
Envir.m_boMUSIC := MapFlag.boMUSIC; //音乐
Envir.m_boEXPRATE := MapFlag.boEXPRATE; //杀怪经验倍数
Envir.m_boPKWINLEVEL := MapFlag.boPKWINLEVEL; //PK得等级
Envir.m_boPKWINEXP := MapFlag.boPKWINEXP; //PK得经验
Envir.m_boPKLOSTLEVEL := MapFlag.boPKLOSTLEVEL;
Envir.m_boPKLOSTEXP := MapFlag.boPKLOSTEXP;
Envir.m_nPKWINLEVEL := MapFlag.nPKWINLEVEL; //PK得等级数
Envir.m_nPKWINEXP := MapFlag.nPKWINEXP; //PK得经验数
Envir.m_nPKLOSTLEVEL := MapFlag.nPKLOSTLEVEL;
Envir.m_nPKLOSTEXP := MapFlag.nPKLOSTEXP;
Envir.m_nPKWINEXP := MapFlag.nPKWINEXP; //PK得经验数
Envir.m_nDECHPTIME := MapFlag.nDECHPTIME; //减HP间隔时间
Envir.m_nDECHPPOINT := MapFlag.nDECHPPOINT; //一次减点数
Envir.m_nINCHPTIME := MapFlag.nINCHPTIME; //加HP间隔时间
Envir.m_nINCHPPOINT := MapFlag.nINCHPPOINT; //一次加点数
Envir.m_nDECGAMEGOLDTIME := MapFlag.nDECGAMEGOLDTIME; //减游戏币间隔时间
Envir.m_nDecGameGold := MapFlag.nDECGAMEGOLD; //一次减数量
Envir.m_nINCGAMEGOLDTIME := MapFlag.nINCGAMEGOLDTIME; //减游戏币间隔时间
Envir.m_nIncGameGold := MapFlag.nINCGAMEGOLD; //一次减数量
Envir.m_nINCGAMEPOINTTIME := MapFlag.nINCGAMEPOINTTIME; //减游戏币间隔时间
Envir.m_nINCGAMEPOINT := MapFlag.nINCGAMEPOINT; //一次减数量
Envir.m_nMUSICID := MapFlag.nMUSICID; //音乐ID
Envir.m_nEXPRATE := MapFlag.nEXPRATE; //经验倍率

Envir.sNoReconnectMap := MapFlag.sReConnectMap;
Envir.QuestNPC := QuestNPC;
Envir.nNEEDSETONFlag := MapFlag.nNEEDSETONFlag;
Envir.nNeedONOFF := MapFlag.nNeedONOFF;
Envir.m_boAutoMakeMonster := MapFlag.boAutoMakeMonster;

if (MapFlag.boUnAllowStdItems) and (MapFlag.sUnAllowStdItemsText <> '') then begin
Envir.m_boUnAllowStdItems := True;
Envir.m_UnAllowStdItemsList := TGStringList.Create;
TempList := TStringList.Create;
ExtractStrings(['|', '\', '/'], [], PChar(Trim(MapFlag.sUnAllowStdItemsText)), TempList);
for I := 0 to TempList.Count - 1 do begin
nStd := UserEngine.GetStdItemIdx(Trim(TempList.Strings[I]));
if nStd >= 0 then
Envir.m_UnAllowStdItemsList.AddObject(Trim(TempList.Strings[I]), TObject(nStd));
end;
TempList.Free;
end;

for I := 0 to MiniMapList.Count - 1 do begin
if CompareText(MiniMapList.Strings[I], Envir.sMapName) = 0 then begin
Envir.nMinMap := Integer(MiniMapList.Objects[I]);
break;
end;
end;
if sMainMapName <> '' then begin
if Envir.LoadMapData(g_Config.sMapDir + sMainMapName + '.map') then begin
Result := Envir;
Self.Add(Envir);
end else begin
MainOutMessage('地图文件 ' + g_Config.sMapDir + sMainMapName + '.map' + ' 未找到！！！');
end;
end else begin
if Envir.LoadMapData(g_Config.sMapDir + sMapName + '.map') then begin
Result := Envir;
Self.Add(Envir);
end else begin
MainOutMessage('地图文件 ' + g_Config.sMapDir + sMapName + '.map' + ' 未找到！！！');
end;
end;
end;

function TMapManager.AddMapRoute(sSMapNO: string; nSMapX, nSMapY: Integer; sDMapNO: string; nDMapX, nDMapY: Integer): Boolean;
var
GateObj: pTGateObj;
SEnvir: TEnvirnoment;
DEnvir: TEnvirnoment;
begin
Result := False;
SEnvir := FindMap(sSMapNO);
DEnvir := FindMap(sDMapNO);
if (SEnvir <> nil) and (DEnvir <> nil) then begin
New(GateObj);
GateObj.boFlag := False;
GateObj.DEnvir := DEnvir;
GateObj.nDMapX := nDMapX;
GateObj.nDMapY := nDMapY;
SEnvir.AddToMap(nSMapX, nSMapY, OS_GATEOBJECT, TObject(GateObj));
Result := True;
end;
end;

function TEnvirnoment.AddToMap(nX, nY: Integer; btType: Byte;
pRemoveObject: TObject): Pointer;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
MapItem: PTMapItem;
I: Integer;
nGoldCount: Integer;
bo1E: Boolean;
btRaceServer: Byte;
nCheckCode: Integer;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::AddToMap';
begin
Result := nil;
try
bo1E := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
if (MapCellInfo.ObjList = nil) or (MapCellInfo.boListDisPose) then begin
MapCellInfo.ObjList := TList.Create;
MapCellInfo.boListDisPose := False;
end else begin
if btType = OS_ITEMOBJECT then begin
if PTMapItem(pRemoveObject).Name = sSTRING_GOLDNAME then begin
if (MapCellInfo.ObjList <> nil) and (MapCellInfo.ObjList.Count > 0) and (not MapCellInfo.boListDisPose) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_ITEMOBJECT then begin
MapItem := PTMapItem(pTOSObject(MapCellInfo.ObjList.Items[I]).CellObj);
if MapItem <> nil then begin
if MapItem.Name = sSTRING_GOLDNAME then begin
nGoldCount := MapItem.Count + PTMapItem(pRemoveObject).Count;
if nGoldCount <= 2000 then begin
MapItem.Count := nGoldCount;
MapItem.Looks := GetGoldShape(nGoldCount);
MapItem.AniCount := 0;
MapItem.Reserved := 0;
OSObject.dwAddTime := GetTickCount();
Result := MapItem;
bo1E := True;
end;
end;
end;
end;
end;
end;
end;
end;
if not bo1E and (MapCellInfo.ObjList <> nil) and (MapCellInfo.ObjList.Count >= 5) then begin
Result := nil;
bo1E := True;
end;
end;
if btType = OS_EVENTOBJECT then begin

end;
end;
if not bo1E then begin
OSObject := nil;
nCheckCode := 0;
New(OSObject);
nCheckCode := 1;
OSObject.btType := btType;
OSObject.CellObj := pRemoveObject;
OSObject.dwAddTime := GetTickCount();
OSObject.boObjectDisPose := False;
MapCellInfo.ObjList.Add(OSObject);
nCheckCode := 2;
Result := Pointer(pRemoveObject);
if (btType = OS_MOVINGOBJECT) and (not TBaseObject(pRemoveObject).m_boAddToMaped) then begin
TBaseObject(pRemoveObject).m_boDelFormMaped := False;
TBaseObject(pRemoveObject).m_boAddToMaped := True;
btRaceServer := TBaseObject(pRemoveObject).m_btRaceServer;
if btRaceServer = RC_PLAYOBJECT then Inc(m_nHumCount);
if btRaceServer >= RC_ANIMAL then Inc(m_nMonCount);
end;
end;
end;
except
if (nCheckCode = 1) and (OSObject <> nil) then begin
DisPose(OSObject);
end;
//MainOutMessage(sExceptionMsg);
end;
end;

function TEnvirnoment.AllowStdItems(sItemName: string): Boolean; //是否允许使用物品
var
I: Integer;
begin
Result := True;
if (not m_boUnAllowStdItems) or (m_UnAllowStdItemsList = nil) then Exit;
m_UnAllowStdItemsList.Lock;
try
for I := 0 to m_UnAllowStdItemsList.Count - 1 do begin
if CompareText(m_UnAllowStdItemsList.Strings[I], sItemName) = 0 then begin
Result := False;
break;
end;
end;
finally
m_UnAllowStdItemsList.UnLock;
end;
end;

function TEnvirnoment.AllowStdItems(nItemIdx: Integer): Boolean; //是否允许使用物品
var
I: Integer;
begin
Result := True;
if (not m_boUnAllowStdItems) or (m_UnAllowStdItemsList = nil) then Exit;
m_UnAllowStdItemsList.Lock;
try
for I := 0 to m_UnAllowStdItemsList.Count - 1 do begin
if Integer(m_UnAllowStdItemsList.Objects[I]) = nItemIdx then begin
Result := False;
break;
end;
end;
finally
m_UnAllowStdItemsList.UnLock;
end;
end;

procedure TEnvirnoment.AddDoorToMap();
var
I: Integer;
Door: pTDoorInfo;
begin
for I := 0 to m_DoorList.Count - 1 do begin
Door := m_DoorList.Items[I];
AddToMap(Door.nX, Door.nY, OS_DOOR, TObject(Door));
end;
end;

function TEnvirnoment.GetMapCellInfo(nX, nY: Integer; var MapCellInfo: pTMapCellinfo): Boolean; //004B57D8
begin
try
if (nX >= 0) and (nX < m_nWidth) and (nY >= 0) and (nY < m_nHeight) then begin
MapCellInfo := @MapCellArray[nX * m_nHeight + nY];
Result := True;
end else begin
Result := False;
end;
except
Result := False;
end;
end;

function TEnvirnoment.MoveToMovingObject(nCX, nCY: Integer; Cert: TObject; nX, nY: Integer; boFlag: Boolean): Integer; //004B612C
var
MapCellInfo: pTMapCellinfo;
BaseObject: TBaseObject;
OSObject: pTOSObject;
I: Integer;
bo1A: Boolean;
nCheckCode: Integer;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::MoveToMovingObject';
label
Loop, Over;
begin
Result := 0;
try
bo1A := True;
nCheckCode := 0;
if not boFlag and GetMapCellInfo(nX, nY, MapCellInfo) then begin
nCheckCode := 1;
if (MapCellInfo <> nil) and (not MapCellInfo.boListDisPose) then begin
if MapCellInfo.chFlag = 0 then begin
if (MapCellInfo.ObjList <> nil) and (MapCellInfo.ObjList.Count > 0) then begin
nCheckCode := 2;
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
nCheckCode := 3;
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
nCheckCode := 4;
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_MOVINGOBJECT then begin
if OSObject.CellObj <> nil then begin
BaseObject := TBaseObject(pTOSObject(OSObject.CellObj));
nCheckCode := 5;
if BaseObject <> nil then begin
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
bo1A := False;
break;
end;
end;
end;
end;
end;
end;
end;
end else begin // if MapCellInfo.chFlag = 0 then begin
Result := -1;
bo1A := False;
end;
end;
end;
if bo1A then begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo <> nil) and (MapCellInfo.chFlag <> 0) and (not MapCellInfo.boListDisPose) then begin
Result := -1;
end else begin
if GetMapCellInfo(nCX, nCY, MapCellInfo) and (MapCellInfo <> nil) and (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) then begin
I := 0;
while (True) do begin
if MapCellInfo.ObjList.Count <= I then break;
if MapCellInfo.ObjList.Count <= 0 then break;
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
nCheckCode := 6;
if OSObject.btType = OS_MOVINGOBJECT then begin
nCheckCode := 7;
if (TBaseObject(OSObject.CellObj) <> nil) and (TBaseObject(OSObject.CellObj) = TBaseObject(Cert)) and (TBaseObject(Cert) <> nil) then begin
if not OSObject.boObjectDisPose then begin
OSObject.boObjectDisPose := True;
try
DisPose(OSObject);
except
OSObject := nil;
end;
end;
MapCellInfo.ObjList.Delete(I);
if MapCellInfo.ObjList.Count > 0 then Continue;
nCheckCode := 11;
if not MapCellInfo.boListDisPose then begin
MapCellInfo.boListDisPose := True;
MapCellInfo.ObjList.Free;
MapCellInfo.ObjList := nil;
nCheckCode := 12;
end;
break;
end;
end;
end;
Inc(I);
end;
end;
nCheckCode := 13;
if GetMapCellInfo(nX, nY, MapCellInfo) then begin
if (MapCellInfo.ObjList = nil) or (MapCellInfo.boListDisPose) then begin
MapCellInfo.ObjList := TList.Create;
MapCellInfo.boListDisPose := False;
end;
New(OSObject);
OSObject.btType := OS_MOVINGOBJECT;
OSObject.CellObj := Cert;
OSObject.dwAddTime := GetTickCount;
OSObject.boObjectDisPose := False;
MapCellInfo.ObjList.Add(OSObject);
Result := 1;
end;
end;
end;
except
on E: Exception do begin
{MainOutMessage(sExceptionMsg + ' '+IntToStr(nCheckCode));
MainOutMessage(E.Message);}
end;
end;
// pMapCellInfo = GetMapCellInfo(nX, nY);
end;
//======================================================================
//检查地图指定座标是否可以移动
//boFlag 如果为TRUE 则忽略座标上是否有角色
//返回值 True 为可以移动，False 为不可以移动
//======================================================================
function TEnvirnoment.CanWalk(nX, nY: Integer; boFlag: Boolean): Boolean; //004B5ED0
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
I: Integer;
begin
Result := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
Result := True;
if not boFlag and (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) and (MapCellInfo.ObjList.Count > 0) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
Result := False;
break;
end;
end;
end;
end;
end;
end;
end;
end;

//======================================================================
//检查地图指定座标是否可以移动
//boFlag 如果为TRUE 则忽略座标上是否有角色
//返回值 True 为可以移动，False 为不可以移动
//======================================================================
function TEnvirnoment.CanWalkOfItem(nX, nY: Integer; boFlag, boItem: Boolean): Boolean;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
I: Integer;
begin
Result := True;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
if (MapCellInfo.ObjList <> nil) and (MapCellInfo.ObjList.Count > 0) and (not MapCellInfo.boListDisPose) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if not boFlag and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
Result := False;
break;
end;
end;
end;
end;
if not boItem and (OSObject.btType = OS_ITEMOBJECT) then begin
Result := False;
break;
end;
end;
end;
end;
end;

function TEnvirnoment.CanWalkEx(nX, nY: Integer; boFlag: Boolean): Boolean;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
I: Integer;
Castle: TUserCastle;
begin
Result := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
Result := True;
if not boFlag and (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) and (MapCellInfo.ObjList.Count > 0) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
{//01/25 多城堡控制
if g_Config.boWarDisHumRun and UserCastle.m_boUnderWar and
UserCastle.InCastleWarArea(BaseObject.m_PEnvir,BaseObject.m_nCurrX,BaseObject.m_nCurrY) then begin
}
Castle := g_CastleManager.InCastleWarArea(BaseObject);
if g_Config.boWarDisHumRun and (Castle <> nil) and (Castle.m_boUnderWar) then begin
end else begin
if BaseObject.m_btRaceServer = RC_PLAYOBJECT then begin
if g_Config.boRUNHUMAN or m_boRUNHUMAN then Continue;
end else begin
if BaseObject.m_btRaceServer = RC_NPC then begin
if g_Config.boRunNpc then Continue;
end else begin
if BaseObject.m_btRaceServer in [RC_GUARD, RC_ARCHERGUARD] then begin
if g_Config.boRunGuard then Continue;
end else begin
if BaseObject.m_btRaceServer <> 55 then begin //不允许穿过练功师
if g_Config.boRUNMON or m_boRUNMON then Continue;
end;
end;
end;
end;
end;
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
Result := False;
break;
end;
end;
end;
end;
end;
end;
end;
end;

constructor TMapManager.Create;
begin

inherited Create;
end;

destructor TMapManager.Destroy;
var
I: Integer;
begin
for I := 0 to Count - 1 do begin
TEnvirnoment(Items[I]).Free;
end;

inherited;
end;

function TMapManager.GetMainMap(Envir: TEnvirnoment): string;
begin
if Envir.m_boMainMap then Result := Envir.sMainMapName
else Result := Envir.sMapName;
end;

function TMapManager.FindMap(sMapName: string): TEnvirnoment;
var
Map: TEnvirnoment;
I: Integer;
begin
Result := nil;
Lock;
try
for I := 0 to Count - 1 do begin
Map := TEnvirnoment(Items[I]);
if Map <> nil then begin
if CompareText(Map.sMapName, sMapName) = 0 then begin
Result := Map;
break;
end;
end;
end;
finally
UnLock;
end;
end;

function TMapManager.GetMapInfo(nServerIdx: Integer; sMapName: string): TEnvirnoment;
var
I: Integer;
Envir: TEnvirnoment;
begin
Result := nil;
Lock;
try
for I := 0 to Count - 1 do begin
Envir := Items[I];
if Envir <> nil then begin
if (Envir.nServerIndex = nServerIdx) and (CompareText(Envir.sMapName, sMapName) = 0) then begin
Result := Envir;
break;
end;
end;
end;
finally
UnLock;
end;
end;

function TEnvirnoment.DeleteFromMap(nX, nY: Integer; btType: Byte;
pRemoveObject: TObject): Integer;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
n18: Integer;
btRaceServer: Byte;
resourcestring
sExceptionMsg1 = '[Exception] TEnvirnoment::DeleteFromMap -> Except 1 ** %d';
sExceptionMsg2 = '[Exception] TEnvirnoment::DeleteFromMap -> Except 2 ** %d';
begin
Result := -1;
try
if GetMapCellInfo(nX, nY, MapCellInfo) then begin
if MapCellInfo <> nil then begin
try
if (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) and (MapCellInfo.ObjList.Count > 0) then begin
n18 := 0;
while (True) do begin
if MapCellInfo.ObjList.Count <= n18 then break;
if MapCellInfo.ObjList.Count <= 0 then break;
OSObject := pTOSObject(MapCellInfo.ObjList.Items[n18]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if (OSObject.btType = btType) and (OSObject.CellObj = pRemoveObject) then begin
if not OSObject.boObjectDisPose then begin
OSObject.boObjectDisPose := True;
try
DisPose(OSObject);
except
OSObject := nil;
end;
end;
MapCellInfo.ObjList.Delete(n18);
Result := 1;
//减地图人物怪物计数
if (btType = OS_MOVINGOBJECT) and (not TBaseObject(pRemoveObject).m_boDelFormMaped) then begin
TBaseObject(pRemoveObject).m_boDelFormMaped := True;
TBaseObject(pRemoveObject).m_boAddToMaped := False;
btRaceServer := TBaseObject(pRemoveObject).m_btRaceServer;
if btRaceServer = RC_PLAYOBJECT then Dec(m_nHumCount);
if btRaceServer >= RC_ANIMAL then Dec(m_nMonCount);
end;

if MapCellInfo.ObjList.Count > 0 then Continue;
if not MapCellInfo.boListDisPose then begin
MapCellInfo.boListDisPose := True;
MapCellInfo.ObjList.Free;
MapCellInfo.ObjList := nil;
end;
break;
//Jacky 处理防止内存泄露有待换上
{ if MapCellInfo.ObjList.Count <= 0 then begin
MapCellInfo.ObjList.Free;
MapCellInfo.ObjList:=nil;
break;
end; }
end
end else begin
MapCellInfo.ObjList.Delete(n18);
if MapCellInfo.ObjList.Count > 0 then Continue;
if not MapCellInfo.boListDisPose then begin
MapCellInfo.boListDisPose := True;
MapCellInfo.ObjList.Free;
MapCellInfo.ObjList := nil;
end;
break;
end;
Inc(n18);
end;
end else begin
Result := -2;
end;
except
OSObject := nil;
//MainOutMessage(format(sExceptionMsg1, [btType]));
end;
end else Result := -3;
end else Result := 0;
except
//MainOutMessage(format(sExceptionMsg2, [btType]));
end;
end;

function TEnvirnoment.GetItem(nX, nY: Integer): PTMapItem;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := nil;
bo2C := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
bo2C := True;
if (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) and (MapCellInfo.ObjList.Count > 0) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_ITEMOBJECT then begin
Result := PTMapItem(OSObject.CellObj);
Exit;
end;
if OSObject.btType = OS_GATEOBJECT then
bo2C := False;
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boDeath then
bo2C := False;
end;
end;
end;
end;
end;
end;
end;

function TMapManager.GetMapOfServerIndex(sMapName: string): Integer;
var
I: Integer;
Envir: TEnvirnoment;
begin
Result := 0;
Lock;
try
for I := 0 to Count - 1 do begin
Envir := Items[I];
if Envir <> nil then begin
if (CompareText(Envir.sMapName, sMapName) = 0) then begin
Result := Envir.nServerIndex;
break;
end;
end;
end;
finally
UnLock;
end;
end;

procedure TMapManager.LoadMapDoor;
var
I: Integer;
begin
for I := 0 to Count - 1 do begin
TEnvirnoment(Items[I]).AddDoorToMap;
end;
end;
procedure TMapManager.ProcessMapDoor;
begin

end;

procedure TMapManager.ReSetMinMap;
var
I, ii: Integer;
Envirnoment: TEnvirnoment;
begin
for I := 0 to Count - 1 do begin
Envirnoment := TEnvirnoment(Items[I]);
if Envirnoment <> nil then begin
for ii := 0 to MiniMapList.Count - 1 do begin
if CompareText(MiniMapList.Strings[ii], Envirnoment.sMapName) = 0 then begin
Envirnoment.nMinMap := Integer(MiniMapList.Objects[ii]);
break;
end;
end;
end;
end;
end;

function TEnvirnoment.IsCheapStuff: Boolean;
begin
if m_QuestList.Count > 0 then Result := True
else Result := False;
end;

function TEnvirnoment.AddToMapMineEvent(nX, nY: Integer; nType: Integer; Event: TObject): TObject;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
bo19, bo1A: Boolean;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::AddToMapMineEvent ';
begin
Result := nil;
try
bo19 := GetMapCellInfo(nX, nY, MapCellInfo);
bo1A := False;
if bo19 and (MapCellInfo.chFlag <> 0) then begin
if (MapCellInfo.ObjList = nil) or (MapCellInfo.boListDisPose) then begin
MapCellInfo.ObjList := TList.Create;
MapCellInfo.boListDisPose := False;
end;
if not bo1A then begin
New(OSObject);
OSObject.btType := nType;
OSObject.CellObj := Event;
OSObject.dwAddTime := GetTickCount();
OSObject.boObjectDisPose := False;
MapCellInfo.ObjList.Add(OSObject);
Result := Event;
end;
end;
except
MainOutMessage(sExceptionMsg);
end;
end;

procedure TEnvirnoment.VerifyMapTime(nX, nY: Integer; BaseObject: TObject);
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
boVerify: Boolean;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::VerifyMapTime';
begin
try
boVerify := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo <> nil) and (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if (OSObject.btType = OS_MOVINGOBJECT) and (OSObject.CellObj = BaseObject) then begin
OSObject.dwAddTime := GetTickCount();
boVerify := True;
break;
end;
end;
end;
end;
if not boVerify then
AddToMap(nX, nY, OS_MOVINGOBJECT, BaseObject);
except
MainOutMessage(sExceptionMsg);
end;
end;

constructor TEnvirnoment.Create;
begin
Pointer(MapCellArray) := nil;
sMapName := '';
sSubMapName := '';
sMainMapName := '';
m_boMainMap := False;
nServerIndex := 0;
nMinMap := 0;
m_nWidth := 0;
m_nHeight := 0;
m_boDARK := False;
m_boDAY := False;
m_nMonCount := 0;
m_nHumCount := 0; ;
m_DoorList := TList.Create;
m_QuestList := TList.Create;
end;

destructor TEnvirnoment.Destroy;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
nX, nY: Integer;
DoorInfo: pTDoorInfo;
begin
for nX := 0 to m_nWidth - 1 do begin
for nY := 0 to m_nHeight - 1 do begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.CellObj <> nil then begin
case OSObject.btType of
OS_ITEMOBJECT: DisPose(PTMapItem(OSObject.CellObj));
OS_GATEOBJECT: DisPose(pTGateObj(OSObject.CellObj));
OS_EVENTOBJECT: TEvent(OSObject.CellObj).Free;
end;
end;
DisPose(OSObject);
end;
end;
MapCellInfo.ObjList.Free;
MapCellInfo.ObjList := nil;
end;
end;
end;

for I := 0 to m_DoorList.Count - 1 do begin
DoorInfo := m_DoorList.Items[I];
if DoorInfo <> nil then begin
Dec(DoorInfo.Status.nRefCount);
if DoorInfo.Status.nRefCount <= 0 then
DisPose(DoorInfo.Status);
DisPose(DoorInfo);
end;
end;
m_DoorList.Free;
for I := 0 to m_QuestList.Count - 1 do begin
DisPose(pTMapQuestInfo(m_QuestList.Items[I]));
end;
m_QuestList.Free;
FreeMem(MapCellArray);
Pointer(MapCellArray) := nil;
inherited;
end;

function TEnvirnoment.LoadMapData(sMapFile: string): Boolean;
var
fHandle: Integer;
Header: TMapHeader;
nMapSize: Integer;
n24, nW, nH: Integer;
MapBuffer: pTMap;
Point: Integer;
Door: pTDoorInfo;
I: Integer;
MapCellInfo: pTMapCellinfo;
begin
Result := False;
if FileExists(sMapFile) then begin
fHandle := FileOpen(sMapFile, fmOpenRead or fmShareExclusive);
if fHandle > 0 then begin
FileRead(fHandle, Header, SizeOf(TMapHeader));
m_nWidth := Header.wWidth;
m_nHeight := Header.wHeight;
Initialize(m_nWidth, m_nHeight);
nMapSize := m_nWidth * SizeOf(TMapUnitInfo) * m_nHeight;

MapBuffer := AllocMem(nMapSize);
FileRead(fHandle, MapBuffer^, nMapSize);

for nW := 0 to m_nWidth - 1 do begin
n24 := nW * m_nHeight;
for nH := 0 to m_nHeight - 1 do begin
if (MapBuffer[n24 + nH].wBkImg) and $8000 <> 0 then begin
MapCellInfo := @MapCellArray[n24 + nH];
MapCellInfo.chFlag := 1;
end;
if MapBuffer[n24 + nH].wFrImg and $8000 <> 0 then begin
MapCellInfo := @MapCellArray[n24 + nH];
MapCellInfo.chFlag := 2;
end;
if MapBuffer[n24 + nH].btDoorIndex and $80 <> 0 then begin
Point := (MapBuffer[n24 + nH].btDoorIndex and $7F);
if Point > 0 then begin
New(Door);
Door.nX := nW;
Door.nY := nH;
Door.n08 := Point;
Door.Status := nil;
for I := 0 to m_DoorList.Count - 1 do begin
if abs(pTDoorInfo(m_DoorList.Items[I]).nX - Door.nX) <= 10 then begin
if abs(pTDoorInfo(m_DoorList.Items[I]).nY - Door.nY) <= 10 then begin
if pTDoorInfo(m_DoorList.Items[I]).n08 = Point then begin
Door.Status := pTDoorInfo(m_DoorList.Items[I]).Status;
Inc(Door.Status.nRefCount);
break;
end;
end;
end;
end;
if Door.Status = nil then begin
New(Door.Status);
Door.Status.boOpened := False;
Door.Status.bo01 := False;
Door.Status.n04 := 0;
Door.Status.dwOpenTick := 0;
Door.Status.nRefCount := 1;
end;
m_DoorList.Add(Door);
end;
end;
end;
end;
//Dispose(MapBuffer);
FreeMem(MapBuffer);
FileClose(fHandle);
Result := True;
end; //004B57B1
end; //004B57B1
end;

procedure TEnvirnoment.Initialize(nWidth, nHeight: Integer); //004B53FC
var
nW, nH: Integer;
MapCellInfo: pTMapCellinfo;
begin
if (nWidth > 1) and (nHeight > 1) then begin
if MapCellArray <> nil then begin
for nW := 0 to m_nWidth - 1 do begin
for nH := 0 to m_nHeight - 1 do begin
MapCellInfo := @MapCellArray[nW * m_nHeight + nH];
if MapCellInfo.ObjList <> nil then begin
MapCellInfo.ObjList.Free;
MapCellInfo.ObjList := nil;
end;
end;
end;
FreeMem(MapCellArray);
Pointer(MapCellArray) := nil;
end; //004B54AF
m_nWidth := nWidth;
m_nHeight := nHeight;
Pointer(MapCellArray) := AllocMem((m_nWidth * m_nHeight) * SizeOf(TMapCellinfo));
end; //004B54DB
end;

//nFlag,boFlag,Monster,Item,Quest,boGrouped
function TEnvirnoment.CreateQuest(nFlag, nValue: Integer; s24, s28, s2C: string;
boGrouped: Boolean): Boolean; //004B6C3C
var
MapQuest: pTMapQuestInfo;
MapMerchant: TMerchant;
begin
Result := False;
if nFlag < 0 then Exit;
New(MapQuest);
MapQuest.nFlag := nFlag;
if nValue > 1 then nValue := 1;
MapQuest.nValue := nValue;
if s24 = '*' then s24 := '';
MapQuest.s08 := s24;
if s28 = '*' then s28 := '';
MapQuest.s0C := s28;
if s2C = '*' then s2C := '';

MapQuest.bo10 := boGrouped;
MapMerchant := TMerchant.Create;
MapMerchant.m_sMapName := '0';
MapMerchant.m_nCurrX := 0;
MapMerchant.m_nCurrY := 0;
MapMerchant.m_sCharName := s2C;
MapMerchant.m_nFlag := 0;
MapMerchant.m_wAppr := 0;
MapMerchant.m_sFilePath := 'MapQuest_def\';
MapMerchant.m_boIsHide := True;
MapMerchant.m_boIsQuest := False;

UserEngine.QuestNPCList.Add(MapMerchant);
MapQuest.NPC := MapMerchant;
m_QuestList.Add(MapQuest);
Result := True;
end;

function TEnvirnoment.GetXYObjCount(nX, nY: Integer): Integer;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := 0;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost and
BaseObject.bo2B9 and
not BaseObject.m_boDeath and
not BaseObject.m_boFixedHideMode and
not BaseObject.m_boObMode then begin
Inc(Result);
end;
end;
end;
end;
end;
end;
end;

function TEnvirnoment.GetNextPosition(sX, sY, nDir, nFlag: Integer; var snx: Integer; var sny: Integer): Boolean;
begin
snx := sX;
sny := sY;
case nDir of
DR_UP: if sny > nFlag - 1 then Dec(sny, nFlag);
DR_DOWN: if sny < (m_nHeight - nFlag) then Inc(sny, nFlag);
DR_LEFT: if snx > nFlag - 1 then Dec(snx, nFlag);
DR_RIGHT: if snx < (m_nWidth - nFlag) then Inc(snx, nFlag);
DR_UPLEFT: begin
if (snx > nFlag - 1) and (sny > nFlag - 1) then begin
Dec(snx, nFlag);
Dec(sny, nFlag);
end;
end;
DR_UPRIGHT: begin
if (snx > nFlag - 1) and (sny < (m_nHeight - nFlag)) then begin
Inc(snx, nFlag);
Dec(sny, nFlag);
end;
end;
DR_DOWNLEFT: begin
if (snx < (m_nWidth - nFlag)) and (sny > nFlag - 1) then begin
Dec(snx, nFlag);
Inc(sny, nFlag);
end;
end;
DR_DOWNRIGHT: begin
if (snx < (m_nWidth - nFlag)) and (sny < (m_nHeight - nFlag)) then begin
Inc(snx, nFlag);
Inc(sny, nFlag);
end;
end;
end;
if (snx = sX) and (sny = sY) then Result := False
else Result := True;
end;

function TEnvirnoment.CanSafeWalk(nX, nY: Integer): Boolean;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
begin
Result := True;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) and (MapCellInfo.ObjList.Count > 0) and (not MapCellInfo.boListDisPose) then begin
for I := MapCellInfo.ObjList.Count - 1 downto 0 do begin
if MapCellInfo.ObjList.Count <= 0 then break;
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_EVENTOBJECT then begin
if TEvent(OSObject.CellObj).m_nDamage > 0 then Result := False;
end;
end;
end;
end;
end;

function TEnvirnoment.ArroundDoorOpened(nX, nY: Integer): Boolean;
var
I: Integer;
Door: pTDoorInfo;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::ArroundDoorOpened ';
begin
Result := True;
try
for I := 0 to m_DoorList.Count - 1 do begin
Door := m_DoorList.Items[I];
if Door <> nil then begin
if (abs(Door.nX - nX) <= 1) and ((abs(Door.nY - nY) <= 1)) then begin
if not Door.Status.boOpened then begin
Result := False;
break;
end;
end;
end;
end;
except
MainOutMessage(sExceptionMsg);
end;
end;

function TEnvirnoment.GetMovingObject(nX, nY: Integer; boFlag: Boolean): Pointer;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := nil;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if ((BaseObject <> nil) and
(not BaseObject.m_boGhost) and
(BaseObject.bo2B9)) and
((not boFlag) or (not BaseObject.m_boDeath)) then begin
Result := BaseObject;
break;
end;
end;
end;
end;
end;
end;

function TEnvirnoment.GetQuestNPC(BaseObject: TObject; sCharName, sStr: string; boFlag: Boolean): TObject; //004B6E4C
var
I: Integer;
MapQuestFlag: pTMapQuestInfo;
nFlagValue: Integer;
bo1D: Boolean;
begin
Result := nil;
for I := 0 to m_QuestList.Count - 1 do begin
MapQuestFlag := m_QuestList.Items[I];
if MapQuestFlag <> nil then begin
nFlagValue := TBaseObject(BaseObject).GetQuestFalgStatus(MapQuestFlag.nFlag);
if nFlagValue = MapQuestFlag.nValue then begin
if (boFlag = MapQuestFlag.bo10) or (not boFlag) then begin
bo1D := False;
if (MapQuestFlag.s08 <> '') and (MapQuestFlag.s0C <> '') then begin
if (MapQuestFlag.s08 = sCharName) and (MapQuestFlag.s0C = sStr) then
bo1D := True;
end;
if (MapQuestFlag.s08 <> '') and (MapQuestFlag.s0C = '') then begin
if (MapQuestFlag.s08 = sCharName) and (sStr = '') then
bo1D := True;
end;
if (MapQuestFlag.s08 = '') and (MapQuestFlag.s0C <> '') then begin
if (MapQuestFlag.s0C = sStr) then
bo1D := True;
end;
if bo1D then begin
Result := MapQuestFlag.NPC;
break;
end;
end;
end;
end;
end;
end;

function TEnvirnoment.GetItemEx(nX, nY: Integer;
var nCount: Integer): Pointer; //004B5C10
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := nil;
nCount := 0;
bo2C := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
bo2C := True;
if (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_ITEMOBJECT then begin
Result := Pointer(OSObject.CellObj);
Inc(nCount);
end;
if OSObject.btType = OS_GATEOBJECT then begin
bo2C := False;
end;
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if not BaseObject.m_boDeath then
bo2C := False;
end;
end;
end;
end;
end;
end;

function TEnvirnoment.GetDoor(nX, nY: Integer): pTDoorInfo;
var
I: Integer;
Door: pTDoorInfo;
begin
Result := nil;
for I := 0 to m_DoorList.Count - 1 do begin
Door := m_DoorList.Items[I];
if Door <> nil then begin
if (Door.nX = nX) and (Door.nY = nY) then begin
Result := Door;
Exit;
end;
end;
end;
end;

function TEnvirnoment.IsValidObject(nX, nY, nRage: Integer; BaseObject: TObject): Boolean;
var
nXX, nYY, I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
begin
Result := False;
for nXX := nX - nRage to nX + nRage do begin
for nYY := nY - nRage to nY + nRage do begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.CellObj = BaseObject then begin
Result := True;
Exit;
end;
end;
end;
end;
end;
end;
end;

function TEnvirnoment.GetRangeBaseObject(nX, nY, nRage: Integer; boFlag: Boolean;
BaseObjectList: TList): Integer;
var
nXX, nYY: Integer;
begin
for nXX := nX - nRage to nX + nRage do begin
for nYY := nY - nRage to nY + nRage do begin
GeTBaseObjects(nXX, nYY, boFlag, BaseObjectList);
end;
end;
if BaseObjectList <> nil then
Result := BaseObjectList.Count;
end;
//boFlag 是否包括死亡对象
//FALSE 包括死亡对象
//TRUE 不包括死亡对象
function TEnvirnoment.GeTBaseObjects(nX, nY: Integer; boFlag: Boolean;
BaseObjectList: TList): Integer;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost and BaseObject.bo2B9 then begin
if not boFlag or not BaseObject.m_boDeath then
BaseObjectList.Add(BaseObject);
end;
end;
end;
end;
end;
end;
if BaseObjectList <> nil then
Result := BaseObjectList.Count;
end;

function TEnvirnoment.GetEvent(nX, nY: Integer): TObject;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
begin
Result := nil;
bo2C := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_EVENTOBJECT then begin
Result := OSObject.CellObj;
end;
end;
end;
end;
end;

procedure TEnvirnoment.SetMapXYFlag(nX, nY: Integer; boFlag: Boolean);
var
MapCellInfo: pTMapCellinfo;
begin
if GetMapCellInfo(nX, nY, MapCellInfo) then begin
if boFlag and (MapCellInfo <> nil) then MapCellInfo.chFlag := 0
else MapCellInfo.chFlag := 2;
end;
end;

function TEnvirnoment.CanFly(nSX, nSY, nDX, nDY: Integer): Boolean;
var
r28, r30: real;
n14, n18, n1C: Integer;
begin
Result := True;
r28 := (nDX - nSX) / 1.0E1;
r30 := (nDY - nDX) / 1.0E1;
n14 := 0;
while (True) do begin
n18 := ROUND(nSX + r28);
n1C := ROUND(nSY + r30);
if not CanWalk(n18, n1C, True) then begin
Result := False;
break;
end;
Inc(n14);
if n14 >= 10 then break;
end;
end;

function TEnvirnoment.GetXYHuman(nMapX, nMapY: Integer): Boolean;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := False;
if GetMapCellInfo(nMapX, nMapY, MapCellInfo) and (MapCellInfo.ObjList <> nil) and (not MapCellInfo.boListDisPose) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := pTOSObject(MapCellInfo.ObjList.Items[I]);
if (OSObject <> nil) and (not OSObject.boObjectDisPose) then begin
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if BaseObject.m_btRaceServer = RC_PLAYOBJECT then begin
Result := True;
break;
end;
end;
end;
end;
end;
end;
end;

function TEnvirnoment.sub_4B5FC8(nX, nY: Integer): Boolean;
var
MapCellInfo: pTMapCellinfo;
begin
Result := True;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo <> nil) and (MapCellInfo.chFlag = 2) then
Result := False;
end;

function TEnvirnoment.GetEnvirInfo: string;
var
sMsg: string;
begin
sMsg := '地图名:%s(%s) DAY:%s DARK:%s SAFE:%s FIGHT:%s FIGHT3:%s QUIZ:%s NORECONNECT:%s(%s) MUSIC:%s(%d) EXPRATE:%s(%f) PKWINLEVEL:%s(%d) PKLOSTLEVEL:%s(%d) PKWINEXP:%s(%d) PKLOSTEXP:%s(%d) DECHP:%s(%d/%d) INCHP:%s(%d/%d)';
sMsg := sMsg + ' DECGAMEGOLD:%s(%d/%d) INCGAMEGOLD:%s(%d/%d) INCGAMEPOINT:%s(%d/%d) RUNHUMAN:%s RUNMON:%s NEEDHOLE:%s NORECALL:%s NOGUILDRECALL:%s NODEARRECALL:%s NOMASTERRECALL:%s NODRUG:%s MINE:%s NOPOSITIONMOVE:%s';
Result := format(sMsg, [sMapName,
sMapDesc,
BoolToCStr(m_boDAY),
BoolToCStr(m_boDARK),
BoolToCStr(m_boSAFE),
BoolToCStr(m_boFightZone),
BoolToCStr(m_boFight3Zone),
BoolToCStr(m_boQUIZ),
BoolToCStr(m_boNORECONNECT), sNoReconnectMap,
BoolToCStr(m_boMUSIC), m_nMUSICID,
BoolToCStr(m_boEXPRATE), m_nEXPRATE / 100,
BoolToCStr(m_boPKWINLEVEL), m_nPKWINLEVEL,
BoolToCStr(m_boPKLOSTLEVEL), m_nPKLOSTLEVEL,
BoolToCStr(m_boPKWINEXP), m_nPKWINEXP,
BoolToCStr(m_boPKLOSTEXP), m_nPKLOSTEXP,
BoolToCStr(m_boDECHP), m_nDECHPTIME, m_nDECHPPOINT,
BoolToCStr(m_boINCHP), m_nINCHPTIME, m_nINCHPPOINT,
BoolToCStr(m_boDecGameGold), m_nDECGAMEGOLDTIME, m_nDecGameGold,
BoolToCStr(m_boIncGameGold), m_nINCGAMEGOLDTIME, m_nIncGameGold,
BoolToCStr(m_boINCGAMEPOINT), m_nINCGAMEPOINTTIME, m_nINCGAMEPOINT,
BoolToCStr(m_boRUNHUMAN),
BoolToCStr(m_boRUNMON),
BoolToCStr(m_boNEEDHOLE),
BoolToCStr(m_boNORECALL),
BoolToCStr(m_boNOGUILDRECALL),
BoolToCStr(m_boNODEARRECALL),
BoolToCStr(m_boNOMASTERRECALL),
BoolToCStr(m_boNODRUG),
BoolToCStr(m_boMINE),
BoolToCStr(m_boNOPOSITIONMOVE)
]);
end;

procedure TEnvirnoment.AddObject(nType: Integer);
begin
case nType of
0: Inc(m_nHumCount);
1: Inc(m_nMonCount);
end;
end;

procedure TEnvirnoment.DelObjectCount(BaseObject: TObject);
var
btRaceServer: Byte;
begin
btRaceServer := TBaseObject(BaseObject).m_btRaceServer;
if btRaceServer = RC_PLAYOBJECT then Dec(m_nHumCount);
if btRaceServer >= RC_ANIMAL then Dec(m_nMonCount);
end;

procedure TMapManager.Run;
begin

end;

end.

**hujiacheng** · 10-12-07

unit Envir;

interface

uses
Windows, SysUtils, Classes, Grobal2;
type
TMapHeader = packed record
wWidth: Word;
wHeight: Word;
sTitle: string[16];
UpdateDate: TDateTime;
Reserved: array[0..22] of Char;
end;
TMapUnitInfo = packed record
wBkImg: Word; //32768 $8000 为禁止移动区域
wMidImg: Word;
wFrImg: Word;
btDoorIndex: Byte; //$80 (巩娄), 巩狼侥喊牢郸胶
btDoorOffset: Byte; //摧腮巩狼弊覆狼惑措困摹, $80 (凯覆/摧塞(扁夯))
btAniFrame: Byte; //$80(Draw Alpha) + 橇贰烙荐
btAniTick: Byte;
btArea: Byte; //瘤开沥焊
btLight: Byte; //0..1..4 堡盔瓤苞
end;
pTMapUnitInfo = ^TMapUnitInfo;
TMap = array[0..1000 * 1000 - 1] of TMapUnitInfo;
pTMap = ^TMap;
TMapCellinfo = record
chFlag: Byte;
bt1: Byte;
bt2: Byte;
bt3: Byte;
ObjList: TList;
end;
pTMapCellinfo = ^TMapCellinfo;
PTEnvirnoment = ^TEnvirnoment;
TEnvirnoment = class
sMapName: string; //0x4
sMapDesc: string;
sMainMapName: string; //0x4
sSubMapName: string; //0x4
m_boMainMap: Boolean; //0x25
MapCellArray: array of TMapCellinfo; //0x0C
nMinMap: Integer; //0x10
nServerIndex: Integer; //0x14
nRequestLevel: Integer; //0x18 进入本地图所需等级
m_nWidth: Integer; //0x1C
m_nHeight: Integer; //0x20
m_boDARK: Boolean; //0x24
m_boDAY: Boolean; //0x25
m_boDarkness: Boolean;
m_boDayLight: Boolean;
m_DoorList: TList; //0x28
bo2C: Boolean;
m_boSAFE: Boolean; //0x2D
m_boFightZone: Boolean; //0x2E
m_boFight3Zone: Boolean; //0x2F //行会战争地图
m_boQUIZ: Boolean; //0x30
m_boNORECONNECT: Boolean; //0x31
m_boNEEDHOLE: Boolean; //0x32
m_boNORECALL: Boolean; //0x33
m_boNOGUILDRECALL: Boolean;
m_boNODEARRECALL: Boolean;
m_boNOMASTERRECALL: Boolean;
m_boNORANDOMMOVE: Boolean; //0x34
m_boNODRUG: Boolean; //0x35
m_boMINE: Boolean; //0x36
m_boNOPOSITIONMOVE: Boolean; //0x37
sNoReconnectMap: string; //0x38
QuestNPC: TObject; //0x3C
nNEEDSETONFlag: Integer; //0x40
nNeedONOFF: Integer; //0x44
m_QuestList: TList; //0x48
m_boRUNHUMAN: Boolean; //可以穿人
m_boRUNMON: Boolean; //可以穿怪
m_boINCHP: Boolean; //自动加HP值
m_boIncGameGold: Boolean; //自动减游戏币
m_boINCGAMEPOINT: Boolean; //自动加点
m_boDECHP: Boolean; //自动减HP值
m_boDecGameGold: Boolean; //自动减游戏币
m_boDECGAMEPOINT: Boolean; //自动减点
m_boMUSIC: Boolean; //音乐
m_boEXPRATE: Boolean; //杀怪经验倍数
m_boPKWINLEVEL: Boolean; //PK得等级
m_boPKWINEXP: Boolean; //PK得经验
m_boPKLOSTLEVEL: Boolean; //PK丢等级
m_boPKLOSTEXP: Boolean; //PK丢经验
m_nPKWINLEVEL: Integer; //PK得等级数
m_nPKLOSTLEVEL: Integer; //PK丢等级
m_nPKWINEXP: Integer; //PK得经验数
m_nPKLOSTEXP: Integer; //PK丢经验
m_nDECHPTIME: Integer; //减HP间隔时间
m_nDECHPPOINT: Integer; //一次减点数
m_nINCHPTIME: Integer; //加HP间隔时间
m_nINCHPPOINT: Integer; //一次加点数
m_nDECGAMEGOLDTIME: Integer; //减游戏币间隔时间
m_nDecGameGold: Integer; //一次减数量
m_nDECGAMEPOINTTIME: Integer; //减游戏点间隔时间
m_nDECGAMEPOINT: Integer; //一次减数量
m_nINCGAMEGOLDTIME: Integer; //加游戏币间隔时间
m_nIncGameGold: Integer; //一次加数量
m_nINCGAMEPOINTTIME: Integer; //加游戏币间隔时间
m_nINCGAMEPOINT: Integer; //一次加数量
m_nMUSICID: Integer; //音乐ID
m_nEXPRATE: Integer; //经验倍率
m_nMonCount: Integer;
m_nHumCount: Integer;

m_boUnAllowStdItems: Boolean; //是否不允许使用物品
m_UnAllowStdItemsList: TGStringList; //不允许使用物品列表
private
procedure Initialize(nWidth, nHeight: Integer);
public
constructor Create();
destructor Destroy; override;
function AddToMap(nX, nY: Integer; btType: Byte; pRemoveObject: TObject): Pointer;
function CanWalk(nX, nY: Integer; boFlag: Boolean): Boolean;
function CanWalkOfItem(nX, nY: Integer; boFlag, boItem: Boolean): Boolean;
function CanWalkEx(nX, nY: Integer; boFlag: Boolean): Boolean;
function CanFly(nSX, nSY, nDX, nDY: Integer): Boolean;
function MoveToMovingObject(nCX, nCY: Integer; Cert: TObject; nX, nY: Integer; boFlag: Boolean): Integer;
function GetItem(nX, nY: Integer): PTMapItem;
function DeleteFromMap(nX, nY: Integer; btType: Byte; pRemoveObject: TObject): Integer;
function IsCheapStuff(): Boolean;
procedure AddDoorToMap;
function AddToMapMineEvent(nX, nY: Integer; nType: Integer; Event: TObject): TObject;
function LoadMapData(sMapFile: string): Boolean;
function CreateQuest(nFlag, nValue: Integer; s24, s28, s2C: string; boGrouped: Boolean): Boolean;
function GetMapCellInfo(nX, nY: Integer; var MapCellInfo: pTMapCellinfo): Boolean;
function GetXYObjCount(nX, nY: Integer): Integer;
function GetNextPosition(sX, sY, nDir, nFlag: Integer; var snx: Integer; var sny: Integer): Boolean;
function sub_4B5FC8(nX, nY: Integer): Boolean;
procedure VerifyMapTime(nX, nY: Integer; BaseObject: TObject);
function CanSafeWalk(nX, nY: Integer): Boolean;
function ArroundDoorOpened(nX, nY: Integer): Boolean;
function GetMovingObject(nX, nY: Integer; boFlag: Boolean): Pointer;
function GetQuestNPC(BaseObject: TObject; sCharName, sStr: string; boFlag: Boolean): TObject;
function GetItemEx(nX, nY: Integer; var nCount: Integer): Pointer;
function GetDoor(nX, nY: Integer): pTDoorInfo;
function IsValidObject(nX, nY: Integer; nRage: Integer; BaseObject: TObject): Boolean;
function GetRangeBaseObject(nX, nY: Integer; nRage: Integer; boFlag: Boolean; BaseObjectList: TList): Integer;
function GeTBaseObjects(nX, nY: Integer; boFlag: Boolean; BaseObjectList: TList): Integer;
function GetEvent(nX, nY: Integer): TObject;
procedure SetMapXYFlag(nX, nY: Integer; boFlag: Boolean);
function GetXYHuman(nMapX, nMapY: Integer): Boolean;
function GetEnvirInfo(): string;
function AllowStdItems(sItemName: string): Boolean; overload;
function AllowStdItems(nItemIdx: Integer): Boolean; overload;
procedure AddObject(nType: Integer);
procedure DelObjectCount(BaseObject: TObject);
property MonCount: Integer read m_nMonCount;
property HumCount: Integer read m_nHumCount;

end;
TMapManager = class(TGList) //004B52B0
private
public
constructor Create();
destructor Destroy; override;
procedure LoadMapDoor();
function AddMapInfo(sMapName, sMainMapName, sMapDesc: string; nServerNumber: Integer; MapFlag: pTMapFlag; QuestNPC: TObject): TEnvirnoment;
function GetMapInfo(nServerIdx: Integer; sMapName: string): TEnvirnoment;
function AddMapRoute(sSMapNO: string; nSMapX, nSMapY: Integer; sDMapNO: string; nDMapX, nDMapY: Integer): Boolean;
function GetMapOfServerIndex(sMapName: string): Integer;
function FindMap(sMapName: string): TEnvirnoment;
function GetMainMap(Envir: TEnvirnoment): string;
procedure ReSetMinMap();
procedure Run();
procedure ProcessMapDoor();
procedure MakeSafePkZone();
end;
implementation

uses ObjBase, ObjNpc, M2Share, Event, ObjMon, HUtil32, Castle;

{ TEnvirList }

//004B7038
procedure TMapManager.MakeSafePkZone();
var
nX, nY: Integer;
SafeEvent: TSafeEvent;
nMinX, nMaxX, nMinY, nMaxY: Integer;
nRange, nType, nTime, nPoint: Integer;
I: Integer;
StartPoint: pTStartPoint;
Envir: TEnvirnoment;
begin
g_StartPointList.Lock;
for I := 0 to g_StartPointList.Count - 1 do begin
StartPoint := pTStartPoint(g_StartPointList.Objects[I]);
if (StartPoint <> nil) and (StartPoint.m_nType > 0) then begin
Envir := FindMap(StartPoint.m_sMapName);
if Envir <> nil then begin
nMinX := StartPoint.m_nCurrX - StartPoint.m_nRange;
nMaxX := StartPoint.m_nCurrX + StartPoint.m_nRange;
nMinY := StartPoint.m_nCurrY - StartPoint.m_nRange;
nMaxY := StartPoint.m_nCurrY + StartPoint.m_nRange;
for nX := nMinX to nMaxX do begin
for nY := nMinY to nMaxY do begin
if ((nX < nMaxX) and (nY = nMinY)) or
((nY < nMaxY) and (nX = nMinX)) or
(nX = nMaxX) or (nY = nMaxY) then begin
SafeEvent := TSafeEvent.Create(Envir, nX, nY, StartPoint.m_nType);
g_EventManager.AddEvent(SafeEvent);
end;
end;
end;
end;
end;
end;
end;

function TMapManager.AddMapInfo(sMapName, sMainMapName, sMapDesc: string; nServerNumber: Integer; MapFlag: pTMapFlag; QuestNPC: TObject): TEnvirnoment;
var
Envir: TEnvirnoment;
I: Integer;
nStd: Integer;
TempList: TStringList;
begin
Result := nil;
Envir := TEnvirnoment.Create;
Envir.sMapName := sMapName;
Envir.sMainMapName := sMainMapName;
Envir.sSubMapName := sMapName;
Envir.sMapDesc := sMapDesc;
if sMainMapName <> '' then Envir.m_boMainMap := True;
Envir.nServerIndex := nServerNumber;
Envir.m_boSAFE := MapFlag.boSAFE;
Envir.m_boFightZone := MapFlag.boFIGHT;
Envir.m_boFight3Zone := MapFlag.boFIGHT3;
Envir.m_boDARK := MapFlag.boDARK;
Envir.m_boDAY := MapFlag.boDAY;
Envir.m_boQUIZ := MapFlag.boQUIZ;
Envir.m_boNORECONNECT := MapFlag.boNORECONNECT;
Envir.m_boNEEDHOLE := MapFlag.boNEEDHOLE;
Envir.m_boNORECALL := MapFlag.boNORECALL;
Envir.m_boNOGUILDRECALL := MapFlag.boNOGUILDRECALL;
Envir.m_boNODEARRECALL := MapFlag.boNODEARRECALL;
Envir.m_boNOMASTERRECALL := MapFlag.boNOMASTERRECALL;
Envir.m_boNORANDOMMOVE := MapFlag.boNORANDOMMOVE;
Envir.m_boNODRUG := MapFlag.boNODRUG;
Envir.m_boMINE := MapFlag.boMINE;
Envir.m_boNOPOSITIONMOVE := MapFlag.boNOPOSITIONMOVE;

Envir.m_boRUNHUMAN := MapFlag.boRUNHUMAN; //可以穿人
Envir.m_boRUNMON := MapFlag.boRUNMON; //可以穿怪
Envir.m_boDECHP := MapFlag.boDECHP; //自动减HP值
Envir.m_boINCHP := MapFlag.boINCHP; //自动加HP值
Envir.m_boDecGameGold := MapFlag.boDECGAMEGOLD; //自动减游戏币
Envir.m_boDECGAMEPOINT := MapFlag.boDECGAMEPOINT; //自动减游戏币
Envir.m_boIncGameGold := MapFlag.boINCGAMEGOLD; //自动加游戏币
Envir.m_boINCGAMEPOINT := MapFlag.boINCGAMEPOINT; //自动加游戏点
Envir.m_boMUSIC := MapFlag.boMUSIC; //音乐
Envir.m_boEXPRATE := MapFlag.boEXPRATE; //杀怪经验倍数
Envir.m_boPKWINLEVEL := MapFlag.boPKWINLEVEL; //PK得等级
Envir.m_boPKWINEXP := MapFlag.boPKWINEXP; //PK得经验
Envir.m_boPKLOSTLEVEL := MapFlag.boPKLOSTLEVEL;
Envir.m_boPKLOSTEXP := MapFlag.boPKLOSTEXP;
Envir.m_nPKWINLEVEL := MapFlag.nPKWINLEVEL; //PK得等级数
Envir.m_nPKWINEXP := MapFlag.nPKWINEXP; //PK得经验数
Envir.m_nPKLOSTLEVEL := MapFlag.nPKLOSTLEVEL;
Envir.m_nPKLOSTEXP := MapFlag.nPKLOSTEXP;
Envir.m_nPKWINEXP := MapFlag.nPKWINEXP; //PK得经验数
Envir.m_nDECHPTIME := MapFlag.nDECHPTIME; //减HP间隔时间
Envir.m_nDECHPPOINT := MapFlag.nDECHPPOINT; //一次减点数
Envir.m_nINCHPTIME := MapFlag.nINCHPTIME; //加HP间隔时间
Envir.m_nINCHPPOINT := MapFlag.nINCHPPOINT; //一次加点数
Envir.m_nDECGAMEGOLDTIME := MapFlag.nDECGAMEGOLDTIME; //减游戏币间隔时间
Envir.m_nDecGameGold := MapFlag.nDECGAMEGOLD; //一次减数量
Envir.m_nINCGAMEGOLDTIME := MapFlag.nINCGAMEGOLDTIME; //减游戏币间隔时间
Envir.m_nIncGameGold := MapFlag.nINCGAMEGOLD; //一次减数量
Envir.m_nINCGAMEPOINTTIME := MapFlag.nINCGAMEPOINTTIME; //减游戏币间隔时间
Envir.m_nINCGAMEPOINT := MapFlag.nINCGAMEPOINT; //一次减数量
Envir.m_nMUSICID := MapFlag.nMUSICID; //音乐ID
Envir.m_nEXPRATE := MapFlag.nEXPRATE; //经验倍率

Envir.sNoReconnectMap := MapFlag.sReConnectMap;
Envir.QuestNPC := QuestNPC;
Envir.nNEEDSETONFlag := MapFlag.nNEEDSETONFlag;
Envir.nNeedONOFF := MapFlag.nNeedONOFF;
if (MapFlag.boUnAllowStdItems) and (MapFlag.sUnAllowStdItemsText <> '') then begin
Envir.m_boUnAllowStdItems := True;
Envir.m_UnAllowStdItemsList := TGStringList.Create;
TempList := TStringList.Create;
ExtractStrings(['|', '\', '/'], [], PChar(Trim(MapFlag.sUnAllowStdItemsText)), TempList);
for I := 0 to TempList.Count - 1 do begin
nStd := UserEngine.GetStdItemIdx(Trim(TempList.Strings[I]));
if nStd >= 0 then
Envir.m_UnAllowStdItemsList.AddObject(Trim(TempList.Strings[I]), TObject(nStd));
end;
TempList.Free;
end;

for I := 0 to MiniMapList.Count - 1 do begin
if CompareText(MiniMapList.Strings[I], Envir.sMapName) = 0 then begin
Envir.nMinMap := Integer(MiniMapList.Objects[I]);
break;
end;
end;
if sMainMapName <> '' then begin
if Envir.LoadMapData(g_Config.sMapDir + sMainMapName + '.map') then begin
Result := Envir;
Self.Add(Envir);
end else begin
MainOutMessage('地图文件 ' + g_Config.sMapDir + sMainMapName + '.map' + ' 未找到！！！');
end;
end else begin
if Envir.LoadMapData(g_Config.sMapDir + sMapName + '.map') then begin
Result := Envir;
Self.Add(Envir);
end else begin
MainOutMessage('地图文件 ' + g_Config.sMapDir + sMapName + '.map' + ' 未找到！！！');
end;
end;
end;

function TMapManager.AddMapRoute(sSMapNO: string; nSMapX, nSMapY: Integer; sDMapNO: string; nDMapX, nDMapY: Integer): Boolean;
var
GateObj: pTGateObj;
SEnvir: TEnvirnoment;
DEnvir: TEnvirnoment;
begin
Result := False;
SEnvir := FindMap(sSMapNO);
DEnvir := FindMap(sDMapNO);
if (SEnvir <> nil) and (DEnvir <> nil) then begin
New(GateObj);
GateObj.boFlag := False;
GateObj.DEnvir := DEnvir;
GateObj.nDMapX := nDMapX;
GateObj.nDMapY := nDMapY;
SEnvir.AddToMap(nSMapX, nSMapY, OS_GATEOBJECT, TObject(GateObj));
Result := True;
end;
end;

function TEnvirnoment.AddToMap(nX, nY: Integer; btType: Byte;
pRemoveObject: TObject): Pointer;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
MapItem: PTMapItem;
I: Integer;
nGoldCount: Integer;
bo1E: Boolean;
btRaceServer: Byte;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::AddToMap';
begin
Result := nil;
try
bo1E := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
if MapCellInfo.ObjList = nil then begin
MapCellInfo.ObjList := TList.Create;
end else begin
if MapCellInfo.ObjList <> nil then begin
if btType = OS_ITEMOBJECT then begin
if PTMapItem(pRemoveObject).Name = sSTRING_GOLDNAME then begin

for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_ITEMOBJECT) then begin
MapItem := PTMapItem(pTOSObject(MapCellInfo.ObjList.Items[I]).CellObj);
if (MapItem <> nil) and (MapItem.Name = sSTRING_GOLDNAME) then begin
nGoldCount := MapItem.Count + PTMapItem(pRemoveObject).Count;
if nGoldCount <= 2000 then begin
MapItem.Count := nGoldCount;
MapItem.Looks := GetGoldShape(nGoldCount);
MapItem.AniCount := 0;
MapItem.Reserved := 0;
OSObject.dwAddTime := GetTickCount();
Result := MapItem;
bo1E := True;
end;
end;
end;
end;
if not bo1E and (MapCellInfo.ObjList.Count >= 5) then begin
Result := nil;
bo1E := True;
end;

end;
end;
end;
if btType = OS_EVENTOBJECT then begin

end;
end;
if not bo1E then begin

New(OSObject);
OSObject.btType := btType;
OSObject.CellObj := pRemoveObject;
OSObject.dwAddTime := GetTickCount();
MapCellInfo.ObjList.Add(OSObject);
Result := Pointer(pRemoveObject);
if (btType = OS_MOVINGOBJECT) and (not TBaseObject(pRemoveObject).m_boAddToMaped) then begin
TBaseObject(pRemoveObject).m_boDelFormMaped := False;
TBaseObject(pRemoveObject).m_boAddToMaped := True;
btRaceServer := TBaseObject(pRemoveObject).m_btRaceServer;
if btRaceServer = RC_PLAYOBJECT then Inc(m_nHumCount);
if btRaceServer >= RC_ANIMAL then Inc(m_nMonCount);
end;

end;
end;
except
MainOutMessage(sExceptionMsg);
end;
end;

function TEnvirnoment.AllowStdItems(sItemName: string): Boolean; //是否允许使用物品
var
I: Integer;
begin
Result := True;
if (not m_boUnAllowStdItems) or (m_UnAllowStdItemsList = nil) then Exit;
m_UnAllowStdItemsList.Lock;
try
for I := 0 to m_UnAllowStdItemsList.Count - 1 do begin
if CompareText(m_UnAllowStdItemsList.Strings[I], sItemName) = 0 then begin
Result := False;
break;
end;
end;
finally
m_UnAllowStdItemsList.Unlock;
end;
end;

function TEnvirnoment.AllowStdItems(nItemIdx: Integer): Boolean; //是否允许使用物品
var
I: Integer;
begin
Result := True;
if (not m_boUnAllowStdItems) or (m_UnAllowStdItemsList = nil) then Exit;
m_UnAllowStdItemsList.Lock;
try
for I := 0 to m_UnAllowStdItemsList.Count - 1 do begin
if Integer(m_UnAllowStdItemsList.Objects[I]) = nItemIdx then begin
Result := False;
break;
end;
end;
finally
m_UnAllowStdItemsList.Unlock;
end;
end;

procedure TEnvirnoment.AddDoorToMap();
var
I: Integer;
Door: pTDoorInfo;
begin
for I := 0 to m_DoorList.Count - 1 do begin
Door := m_DoorList.Items[I];
AddToMap(Door.nX, Door.nY, OS_DOOR, TObject(Door));
end;
end;

function TEnvirnoment.GetMapCellInfo(nX, nY: Integer; var MapCellInfo: pTMapCellinfo): Boolean; //004B57D8
begin
if (nX >= 0) and (nX < m_nWidth) and (nY >= 0) and (nY < m_nHeight) then begin
MapCellInfo := @MapCellArray[nX * m_nHeight + nY];
Result := True;
end else begin
Result := False;
end;
end;

function TEnvirnoment.MoveToMovingObject(nCX, nCY: Integer; Cert: TObject; nX, nY: Integer; boFlag: Boolean): Integer; //004B612C
var
MapCellInfo: pTMapCellinfo;
BaseObject: TBaseObject;
OSObject: pTOSObject;
I: Integer;
bo1A: Boolean;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::MoveToMovingObject';
label
Loop, Over;
begin
Result := 0;
try
bo1A := True;
if not boFlag and GetMapCellInfo(nX, nY, MapCellInfo) then begin
if MapCellInfo.chFlag = 0 then begin
if MapCellInfo.ObjList <> nil then begin

for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
if pTOSObject(MapCellInfo.ObjList.Items[I]).btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(pTOSObject(MapCellInfo.ObjList.Items[I]).CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
bo1A := False;
break;
end;
end;
end;
end;

end;
end else begin //004B622D if MapCellInfo.chFlag = 0 then begin
Result := -1;
bo1A := False;
end;
end;

if bo1A then begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag <> 0) then begin
Result := -1;
end else begin
if GetMapCellInfo(nCX, nCY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
I := 0;

while (True) do begin

if MapCellInfo.ObjList.Count <= I then break;
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
if TBaseObject(OSObject.CellObj) = TBaseObject(Cert) then begin
MapCellInfo.ObjList.Delete(I);
// DisPose(OSObject);
if MapCellInfo.ObjList.Count > 0 then Continue;
{ MapCellInfo.ObjList.Free;
MapCellInfo.ObjList := nil; }
break;
end;
end;
Inc(I);
end;

end;
if GetMapCellInfo(nX, nY, MapCellInfo) then begin
if (MapCellInfo.ObjList = nil) then begin
MapCellInfo.ObjList := TList.Create;
end;

New(OSObject);
OSObject.btType := OS_MOVINGOBJECT;
OSObject.CellObj := Cert;
OSObject.dwAddTime := GetTickCount;
MapCellInfo.ObjList.Add(OSObject);
Result := 1;

end;
end;
end;
except
on E: Exception do begin
MainOutMessage(sExceptionMsg);
MainOutMessage(E.Message);
end;
end;
end;
//======================================================================
//检查地图指定座标是否可以移动
//boFlag 如果为TRUE 则忽略座标上是否有角色
//返回值 True 为可以移动，False 为不可以移动
//======================================================================
function TEnvirnoment.CanWalk(nX, nY: Integer; boFlag: Boolean): Boolean; //004B5ED0
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
I: Integer;
begin
Result := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
Result := True;
if not boFlag and (MapCellInfo.ObjList <> nil) then begin

for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
Result := False;
break;
end;
end;
end;
end;

end;
end;
end;

//======================================================================
//检查地图指定座标是否可以移动
//boFlag 如果为TRUE 则忽略座标上是否有角色
//返回值 True 为可以移动，False 为不可以移动
//======================================================================
function TEnvirnoment.CanWalkOfItem(nX, nY: Integer; boFlag, boItem: Boolean): Boolean; //004B5ED0
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
I: Integer;
begin
Result := True;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
if (MapCellInfo.ObjList <> nil) then begin

for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (not boFlag) and (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
Result := False;
break;
end;
end;
end;
if not boItem and (OSObject.btType = OS_ITEMOBJECT) then begin
Result := False;
break;
end;
end;

end;
end;
end;

function TEnvirnoment.CanWalkEx(nX, nY: Integer; boFlag: Boolean): Boolean;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
I: Integer;
Castle: TUserCastle;
begin
Result := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
Result := True;
if not boFlag and (MapCellInfo.ObjList <> nil) then begin

for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if OSObject <> nil then begin
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
{//01/25 多城堡控制
if g_Config.boWarDisHumRun and UserCastle.m_boUnderWar and
UserCastle.InCastleWarArea(BaseObject.m_PEnvir,BaseObject.m_nCurrX,BaseObject.m_nCurrY) then begin
}
Castle := g_CastleManager.InCastleWarArea(BaseObject);
if g_Config.boWarDisHumRun and (Castle <> nil) and (Castle.m_boUnderWar) then begin
end else begin
if BaseObject.m_btRaceServer = RC_PLAYOBJECT then begin
if g_Config.boRUNHUMAN or m_boRUNHUMAN then Continue;
end else begin
if BaseObject.m_btRaceServer = RC_NPC then begin
if g_Config.boRunNpc then Continue;
end else begin
if BaseObject.m_btRaceServer in [RC_GUARD, RC_ARCHERGUARD] then begin
if g_Config.boRunGuard then Continue;
end else begin
if BaseObject.m_btRaceServer <> 55 then begin //不允许穿过练功师
if g_Config.boRUNMON or m_boRUNMON then Continue;
end;
end;
end;
end;
end;
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
Result := False;
break;
end;
end;
end;
end;
end;

end;
end;
end;

constructor TMapManager.Create;
begin

inherited Create;
end;

destructor TMapManager.Destroy;
var
I: Integer;
begin
for I := 0 to Count - 1 do begin
TEnvirnoment(Items[I]).Free;
end;

inherited;
end;
//Envir:TEnvirnoment
function TMapManager.GetMainMap(Envir: TEnvirnoment): string;
begin
if Envir.m_boMainMap then Result := Envir.sMainMapName
else Result := Envir.sMapName;
end;

function TMapManager.FindMap(sMapName: string): TEnvirnoment; //4B7350
var
Map: TEnvirnoment;
I: Integer;
begin
Result := nil;
Lock;
try
for I := 0 to Count - 1 do begin
Map := TEnvirnoment(Items[I]);
if CompareText(Map.sMapName, sMapName) = 0 then begin
Result := Map;
break;
end;
end;
finally
Unlock;
end;
end;

function TMapManager.GetMapInfo(nServerIdx: Integer; sMapName: string): TEnvirnoment;
var
I: Integer;
Envir: TEnvirnoment;
begin
Result := nil;
Lock;
try
for I := 0 to Count - 1 do begin
Envir := Items[I];
if (Envir.nServerIndex = nServerIdx) and (CompareText(Envir.sMapName, sMapName) = 0) then begin
Result := Envir;
break;
end;
end;
finally
Unlock;
end;
end;

function TEnvirnoment.DeleteFromMap(nX, nY: Integer; btType: Byte;
pRemoveObject: TObject): Integer; //004B6710
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
n18: Integer;
btRaceServer: Byte;
resourcestring
sExceptionMsg1 = '[Exception] TEnvirnoment::DeleteFromMap -> Except 1 ** %d';
sExceptionMsg2 = '[Exception] TEnvirnoment::DeleteFromMap -> Except 2 ** %d';
begin
Result := -1;
if GetMapCellInfo(nX, nY, MapCellInfo) then begin
if MapCellInfo <> nil then begin
if MapCellInfo.ObjList <> nil then begin
n18 := 0;
while (True) do begin

if MapCellInfo.ObjList.Count <= n18 then break;
OSObject := MapCellInfo.ObjList.Items[n18];
if OSObject <> nil then begin
if (OSObject.btType = btType) and (OSObject.CellObj = pRemoveObject) then begin
MapCellInfo.ObjList.Delete(n18);
DisPose(OSObject);
Result := 1;
//减地图人物怪物计数
if (btType = OS_MOVINGOBJECT) and (not TBaseObject(pRemoveObject).m_boDelFormMaped) then begin
TBaseObject(pRemoveObject).m_boDelFormMaped := True;
TBaseObject(pRemoveObject).m_boAddToMaped := False;
btRaceServer := TBaseObject(pRemoveObject).m_btRaceServer;
if btRaceServer = RC_PLAYOBJECT then Inc(m_nHumCount);
if btRaceServer >= RC_ANIMAL then Inc(m_nMonCount);
end;

if MapCellInfo.ObjList.Count > 0 then Continue;

MapCellInfo.ObjList.Free;
MapCellInfo.ObjList := nil;
break;
{//Jacky 处理防止内存泄露有待换上
if MapCellInfo.ObjList.Count <= 0 then begin
MapCellInfo.ObjList.Free;
MapCellInfo.ObjList:=nil;
end;
break;
}
end
end else begin
MapCellInfo.ObjList.Delete(n18);
if MapCellInfo.ObjList.Count > 0 then Continue;

MapCellInfo.ObjList.Free;
MapCellInfo.ObjList := nil;
break;
end;
Inc(n18);
end;
end else begin
Result := -2;
end;
end else Result := -3;
end else Result := 0;
end;

function TEnvirnoment.GetItem(nX, nY: Integer): PTMapItem;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := nil;
bo2C := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
bo2C := True;
if MapCellInfo.ObjList <> nil then begin

for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if OSObject <> nil then begin
if OSObject.btType = OS_ITEMOBJECT then begin
Result := PTMapItem(OSObject.CellObj);
Exit;
end;
if OSObject.btType = OS_GATEOBJECT then
bo2C := False;
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if not BaseObject.m_boDeath then
bo2C := False;
end;
end;
end;

end;
end;
end;

function TMapManager.GetMapOfServerIndex(sMapName: string): Integer;
var
I: Integer;
Envir: TEnvirnoment;
begin
Result := 0;
Lock;
try
for I := 0 to Count - 1 do begin
Envir := Items[I];
if (CompareText(Envir.sMapName, sMapName) = 0) then begin
Result := Envir.nServerIndex;
break;
end;
end;
finally
Unlock;
end;
end;

procedure TMapManager.LoadMapDoor;
var
I: Integer;
begin
for I := 0 to Count - 1 do begin
TEnvirnoment(Items[I]).AddDoorToMap;
end;
end;
procedure TMapManager.ProcessMapDoor;
begin

end;

procedure TMapManager.ReSetMinMap;
var
I, ii: Integer;
Envirnoment: TEnvirnoment;
begin
for I := 0 to Count - 1 do begin
Envirnoment := TEnvirnoment(Items[I]);
for ii := 0 to MiniMapList.Count - 1 do begin
if CompareText(MiniMapList.Strings[ii], Envirnoment.sMapName) = 0 then begin
Envirnoment.nMinMap := Integer(MiniMapList.Objects[ii]);
break;
end;
end;
end;
end;

function TEnvirnoment.IsCheapStuff: Boolean;
begin
if m_QuestList.Count > 0 then Result := True
else Result := False;
end;

function TEnvirnoment.AddToMapMineEvent(nX, nY: Integer; nType: Integer; Event: TObject): TObject; //004B6600
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
bo19, bo1A: Boolean;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::AddToMapMineEvent ';
begin
try
Result := nil;
bo19 := GetMapCellInfo(nX, nY, MapCellInfo);
bo1A := False;
if bo19 and (MapCellInfo.chFlag <> 0) then begin
if MapCellInfo.ObjList = nil then MapCellInfo.ObjList := TList.Create;
if not bo1A then begin

New(OSObject);
OSObject.btType := nType;
OSObject.CellObj := Event;
OSObject.dwAddTime := GetTickCount();
MapCellInfo.ObjList.Add(OSObject);
Result := Event;

end;
end;
except
MainOutMessage(sExceptionMsg);
end;
end;

procedure TEnvirnoment.VerifyMapTime(nX, nY: Integer; BaseObject: TObject);
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
boVerify: Boolean;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::VerifyMapTime';
begin
try
boVerify := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo <> nil) and (MapCellInfo.ObjList <> nil) then begin

for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) and (OSObject.CellObj = BaseObject) then begin
OSObject.dwAddTime := GetTickCount();
boVerify := True;
break;
end;
end;

end;
if not boVerify then
AddToMap(nX, nY, OS_MOVINGOBJECT, BaseObject);
except
MainOutMessage(sExceptionMsg);
end;
end;

constructor TEnvirnoment.Create;
begin
Pointer(MapCellArray) := nil;
sMapName := '';
sSubMapName := '';
sMainMapName := '';
m_boMainMap := False;
nServerIndex := 0;
nMinMap := 0;
m_nWidth := 0;
m_nHeight := 0;
m_boDARK := False;
m_boDAY := False;
m_nMonCount := 0;
m_nHumCount := 0; ;
m_DoorList := TList.Create;
m_QuestList := TList.Create;
end;

destructor TEnvirnoment.Destroy;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
nX, nY: Integer;
DoorInfo: pTDoorInfo;
begin
for nX := 0 to m_nWidth - 1 do begin
for nY := 0 to m_nHeight - 1 do begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if OSObject <> nil then begin
case OSObject.btType of
OS_ITEMOBJECT: DisPose(PTMapItem(OSObject.CellObj));
OS_GATEOBJECT: DisPose(pTGateObj(OSObject.CellObj));
OS_EVENTOBJECT: TEvent(OSObject.CellObj).Free;
end;
DisPose(OSObject);
end;
end;
MapCellInfo.ObjList.Free;
end;
end;
end;

for I := 0 to m_DoorList.Count - 1 do begin
DoorInfo := m_DoorList.Items[I];
Dec(DoorInfo.Status.nRefCount);
if DoorInfo.Status.nRefCount <= 0 then
DisPose(DoorInfo.Status);

DisPose(DoorInfo);
end;
m_DoorList.Free;
for I := 0 to m_QuestList.Count - 1 do begin
DisPose(pTMapQuestInfo(m_QuestList.Items[I]));
end;
m_QuestList.Free;
FreeMem(MapCellArray);
Pointer(MapCellArray) := nil;
inherited;
end;

function TEnvirnoment.LoadMapData(sMapFile: string): Boolean;
var
fHandle: Integer;
Header: TMapHeader;
nMapSize: Integer;
n24, nW, nH: Integer;
MapBuffer: pTMap;
Point: Integer;
Door: pTDoorInfo;
I: Integer;
MapCellInfo: pTMapCellinfo;
begin
Result := False;
if FileExists(sMapFile) then begin
fHandle := FileOpen(sMapFile, fmOpenRead or fmShareExclusive);
if fHandle > 0 then begin
FileRead(fHandle, Header, SizeOf(TMapHeader));
m_nWidth := Header.wWidth;
m_nHeight := Header.wHeight;
Initialize(m_nWidth, m_nHeight);
nMapSize := m_nWidth * SizeOf(TMapUnitInfo) * m_nHeight;
//SetLength(MapBuffer, nMapSize);
MapBuffer := AllocMem(nMapSize);
FileRead(fHandle, MapBuffer^, nMapSize);

for nW := 0 to m_nWidth - 1 do begin
n24 := nW * m_nHeight;
for nH := 0 to m_nHeight - 1 do begin
if (MapBuffer[n24 + nH].wBkImg) and $8000 <> 0 then begin
MapCellInfo := @MapCellArray[n24 + nH];
MapCellInfo.chFlag := 1;
end;
if MapBuffer[n24 + nH].wFrImg and $8000 <> 0 then begin
MapCellInfo := @MapCellArray[n24 + nH];
MapCellInfo.chFlag := 2;
end;
if MapBuffer[n24 + nH].btDoorIndex and $80 <> 0 then begin
Point := (MapBuffer[n24 + nH].btDoorIndex and $7F);
if Point > 0 then begin
New(Door);
Door.nX := nW;
Door.nY := nH;
Door.n08 := Point;
Door.Status := nil;
for I := 0 to m_DoorList.Count - 1 do begin
if abs(pTDoorInfo(m_DoorList.Items[I]).nX - Door.nX) <= 10 then begin
if abs(pTDoorInfo(m_DoorList.Items[I]).nY - Door.nY) <= 10 then begin
if pTDoorInfo(m_DoorList.Items[I]).n08 = Point then begin
Door.Status := pTDoorInfo(m_DoorList.Items[I]).Status;
Inc(Door.Status.nRefCount);
break;
end;
end;
end;
end;
if Door.Status = nil then begin
New(Door.Status);
Door.Status.boOpened := False;
Door.Status.bo01 := False;
Door.Status.n04 := 0;
Door.Status.dwOpenTick := 0;
Door.Status.nRefCount := 1;
end;
m_DoorList.Add(Door);
end;
end;
end;
end;
//Dispose(MapBuffer);
//MapBuffer := nil;
FreeMem(MapBuffer);

FileClose(fHandle);
Result := True;
end;
end;
end;

procedure TEnvirnoment.Initialize(nWidth, nHeight: Integer);
var
nW, nH: Integer;
MapCellInfo: pTMapCellinfo;
begin
if (nWidth > 1) and (nHeight > 1) then begin
if MapCellArray <> nil then begin
for nW := 0 to m_nWidth - 1 do begin
for nH := 0 to m_nHeight - 1 do begin
MapCellInfo := @MapCellArray[nW * m_nHeight + nH];
if MapCellInfo.ObjList <> nil then begin
MapCellInfo.ObjList.Free;
end;
end;
end;
FreeMem(MapCellArray);
Pointer(MapCellArray) := nil;
end; //004B54AF
m_nWidth := nWidth;
m_nHeight := nHeight;
//SetLength(MapCellArray, m_nWidth * SizeOf(TMapUnitInfo) * m_nHeight);
Pointer(MapCellArray) := AllocMem((m_nWidth * m_nHeight) * SizeOf(TMapCellinfo));
end;
end;

//nFlag,boFlag,Monster,Item,Quest,boGrouped
function TEnvirnoment.CreateQuest(nFlag, nValue: Integer; s24, s28, s2C: string;
boGrouped: Boolean): Boolean; //004B6C3C
var
MapQuest: pTMapQuestInfo;
MapMerchant: TMerchant;
begin
Result := False;
if nFlag < 0 then Exit;
New(MapQuest);
MapQuest.nFlag := nFlag;
if nValue > 1 then nValue := 1;
MapQuest.nValue := nValue;
if s24 = '*' then s24 := '';
MapQuest.s08 := s24;
if s28 = '*' then s28 := '';
MapQuest.s0C := s28;
if s2C = '*' then s2C := '';

MapQuest.bo10 := boGrouped;
MapMerchant := TMerchant.Create;
MapMerchant.m_sMapName := '0';
MapMerchant.m_nCurrX := 0;
MapMerchant.m_nCurrY := 0;
MapMerchant.m_sCharName := s2C;
MapMerchant.m_nFlag := 0;
MapMerchant.m_wAppr := 0;
MapMerchant.m_sFilePath := 'MapQuest_def\';
MapMerchant.m_boIsHide := True;
MapMerchant.m_boIsQuest := False;

UserEngine.QuestNPCList.Add(MapMerchant);
MapQuest.NPC := MapMerchant;
m_QuestList.Add(MapQuest);
Result := True;
end;

function TEnvirnoment.GetXYObjCount(nX, nY: Integer): Integer;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := 0;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin

for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost and
BaseObject.bo2B9 and
not BaseObject.m_boDeath and
not BaseObject.m_boFixedHideMode and
not BaseObject.m_boObMode then begin
Inc(Result);
end;
end;
end;
end;

end;
end;

function TEnvirnoment.GetNextPosition(sX, sY, nDir, nFlag: Integer; var snx: Integer; var sny: Integer): Boolean;
begin
snx := sX;
sny := sY;
case nDir of
DR_UP: if sny > nFlag - 1 then Dec(sny, nFlag);
DR_DOWN: if sny < (m_nHeight - nFlag) then Inc(sny, nFlag);
DR_LEFT: if snx > nFlag - 1 then Dec(snx, nFlag);
DR_RIGHT: if snx < (m_nWidth - nFlag) then Inc(snx, nFlag);
DR_UPLEFT: begin
if (snx > nFlag - 1) and (sny > nFlag - 1) then begin
Dec(snx, nFlag);
Dec(sny, nFlag);
end;
end;
DR_UPRIGHT: begin //004B2B77
if (snx > nFlag - 1) and (sny < (m_nHeight - nFlag)) then begin
Inc(snx, nFlag);
Dec(sny, nFlag);
end;
end;
DR_DOWNLEFT: begin //004B2BAC
if (snx < (m_nWidth - nFlag)) and (sny > nFlag - 1) then begin
Dec(snx, nFlag);
Inc(sny, nFlag);
end;
end;
DR_DOWNRIGHT: begin
if (snx < (m_nWidth - nFlag)) and (sny < (m_nHeight - nFlag)) then begin
Inc(snx, nFlag);
Inc(sny, nFlag);
end;
end;
end;
if (snx = sX) and (sny = sY) then Result := False
else Result := True;
end;

function TEnvirnoment.CanSafeWalk(nX, nY: Integer): Boolean;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
begin
Result := True;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin

for I := MapCellInfo.ObjList.Count - 1 downto 0 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_EVENTOBJECT) then begin
if TEvent(OSObject.CellObj).m_nDamage > 0 then Result := False;
end;
end;

end;
end;

function TEnvirnoment.ArroundDoorOpened(nX, nY: Integer): Boolean;
var
I: Integer;
Door: pTDoorInfo;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::ArroundDoorOpened ';
begin
Result := True;
try
for I := 0 to m_DoorList.Count - 1 do begin
Door := m_DoorList.Items[I];
if (abs(Door.nX - nX) <= 1) and ((abs(Door.nY - nY) <= 1)) then begin
if not Door.Status.boOpened then begin
Result := False;
break;
end;
end;
end;
except
MainOutMessage(sExceptionMsg);
end;
end;

function TEnvirnoment.GetMovingObject(nX, nY: Integer; boFlag: Boolean): Pointer;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := nil;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin

for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if ((BaseObject <> nil) and
(not BaseObject.m_boGhost) and
(BaseObject.bo2B9)) and
((not boFlag) or (not BaseObject.m_boDeath)) then begin
Result := BaseObject;
break;
end;
end;
end;

end;
end;

function TEnvirnoment.GetQuestNPC(BaseObject: TObject; sCharName, sStr: string; boFlag: Boolean): TObject; //004B6E4C
var
I: Integer;
MapQuestFlag: pTMapQuestInfo;
nFlagValue: Integer;
bo1D: Boolean;
begin
Result := nil;
for I := 0 to m_QuestList.Count - 1 do begin
MapQuestFlag := m_QuestList.Items[I];
nFlagValue := TBaseObject(BaseObject).GetQuestFalgStatus(MapQuestFlag.nFlag);
if nFlagValue = MapQuestFlag.nValue then begin
if (boFlag = MapQuestFlag.bo10) or (not boFlag) then begin
bo1D := False;
if (MapQuestFlag.s08 <> '') and (MapQuestFlag.s0C <> '') then begin
if (MapQuestFlag.s08 = sCharName) and (MapQuestFlag.s0C = sStr) then
bo1D := True;
end;
if (MapQuestFlag.s08 <> '') and (MapQuestFlag.s0C = '') then begin
if (MapQuestFlag.s08 = sCharName) and (sStr = '') then
bo1D := True;
end;
if (MapQuestFlag.s08 = '') and (MapQuestFlag.s0C <> '') then begin
if (MapQuestFlag.s0C = sStr) then
bo1D := True;
end;
if bo1D then begin
Result := MapQuestFlag.NPC;
break;
end;
end;
end;
end;
end;

function TEnvirnoment.GetItemEx(nX, nY: Integer;
var nCount: Integer): Pointer;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := nil;
nCount := 0;
bo2C := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
bo2C := True;
if MapCellInfo.ObjList <> nil then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if OSObject <> nil then begin
if OSObject.btType = OS_ITEMOBJECT then begin
Result := Pointer(OSObject.CellObj);
Inc(nCount);
end;
if OSObject.btType = OS_GATEOBJECT then begin
bo2C := False;
end;
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if not BaseObject.m_boDeath then
bo2C := False;
end;
end;
end;
end;
end;
end;

function TEnvirnoment.GetDoor(nX, nY: Integer): pTDoorInfo;
var
I: Integer;
Door: pTDoorInfo;
begin
Result := nil;
for I := 0 to m_DoorList.Count - 1 do begin
Door := m_DoorList.Items[I];
if (Door.nX = nX) and (Door.nY = nY) then begin
Result := Door;
Exit;
end;
end;
end;

function TEnvirnoment.IsValidObject(nX, nY, nRage: Integer; BaseObject: TObject): Boolean;
var
nXX, nYY, I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
begin
Result := False;
for nXX := nX - nRage to nX + nRage do begin
for nYY := nY - nRage to nY + nRage do begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.CellObj = BaseObject) then begin
Result := True;
Exit;
end;
end;
end;
end;
end;
end;

function TEnvirnoment.GetRangeBaseObject(nX, nY, nRage: Integer; boFlag: Boolean;
BaseObjectList: TList): Integer;
var
nXX, nYY: Integer;
begin
for nXX := nX - nRage to nX + nRage do begin
for nYY := nY - nRage to nY + nRage do begin
GeTBaseObjects(nXX, nYY, boFlag, BaseObjectList);
end;
end;
Result := BaseObjectList.Count;
end;
//boFlag 是否包括死亡对象
//FALSE 包括死亡对象
//TRUE 不包括死亡对象
function TEnvirnoment.GeTBaseObjects(nX, nY: Integer; boFlag: Boolean;
BaseObjectList: TList): Integer;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost and BaseObject.bo2B9 then begin
if not boFlag or not BaseObject.m_boDeath then
BaseObjectList.Add(BaseObject);
end;
end;
end;
end;
end;
Result := BaseObjectList.Count;
end;

function TEnvirnoment.GetEvent(nX, nY: Integer): TObject;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
begin
Result := nil;
bo2C := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_EVENTOBJECT) then begin
Result := OSObject.CellObj;
end;
end;
end;
end;

procedure TEnvirnoment.SetMapXYFlag(nX, nY: Integer; boFlag: Boolean);
var
MapCellInfo: pTMapCellinfo;
begin
if GetMapCellInfo(nX, nY, MapCellInfo) then begin
if boFlag then MapCellInfo.chFlag := 0
else MapCellInfo.chFlag := 2;
end;
end;

function TEnvirnoment.CanFly(nSX, nSY, nDX, nDY: Integer): Boolean;
var
r28, r30: real;
n14, n18, n1C: Integer;
begin
Result := True;
r28 := (nDX - nSX) / 1.0E1;
r30 := (nDY - nDX) / 1.0E1;
n14 := 0;
while (True) do begin
n18 := ROUND(nSX + r28);
n1C := ROUND(nSY + r30);
if not CanWalk(n18, n1C, True) then begin
Result := False;
break;
end;
Inc(n14);
if n14 >= 10 then break;
end;
end;

function TEnvirnoment.GetXYHuman(nMapX, nMapY: Integer): Boolean;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := False;
if GetMapCellInfo(nMapX, nMapY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject.m_btRaceServer = RC_PLAYOBJECT then begin
Result := True;
break;
end;
end;
end;
end;
end;

function TEnvirnoment.sub_4B5FC8(nX, nY: Integer): Boolean;
var
MapCellInfo: pTMapCellinfo;
begin
Result := True;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 2) then
Result := False;
end;

function TEnvirnoment.GetEnvirInfo: string;
var
sMsg: string;
begin
sMsg := '地图名:%s(%s) DAY:%s DARK:%s SAFE:%s FIGHT:%s FIGHT3:%s QUIZ:%s NORECONNECT:%s(%s) MUSIC:%s(%d) EXPRATE:%s(%f) PKWINLEVEL:%s(%d) PKLOSTLEVEL:%s(%d) PKWINEXP:%s(%d) PKLOSTEXP:%s(%d) DECHP:%s(%d/%d) INCHP:%s(%d/%d)';
sMsg := sMsg + ' DECGAMEGOLD:%s(%d/%d) INCGAMEGOLD:%s(%d/%d) INCGAMEPOINT:%s(%d/%d) RUNHUMAN:%s RUNMON:%s NEEDHOLE:%s NORECALL:%s NOGUILDRECALL:%s NODEARRECALL:%s NOMASTERRECALL:%s NODRUG:%s MINE:%s NOPOSITIONMOVE:%s';
Result := format(sMsg, [sMapName,
sMapDesc,
BoolToCStr(m_boDAY),
BoolToCStr(m_boDARK),
BoolToCStr(m_boSAFE),
BoolToCStr(m_boFightZone),
BoolToCStr(m_boFight3Zone),
BoolToCStr(m_boQUIZ),
BoolToCStr(m_boNORECONNECT), sNoReconnectMap,
BoolToCStr(m_boMUSIC), m_nMUSICID,
BoolToCStr(m_boEXPRATE), m_nEXPRATE / 100,
BoolToCStr(m_boPKWINLEVEL), m_nPKWINLEVEL,
BoolToCStr(m_boPKLOSTLEVEL), m_nPKLOSTLEVEL,
BoolToCStr(m_boPKWINEXP), m_nPKWINEXP,
BoolToCStr(m_boPKLOSTEXP), m_nPKLOSTEXP,
BoolToCStr(m_boDECHP), m_nDECHPTIME, m_nDECHPPOINT,
BoolToCStr(m_boINCHP), m_nINCHPTIME, m_nINCHPPOINT,
BoolToCStr(m_boDecGameGold), m_nDECGAMEGOLDTIME, m_nDecGameGold,
BoolToCStr(m_boIncGameGold), m_nINCGAMEGOLDTIME, m_nIncGameGold,
BoolToCStr(m_boINCGAMEPOINT), m_nINCGAMEPOINTTIME, m_nINCGAMEPOINT,
BoolToCStr(m_boRUNHUMAN),
BoolToCStr(m_boRUNMON),
BoolToCStr(m_boNEEDHOLE),
BoolToCStr(m_boNORECALL),
BoolToCStr(m_boNOGUILDRECALL),
BoolToCStr(m_boNODEARRECALL),
BoolToCStr(m_boNOMASTERRECALL),
BoolToCStr(m_boNODRUG),
BoolToCStr(m_boMINE),
BoolToCStr(m_boNOPOSITIONMOVE)
]);
end;

procedure TEnvirnoment.AddObject(nType: Integer);
begin
case nType of
0: Inc(m_nHumCount);
1: Inc(m_nMonCount);
end;
end;

procedure TEnvirnoment.DelObjectCount(BaseObject: TObject);
var
btRaceServer: Byte;
begin
btRaceServer := TBaseObject(BaseObject).m_btRaceServer;
if btRaceServer = RC_PLAYOBJECT then Dec(m_nHumCount);
if btRaceServer >= RC_ANIMAL then Dec(m_nMonCount);
end;

procedure TMapManager.Run;
begin

end;

end.

**hujiacheng** · 10-12-07

unit Envir;

interface

uses
Windows, SysUtils, Classes, Grobal2;
type
TMapHeader = packed record
wWidth: Word;
wHeight: Word;
sTitle: string[16];
UpdateDate: TDateTime;
Reserved: array[0..22] of Char;
end;
TMapUnitInfo = packed record
wBkImg: Word; //32768 $8000 为禁止移动区域
wMidImg: Word;
wFrImg: Word;
btDoorIndex: Byte; //$80 (巩娄), 巩狼侥喊牢郸胶
btDoorOffset: Byte; //摧腮巩狼弊覆狼惑措困摹, $80 (凯覆/摧塞(扁夯))
btAniFrame: Byte; //$80(Draw Alpha) + 橇贰烙荐
btAniTick: Byte;
btArea: Byte; //瘤开沥焊
btLight: Byte; //0..1..4 堡盔瓤苞
end;
pTMapUnitInfo = ^TMapUnitInfo;
TMap = array[0..1000 * 1000 - 1] of TMapUnitInfo;
pTMap = ^TMap;
TMapCellinfo = record
chFlag: Byte;
bt1: Byte;
bt2: Byte;
bt3: Byte;
ObjList: TList;
end;
pTMapCellinfo = ^TMapCellinfo;
PTEnvirnoment = ^TEnvirnoment;
TEnvirnoment = class
sMapName: string; //0x4
sMapDesc: string;
sMainMapName: string; //0x4
sSubMapName: string; //0x4
m_boMainMap: Boolean; //0x25
MapCellArray: array of TMapCellinfo; //0x0C
nMinMap: Integer; //0x10
nServerIndex: Integer; //0x14
nRequestLevel: Integer; //0x18 进入本地图所需等级
m_nWidth: Integer; //0x1C
m_nHeight: Integer; //0x20
m_boDARK: Boolean; //0x24
m_boDAY: Boolean; //0x25
m_boDarkness: Boolean;
m_boDayLight: Boolean;
m_DoorList: TList; //0x28
bo2C: Boolean;
m_boSAFE: Boolean; //0x2D
m_boFightZone: Boolean; //0x2E
m_boFight3Zone: Boolean; //0x2F //行会战争地图
m_boQUIZ: Boolean; //0x30
m_boNORECONNECT: Boolean; //0x31
m_boNEEDHOLE: Boolean; //0x32
m_boNORECALL: Boolean; //0x33
m_boNOGUILDRECALL: Boolean;
m_boNODEARRECALL: Boolean;
m_boNOMASTERRECALL: Boolean;
m_boNORANDOMMOVE: Boolean; //0x34
m_boNODRUG: Boolean; //0x35
m_boMINE: Boolean; //0x36
m_boNOPOSITIONMOVE: Boolean; //0x37
sNoReconnectMap: string; //0x38
QuestNPC: TObject; //0x3C
nNEEDSETONFlag: Integer; //0x40
nNeedONOFF: Integer; //0x44
m_QuestList: TList; //0x48
m_boRUNHUMAN: Boolean; //可以穿人
m_boRUNMON: Boolean; //可以穿怪
m_boINCHP: Boolean; //自动加HP值
m_boIncGameGold: Boolean; //自动减游戏币
m_boINCGAMEPOINT: Boolean; //自动加点
m_boDECHP: Boolean; //自动减HP值
m_boDecGameGold: Boolean; //自动减游戏币
m_boDECGAMEPOINT: Boolean; //自动减点
m_boMUSIC: Boolean; //音乐
m_boEXPRATE: Boolean; //杀怪经验倍数
m_boPKWINLEVEL: Boolean; //PK得等级
m_boPKWINEXP: Boolean; //PK得经验
m_boPKLOSTLEVEL: Boolean; //PK丢等级
m_boPKLOSTEXP: Boolean; //PK丢经验
m_nPKWINLEVEL: Integer; //PK得等级数
m_nPKLOSTLEVEL: Integer; //PK丢等级
m_nPKWINEXP: Integer; //PK得经验数
m_nPKLOSTEXP: Integer; //PK丢经验
m_nDECHPTIME: Integer; //减HP间隔时间
m_nDECHPPOINT: Integer; //一次减点数
m_nINCHPTIME: Integer; //加HP间隔时间
m_nINCHPPOINT: Integer; //一次加点数
m_nDECGAMEGOLDTIME: Integer; //减游戏币间隔时间
m_nDecGameGold: Integer; //一次减数量
m_nDECGAMEPOINTTIME: Integer; //减游戏点间隔时间
m_nDECGAMEPOINT: Integer; //一次减数量
m_nINCGAMEGOLDTIME: Integer; //加游戏币间隔时间
m_nIncGameGold: Integer; //一次加数量
m_nINCGAMEPOINTTIME: Integer; //加游戏币间隔时间
m_nINCGAMEPOINT: Integer; //一次加数量
m_nMUSICID: Integer; //音乐ID
m_nEXPRATE: Integer; //经验倍率
m_nMonCount: Integer;
m_nHumCount: Integer;

m_boUnAllowStdItems: Boolean; //是否不允许使用物品
m_UnAllowStdItemsList: TGStringList; //不允许使用物品列表
m_boUnAllowFireMagic: Boolean; //不允许使用火墙
private
procedure Initialize(nWidth, nHeight: Integer);
public
constructor Create();
destructor Destroy; override;
function AddToMap(nX, nY: Integer; btType: Byte; pRemoveObject: TObject): Pointer;
function CanWalk(nX, nY: Integer; boFlag: Boolean): Boolean;
function CanWalkOfItem(nX, nY: Integer; boFlag, boItem: Boolean): Boolean;
function CanWalkEx(nX, nY: Integer; boFlag: Boolean): Boolean;
function CanFly(nSX, nSY, nDX, nDY: Integer): Boolean;
function MoveToMovingObject(nCX, nCY: Integer; Cert: TObject; nX, nY: Integer; boFlag: Boolean): Integer;
function GetItem(nX, nY: Integer): PTMapItem;
function DeleteFromMap(nX, nY: Integer; btType: Byte; pRemoveObject: TObject): Integer;
function IsCheapStuff(): Boolean;
procedure AddDoorToMap;
function AddToMapMineEvent(nX, nY: Integer; nType: Integer; Event: TObject): TObject;
function LoadMapData(sMapFile: string): Boolean;
function CreateQuest(nFlag, nValue: Integer; s24, s28, s2C: string; boGrouped: Boolean): Boolean;
function GetMapCellInfo(nX, nY: Integer; var MapCellInfo: pTMapCellinfo): Boolean;
function GetXYObjCount(nX, nY: Integer): Integer;
function GetNextPosition(sX, sY, nDir, nFlag: Integer; var snx: Integer; var sny: Integer): Boolean;
function sub_4B5FC8(nX, nY: Integer): Boolean;
procedure VerifyMapTime(nX, nY: Integer; BaseObject: TObject);
function CanSafeWalk(nX, nY: Integer): Boolean;
function ArroundDoorOpened(nX, nY: Integer): Boolean;
function GetMovingObject(nX, nY: Integer; boFlag: Boolean): Pointer;
function GetQuestNPC(BaseObject: TObject; sCharName, sStr: string; boFlag: Boolean): TObject;
function GetItemEx(nX, nY: Integer; var nCount: Integer): Pointer;
function GetDoor(nX, nY: Integer): pTDoorInfo;
function IsValidObject(nX, nY: Integer; nRage: Integer; BaseObject: TObject): Boolean;
function GetRangeBaseObject(nX, nY: Integer; nRage: Integer; boFlag: Boolean; BaseObjectList: TList): Integer;
function GeTBaseObjects(nX, nY: Integer; boFlag: Boolean; BaseObjectList: TList): Integer;
function GetEvent(nX, nY: Integer): TObject;
procedure SetMapXYFlag(nX, nY: Integer; boFlag: Boolean);
function GetXYHuman(nMapX, nMapY: Integer): Boolean;
function GetEnvirInfo(): string;
function AllowStdItems(sItemName: string): Boolean; overload;
function AllowStdItems(nItemIdx: Integer): Boolean; overload;
procedure AddObject(nType: Integer);
procedure DelObjectCount(BaseObject: TObject);
property MonCount: Integer read m_nMonCount;
property HumCount: Integer read m_nHumCount;

end;
TMapManager = class(TGList) //004B52B0
private
public
constructor Create();
destructor Destroy; override;
procedure LoadMapDoor();
function AddMapInfo(sMapName, sMainMapName, sMapDesc: string; nServerNumber: Integer; MapFlag: pTMapFlag; QuestNPC: TObject): TEnvirnoment;
function GetMapInfo(nServerIdx: Integer; sMapName: string): TEnvirnoment;
function AddMapRoute(sSMapNO: string; nSMapX, nSMapY: Integer; sDMapNO: string; nDMapX, nDMapY: Integer): Boolean;
function GetMapOfServerIndex(sMapName: string): Integer;
function FindMap(sMapName: string): TEnvirnoment;
function GetMainMap(Envir: TEnvirnoment): string;
procedure ReSetMinMap();
procedure Run();
procedure ProcessMapDoor();
procedure MakeSafePkZone();
end;
implementation

uses ObjBase, ObjNpc, M2Share, Event, ObjMon, HUtil32, Castle;

{ TEnvirList }

procedure TMapManager.MakeSafePkZone();
var
nX, nY: Integer;
SafeEvent: TSafeEvent;
nMinX, nMaxX, nMinY, nMaxY: Integer;
nRange, nType, nTime, nPoint: Integer;
I: Integer;
StartPoint: pTStartPoint;
Envir: TEnvirnoment;
begin
g_StartPointList.Lock;
for I := 0 to g_StartPointList.Count - 1 do begin
StartPoint := pTStartPoint(g_StartPointList.Objects[I]);
if (StartPoint <> nil) and (StartPoint.m_nType > 0) then begin
Envir := FindMap(StartPoint.m_sMapName);
if Envir <> nil then begin
nMinX := StartPoint.m_nCurrX - StartPoint.m_nRange;
nMaxX := StartPoint.m_nCurrX + StartPoint.m_nRange;
nMinY := StartPoint.m_nCurrY - StartPoint.m_nRange;
nMaxY := StartPoint.m_nCurrY + StartPoint.m_nRange;
for nX := nMinX to nMaxX do begin
for nY := nMinY to nMaxY do begin
if ((nX < nMaxX) and (nY = nMinY)) or
((nY < nMaxY) and (nX = nMinX)) or
(nX = nMaxX) or (nY = nMaxY) then begin
SafeEvent := TSafeEvent.Create(Envir, nX, nY, StartPoint.m_nType);
g_EventManager.AddEvent(SafeEvent);
end;
end;
end;
end;
end;
end;
end;

function TMapManager.AddMapInfo(sMapName, sMainMapName, sMapDesc: string; nServerNumber: Integer; MapFlag: pTMapFlag; QuestNPC: TObject): TEnvirnoment;
var
Envir: TEnvirnoment;
I: Integer;
nStd: Integer;
TempList: TStringList;
begin
Result := nil;
Envir := TEnvirnoment.Create;
Envir.sMapName := sMapName;
Envir.sMainMapName := sMainMapName;
Envir.sSubMapName := sMapName;
Envir.sMapDesc := sMapDesc;
if sMainMapName <> '' then Envir.m_boMainMap := True;
Envir.nServerIndex := nServerNumber;
Envir.m_boSAFE := MapFlag.boSAFE;
Envir.m_boFightZone := MapFlag.boFIGHT;
Envir.m_boFight3Zone := MapFlag.boFIGHT3;
Envir.m_boDARK := MapFlag.boDARK;
Envir.m_boDAY := MapFlag.boDAY;
Envir.m_boQUIZ := MapFlag.boQUIZ;
Envir.m_boNORECONNECT := MapFlag.boNORECONNECT;
Envir.m_boNEEDHOLE := MapFlag.boNEEDHOLE;
Envir.m_boNORECALL := MapFlag.boNORECALL;
Envir.m_boNOGUILDRECALL := MapFlag.boNOGUILDRECALL;
Envir.m_boNODEARRECALL := MapFlag.boNODEARRECALL;
Envir.m_boNOMASTERRECALL := MapFlag.boNOMASTERRECALL;
Envir.m_boNORANDOMMOVE := MapFlag.boNORANDOMMOVE;
Envir.m_boNODRUG := MapFlag.boNODRUG;
Envir.m_boMINE := MapFlag.boMINE;
Envir.m_boNOPOSITIONMOVE := MapFlag.boNOPOSITIONMOVE;

Envir.m_boRUNHUMAN := MapFlag.boRUNHUMAN; //可以穿人
Envir.m_boRUNMON := MapFlag.boRUNMON; //可以穿怪
Envir.m_boDECHP := MapFlag.boDECHP; //自动减HP值
Envir.m_boINCHP := MapFlag.boINCHP; //自动加HP值
Envir.m_boDecGameGold := MapFlag.boDECGAMEGOLD; //自动减游戏币
Envir.m_boDECGAMEPOINT := MapFlag.boDECGAMEPOINT; //自动减游戏币
Envir.m_boIncGameGold := MapFlag.boINCGAMEGOLD; //自动加游戏币
Envir.m_boINCGAMEPOINT := MapFlag.boINCGAMEPOINT; //自动加游戏点
Envir.m_boMUSIC := MapFlag.boMUSIC; //音乐
Envir.m_boEXPRATE := MapFlag.boEXPRATE; //杀怪经验倍数
Envir.m_boPKWINLEVEL := MapFlag.boPKWINLEVEL; //PK得等级
Envir.m_boPKWINEXP := MapFlag.boPKWINEXP; //PK得经验
Envir.m_boPKLOSTLEVEL := MapFlag.boPKLOSTLEVEL;
Envir.m_boPKLOSTEXP := MapFlag.boPKLOSTEXP;
Envir.m_nPKWINLEVEL := MapFlag.nPKWINLEVEL; //PK得等级数
Envir.m_nPKWINEXP := MapFlag.nPKWINEXP; //PK得经验数
Envir.m_nPKLOSTLEVEL := MapFlag.nPKLOSTLEVEL;
Envir.m_nPKLOSTEXP := MapFlag.nPKLOSTEXP;
Envir.m_nPKWINEXP := MapFlag.nPKWINEXP; //PK得经验数
Envir.m_nDECHPTIME := MapFlag.nDECHPTIME; //减HP间隔时间
Envir.m_nDECHPPOINT := MapFlag.nDECHPPOINT; //一次减点数
Envir.m_nINCHPTIME := MapFlag.nINCHPTIME; //加HP间隔时间
Envir.m_nINCHPPOINT := MapFlag.nINCHPPOINT; //一次加点数
Envir.m_nDECGAMEGOLDTIME := MapFlag.nDECGAMEGOLDTIME; //减游戏币间隔时间
Envir.m_nDecGameGold := MapFlag.nDECGAMEGOLD; //一次减数量
Envir.m_nINCGAMEGOLDTIME := MapFlag.nINCGAMEGOLDTIME; //减游戏币间隔时间
Envir.m_nIncGameGold := MapFlag.nINCGAMEGOLD; //一次减数量
Envir.m_nINCGAMEPOINTTIME := MapFlag.nINCGAMEPOINTTIME; //减游戏币间隔时间
Envir.m_nINCGAMEPOINT := MapFlag.nINCGAMEPOINT; //一次减数量
Envir.m_nMUSICID := MapFlag.nMUSICID; //音乐ID
Envir.m_nEXPRATE := MapFlag.nEXPRATE; //经验倍率

Envir.sNoReconnectMap := MapFlag.sReConnectMap;
Envir.QuestNPC := QuestNPC;
Envir.nNEEDSETONFlag := MapFlag.nNEEDSETONFlag;
Envir.nNeedONOFF := MapFlag.nNeedONOFF;

Envir.m_boUnAllowFireMagic := MapFlag.boNOFIREMAGIC; //不允许使用火墙

if (MapFlag.boUnAllowStdItems) and (MapFlag.sUnAllowStdItemsText <> '') then begin
Envir.m_boUnAllowStdItems := True;
Envir.m_UnAllowStdItemsList := TGStringList.Create;
TempList := TStringList.Create;
ExtractStrings(['|', '\', '/'], [], PChar(Trim(MapFlag.sUnAllowStdItemsText)), TempList);
for I := 0 to TempList.Count - 1 do begin
nStd := UserEngine.GetStdItemIdx(Trim(TempList.Strings[I]));
if nStd >= 0 then
Envir.m_UnAllowStdItemsList.AddObject(Trim(TempList.Strings[I]), TObject(nStd));
end;
TempList.Free;
end;

for I := 0 to MiniMapList.Count - 1 do begin
if CompareText(MiniMapList.Strings[I], Envir.sMapName) = 0 then begin
Envir.nMinMap := Integer(MiniMapList.Objects[I]);
break;
end;
end;
if sMainMapName <> '' then begin
if Envir.LoadMapData(g_Config.sMapDir + sMainMapName + '.map') then begin
Result := Envir;
Self.Add(Envir);
end else begin
MainOutMessage('地图文件 ' + g_Config.sMapDir + sMainMapName + '.map' + ' 未找到！！！');
end;
end else begin
if Envir.LoadMapData(g_Config.sMapDir + sMapName + '.map') then begin
Result := Envir;
Self.Add(Envir);
end else begin
MainOutMessage('地图文件 ' + g_Config.sMapDir + sMapName + '.map' + ' 未找到！！！');
end;
end;
end;

function TMapManager.AddMapRoute(sSMapNO: string; nSMapX, nSMapY: Integer; sDMapNO: string; nDMapX, nDMapY: Integer): Boolean;
var
GateObj: pTGateObj;
SEnvir: TEnvirnoment;
DEnvir: TEnvirnoment;
begin
Result := False;
SEnvir := FindMap(sSMapNO);
DEnvir := FindMap(sDMapNO);
if (SEnvir <> nil) and (DEnvir <> nil) then begin
New(GateObj);
GateObj.boFlag := False;
GateObj.DEnvir := DEnvir;
GateObj.nDMapX := nDMapX;
GateObj.nDMapY := nDMapY;
SEnvir.AddToMap(nSMapX, nSMapY, OS_GATEOBJECT, TObject(GateObj));
Result := True;
end;
end;

function TEnvirnoment.AddToMap(nX, nY: Integer; btType: Byte;
pRemoveObject: TObject): Pointer;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
MapItem: PTMapItem;
I: Integer;
nGoldCount: Integer;
bo1E: Boolean;
btRaceServer: Byte;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::AddToMap';
begin
Result := nil;
try
bo1E := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
if MapCellInfo.ObjList = nil then begin
MapCellInfo.ObjList := TList.Create;
end else begin
if btType = OS_ITEMOBJECT then begin
if PTMapItem(pRemoveObject).Name = sSTRING_GOLDNAME then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_ITEMOBJECT) then begin
MapItem := PTMapItem(pTOSObject(MapCellInfo.ObjList.Items[I]).CellObj);
if MapItem.Name = sSTRING_GOLDNAME then begin
nGoldCount := MapItem.Count + PTMapItem(pRemoveObject).Count;
if nGoldCount <= 2000 then begin
MapItem.Count := nGoldCount;
MapItem.Looks := GetGoldShape(nGoldCount);
MapItem.AniCount := 0;
MapItem.Reserved := 0;
OSObject.dwAddTime := GetTickCount();
Result := MapItem;
bo1E := True;
end;
end;
end;
end; //004B653D
end; //004B653D
if not bo1E and (MapCellInfo.ObjList.Count >= 5) then begin
Result := nil;
bo1E := True;
end; //004B6558
end; //004B6558
if btType = OS_EVENTOBJECT then begin

end;
end; //004B655C
if not bo1E then begin
New(OSObject);
OSObject.btType := btType;
OSObject.CellObj := pRemoveObject;
OSObject.dwAddTime := GetTickCount();
MapCellInfo.ObjList.Add(OSObject);
Result := Pointer(pRemoveObject);

if (btType = OS_MOVINGOBJECT) and (not TBaseObject(pRemoveObject).m_boAddToMaped) then begin
TBaseObject(pRemoveObject).m_boDelFormMaped := False;
TBaseObject(pRemoveObject).m_boAddToMaped := True;
btRaceServer := TBaseObject(pRemoveObject).m_btRaceServer;
if btRaceServer = RC_PLAYOBJECT then Inc(m_nHumCount);
if btRaceServer >= RC_ANIMAL then Inc(m_nMonCount);
end;
end;
end;
except
MainOutMessage(sExceptionMsg);
end;
end;

function TEnvirnoment.AllowStdItems(sItemName: string): Boolean; //是否允许使用物品
var
I: Integer;
begin
Result := True;
if (not m_boUnAllowStdItems) or (m_UnAllowStdItemsList = nil) then Exit;
m_UnAllowStdItemsList.Lock;
try
for I := 0 to m_UnAllowStdItemsList.Count - 1 do begin
if CompareText(m_UnAllowStdItemsList.Strings[I], sItemName) = 0 then begin
Result := False;
break;
end;
end;
finally
m_UnAllowStdItemsList.UnLock;
end;
end;

function TEnvirnoment.AllowStdItems(nItemIdx: Integer): Boolean; //是否允许使用物品
var
I: Integer;
begin
Result := True;
if (not m_boUnAllowStdItems) or (m_UnAllowStdItemsList = nil) then Exit;
m_UnAllowStdItemsList.Lock;
try
for I := 0 to m_UnAllowStdItemsList.Count - 1 do begin
if Integer(m_UnAllowStdItemsList.Objects[I]) = nItemIdx then begin
Result := False;
break;
end;
end;
finally
m_UnAllowStdItemsList.UnLock;
end;
end;

procedure TEnvirnoment.AddDoorToMap();
var
I: Integer;
Door: pTDoorInfo;
begin
for I := 0 to m_DoorList.Count - 1 do begin
Door := m_DoorList.Items[I];
AddToMap(Door.nX, Door.nY, OS_DOOR, TObject(Door));
end;
end;

function TEnvirnoment.GetMapCellInfo(nX, nY: Integer; var MapCellInfo: pTMapCellinfo): Boolean; //004B57D8
begin
if (nX >= 0) and (nX < m_nWidth) and (nY >= 0) and (nY < m_nHeight) then begin
MapCellInfo := @MapCellArray[nX * m_nHeight + nY];
Result := True;
end else begin
Result := False;
end;
end;
function TEnvirnoment.MoveToMovingObject(nCX, nCY: Integer; Cert: TObject; nX, nY: Integer; boFlag: Boolean): Integer; //004B612C
var
MapCellInfo: pTMapCellinfo;
BaseObject: TBaseObject;
OSObject: pTOSObject;
I: Integer;
bo1A: Boolean;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::MoveToMovingObject';
label
Loop, Over;
begin
Result := 0;
try
bo1A := True;
if not boFlag and GetMapCellInfo(nX, nY, MapCellInfo) then begin
if MapCellInfo.chFlag = 0 then begin
if MapCellInfo.ObjList <> nil then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
if pTOSObject(MapCellInfo.ObjList.Items[I]).btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(pTOSObject(MapCellInfo.ObjList.Items[I]).CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
bo1A := False;
break;
end;
end;
end;
end;
end;
end else begin //004B622D if MapCellInfo.chFlag = 0 then begin
Result := -1;
bo1A := False;
end;
end;
if bo1A then begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag <> 0) then begin
Result := -1;
end else begin
if GetMapCellInfo(nCX, nCY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
I := 0;
while (True) do begin
if MapCellInfo.ObjList.Count <= I then break;
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
if TBaseObject(OSObject.CellObj) = TBaseObject(Cert) then begin
MapCellInfo.ObjList.Delete(I);
DisPoseAndNil(OSObject);
if MapCellInfo.ObjList.Count > 0 then Continue;
if MapCellInfo.ObjList.Count <= 0 then begin
FreeAndNil(MapCellInfo.ObjList);
break;
end;
end;
end;
Inc(I);
end;
end;
if GetMapCellInfo(nX, nY, MapCellInfo) then begin
if (MapCellInfo.ObjList = nil) then begin
MapCellInfo.ObjList := TList.Create;
end;
New(OSObject);
OSObject.btType := OS_MOVINGOBJECT;
OSObject.CellObj := Cert;
OSObject.dwAddTime := GetTickCount;
MapCellInfo.ObjList.Add(OSObject);
Result := 1;
end;
end;
end;
except
on E: Exception do begin
MainOutMessage(sExceptionMsg);
MainOutMessage(E.Message);
end;
end;
end;
//======================================================================
//检查地图指定座标是否可以移动
//boFlag 如果为TRUE 则忽略座标上是否有角色
//返回值 True 为可以移动，False 为不可以移动
//======================================================================
function TEnvirnoment.CanWalk(nX, nY: Integer; boFlag: Boolean): Boolean;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
I: Integer;
begin
Result := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
Result := True;
if not boFlag and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
Result := False;
break;
end;
end;
end;
end;
end;
end;
end;

//======================================================================
//检查地图指定座标是否可以移动
//boFlag 如果为TRUE 则忽略座标上是否有角色
//返回值 True 为可以移动，False 为不可以移动
//======================================================================
function TEnvirnoment.CanWalkOfItem(nX, nY: Integer; boFlag, boItem: Boolean): Boolean;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
I: Integer;
begin
Result := True;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
// Result:=True;
if (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if not boFlag and (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
Result := False;
break;
end;
end;
end;
if not boItem and (OSObject.btType = OS_ITEMOBJECT) then begin
Result := False;
break;
end;
end;
end;
end;
end;

function TEnvirnoment.CanWalkEx(nX, nY: Integer; boFlag: Boolean): Boolean;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
I: Integer;
Castle: TUserCastle;
begin
Result := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
Result := True;
if not boFlag and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if OSObject <> nil then begin
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
{//01/25 多城堡控制
if g_Config.boWarDisHumRun and UserCastle.m_boUnderWar and
UserCastle.InCastleWarArea(BaseObject.m_PEnvir,BaseObject.m_nCurrX,BaseObject.m_nCurrY) then begin
}
Castle := g_CastleManager.InCastleWarArea(BaseObject);
if g_Config.boWarDisHumRun and (Castle <> nil) and (Castle.m_boUnderWar) then begin
end else begin
if BaseObject.m_btRaceServer = RC_PLAYOBJECT then begin
if g_Config.boRUNHUMAN or m_boRUNHUMAN then Continue;
end else begin
if BaseObject.m_btRaceServer = RC_NPC then begin
if g_Config.boRunNpc then Continue;
end else begin
if BaseObject.m_btRaceServer in [RC_GUARD, RC_ARCHERGUARD] then begin
if g_Config.boRunGuard then Continue;
end else begin
if BaseObject.m_btRaceServer <> 55 then begin //不允许穿过练功师
if g_Config.boRUNMON or m_boRUNMON then Continue;
end;
end;
end;
end;
end;
if not BaseObject.m_boGhost
and BaseObject.bo2B9
and not BaseObject.m_boDeath
and not BaseObject.m_boFixedHideMode
and not BaseObject.m_boObMode then begin
Result := False;
break;
end;
end;
end;
end;
end;
end;
end;
end;

constructor TMapManager.Create;
begin

inherited Create;
end;

destructor TMapManager.Destroy;
var
I: Integer;
begin
for I := 0 to Count - 1 do begin
TEnvirnoment(Items[I]).Free;
end;

inherited;
end;
//Envir:TEnvirnoment
function TMapManager.GetMainMap(Envir: TEnvirnoment): string;
begin
if Envir.m_boMainMap then Result := Envir.sMainMapName
else Result := Envir.sMapName;
end;

function TMapManager.FindMap(sMapName: string): TEnvirnoment;
var
Map: TEnvirnoment;
I: Integer;
begin
Result := nil;
Lock;
try
for I := 0 to Count - 1 do begin
Map := TEnvirnoment(Items[I]);
if CompareText(Map.sMapName, sMapName) = 0 then begin
Result := Map;
break;
end;
end;
finally
UnLock;
end;
end;

function TMapManager.GetMapInfo(nServerIdx: Integer; sMapName: string): TEnvirnoment;
var
I: Integer;
Envir: TEnvirnoment;
begin
Result := nil;
Lock;
try
for I := 0 to Count - 1 do begin
Envir := Items[I];
if (Envir.nServerIndex = nServerIdx) and (CompareText(Envir.sMapName, sMapName) = 0) then begin
Result := Envir;
break;
end;
end;
finally
UnLock;
end;
end;

function TEnvirnoment.DeleteFromMap(nX, nY: Integer; btType: Byte;
pRemoveObject: TObject): Integer;
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
n18: Integer;
btRaceServer: Byte;
resourcestring
sExceptionMsg1 = '[Exception] TEnvirnoment::DeleteFromMap -> Except 1 ** %d';
sExceptionMsg2 = '[Exception] TEnvirnoment::DeleteFromMap -> Except 2 ** %d';
begin
Result := -1;
try
if GetMapCellInfo(nX, nY, MapCellInfo) then begin
if MapCellInfo <> nil then begin
try
if MapCellInfo.ObjList <> nil then begin
n18 := 0;
while (True) do begin
if MapCellInfo.ObjList.Count <= n18 then break;
OSObject := MapCellInfo.ObjList.Items[n18];
if OSObject <> nil then begin
if (OSObject.btType = btType) and (OSObject.CellObj = pRemoveObject) then begin
DisPoseAndNil(OSObject);
MapCellInfo.ObjList.Delete(n18);
Result := 1;
//减地图人物怪物计数
if (btType = OS_MOVINGOBJECT) and (not TBaseObject(pRemoveObject).m_boDelFormMaped) then begin
TBaseObject(pRemoveObject).m_boDelFormMaped := True;
TBaseObject(pRemoveObject).m_boAddToMaped := False;
btRaceServer := TBaseObject(pRemoveObject).m_btRaceServer;
if btRaceServer = RC_PLAYOBJECT then Dec(m_nHumCount);
if btRaceServer >= RC_ANIMAL then Dec(m_nMonCount);
end;
if MapCellInfo.ObjList.Count > 0 then Continue;
{FreeAndNil(MapCellInfo.ObjList);
break; }
//Jacky 处理防止内存泄露有待换上
if MapCellInfo.ObjList.Count <= 0 then begin
FreeAndNil(MapCellInfo.ObjList);
break;
end;
end
end else begin
MapCellInfo.ObjList.Delete(n18);
if MapCellInfo.ObjList.Count > 0 then Continue;
if MapCellInfo.ObjList.Count <= 0 then begin
FreeAndNil(MapCellInfo.ObjList);
break;
end;
end;
Inc(n18);
end;
end else begin
Result := -2;
end;
except
OSObject := nil;
MainOutMessage(format(sExceptionMsg1, [btType]));
end;
end else Result := -3;
end else Result := 0;
except
MainOutMessage(format(sExceptionMsg2, [btType]));
end;
end;

function TEnvirnoment.GetItem(nX, nY: Integer): PTMapItem;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := nil;
bo2C := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
bo2C := True;
if MapCellInfo.ObjList <> nil then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if OSObject <> nil then begin
if OSObject.btType = OS_ITEMOBJECT then begin
Result := PTMapItem(OSObject.CellObj);
Exit;
end;
if OSObject.btType = OS_GATEOBJECT then
bo2C := False;
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if not BaseObject.m_boDeath then
bo2C := False;
end;
end;
end;
end;
end;
end;

function TMapManager.GetMapOfServerIndex(sMapName: string): Integer;
var
I: Integer;
Envir: TEnvirnoment;
begin
Result := 0;
Lock;
try
for I := 0 to Count - 1 do begin
Envir := Items[I];
if (CompareText(Envir.sMapName, sMapName) = 0) then begin
Result := Envir.nServerIndex;
break;
end;
end;
finally
UnLock;
end;
end;

procedure TMapManager.LoadMapDoor;
var
I: Integer;
begin
for I := 0 to Count - 1 do begin
TEnvirnoment(Items[I]).AddDoorToMap;
end;
end;
procedure TMapManager.ProcessMapDoor;
begin

end;

procedure TMapManager.ReSetMinMap;
var
I, ii: Integer;
Envirnoment: TEnvirnoment;
begin
for I := 0 to Count - 1 do begin
Envirnoment := TEnvirnoment(Items[I]);
for ii := 0 to MiniMapList.Count - 1 do begin
if CompareText(MiniMapList.Strings[ii], Envirnoment.sMapName) = 0 then begin
Envirnoment.nMinMap := Integer(MiniMapList.Objects[ii]);
break;
end;
end;
end;
end;

function TEnvirnoment.IsCheapStuff: Boolean; //004B6E24
begin
if m_QuestList.Count > 0 then Result := True
else Result := False;
end;

function TEnvirnoment.AddToMapMineEvent(nX, nY: Integer; nType: Integer; Event: TObject): TObject; //004B6600
var
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
bo19, bo1A: Boolean;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::AddToMapMineEvent ';
begin
Result := nil;
try
bo19 := GetMapCellInfo(nX, nY, MapCellInfo);
bo1A := False;
if bo19 and (MapCellInfo.chFlag <> 0) then begin
if MapCellInfo.ObjList = nil then MapCellInfo.ObjList := TList.Create;
if not bo1A then begin
New(OSObject);
OSObject.btType := nType;
OSObject.CellObj := Event;
OSObject.dwAddTime := GetTickCount();
MapCellInfo.ObjList.Add(OSObject);
Result := Event;
end;
end;
except
MainOutMessage(sExceptionMsg);
end;
end;

procedure TEnvirnoment.VerifyMapTime(nX, nY: Integer; BaseObject: TObject);
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
boVerify: Boolean;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::VerifyMapTime';
begin
try
boVerify := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo <> nil) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) and (OSObject.CellObj = BaseObject) then begin
OSObject.dwAddTime := GetTickCount();
boVerify := True;
break;
end;
end;
end;
if not boVerify then
AddToMap(nX, nY, OS_MOVINGOBJECT, BaseObject);
except
MainOutMessage(sExceptionMsg);
end;
end;

constructor TEnvirnoment.Create; //004B5318
begin
Pointer(MapCellArray) := nil;
sMapName := '';
sSubMapName := '';
sMainMapName := '';
m_boMainMap := False;
nServerIndex := 0;
nMinMap := 0;
m_nWidth := 0;
m_nHeight := 0;
m_boDARK := False;
m_boDAY := False;
m_nMonCount := 0;
m_nHumCount := 0; ;
m_DoorList := TList.Create;
m_QuestList := TList.Create;
end;

destructor TEnvirnoment.Destroy;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
nX, nY: Integer;
DoorInfo: pTDoorInfo;
begin
for nX := 0 to m_nWidth - 1 do begin
for nY := 0 to m_nHeight - 1 do begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
case OSObject.btType of
OS_ITEMOBJECT: DisPose(PTMapItem(OSObject.CellObj));
OS_GATEOBJECT: DisPose(pTGateObj(OSObject.CellObj));
OS_EVENTOBJECT: TEvent(OSObject.CellObj).Free;
end;
DisPoseAndNil(OSObject);
end;
FreeAndNil(MapCellInfo.ObjList);
end;
end;
end;

for I := 0 to m_DoorList.Count - 1 do begin
DoorInfo := m_DoorList.Items[I];
Dec(DoorInfo.Status.nRefCount);
if DoorInfo.Status.nRefCount <= 0 then
DisPose(DoorInfo.Status);

DisPose(DoorInfo);
end;
m_DoorList.Free;
for I := 0 to m_QuestList.Count - 1 do begin
DisPose(pTMapQuestInfo(m_QuestList.Items[I]));
end;
m_QuestList.Free;
FreeMem(MapCellArray);
Pointer(MapCellArray) := nil;
inherited;
end;

function TEnvirnoment.LoadMapData(sMapFile: string): Boolean; //004B54E0
var
fHandle: Integer;
Header: TMapHeader;
nMapSize: Integer;
n24, nW, nH: Integer;
MapBuffer: pTMap;
Point: Integer;
Door: pTDoorInfo;
I: Integer;
MapCellInfo: pTMapCellinfo;
begin
Result := False;
if FileExists(sMapFile) then begin
fHandle := FileOpen(sMapFile, fmOpenRead or fmShareExclusive);
if fHandle > 0 then begin
FileRead(fHandle, Header, SizeOf(TMapHeader));
m_nWidth := Header.wWidth;
m_nHeight := Header.wHeight;
Initialize(m_nWidth, m_nHeight);
nMapSize := m_nWidth * SizeOf(TMapUnitInfo) * m_nHeight;

MapBuffer := AllocMem(nMapSize);
FileRead(fHandle, MapBuffer^, nMapSize);

for nW := 0 to m_nWidth - 1 do begin
n24 := nW * m_nHeight;
for nH := 0 to m_nHeight - 1 do begin
if (MapBuffer[n24 + nH].wBkImg) and $8000 <> 0 then begin
MapCellInfo := @MapCellArray[n24 + nH];
MapCellInfo.chFlag := 1;
end; //004B5601
if MapBuffer[n24 + nH].wFrImg and $8000 <> 0 then begin
MapCellInfo := @MapCellArray[n24 + nH];
MapCellInfo.chFlag := 2;
end; //004B562C
if MapBuffer[n24 + nH].btDoorIndex and $80 <> 0 then begin
Point := (MapBuffer[n24 + nH].btDoorIndex and $7F);
if Point > 0 then begin
New(Door);
Door.nX := nW;
Door.nY := nH;
Door.n08 := Point;
Door.Status := nil;
for I := 0 to m_DoorList.Count - 1 do begin
if abs(pTDoorInfo(m_DoorList.Items[I]).nX - Door.nX) <= 10 then begin
if abs(pTDoorInfo(m_DoorList.Items[I]).nY - Door.nY) <= 10 then begin
if pTDoorInfo(m_DoorList.Items[I]).n08 = Point then begin
Door.Status := pTDoorInfo(m_DoorList.Items[I]).Status;
Inc(Door.Status.nRefCount);
break;
end;
end;
end;
end; //004B5730
if Door.Status = nil then begin
New(Door.Status);
Door.Status.boOpened := False;
Door.Status.bo01 := False;
Door.Status.n04 := 0;
Door.Status.dwOpenTick := 0;
Door.Status.nRefCount := 1;
end;
m_DoorList.Add(Door);
end; //004B5780
end;
end; //004B578C
end; //004B5798
//Dispose(MapBuffer);

FreeMem(MapBuffer);

FileClose(fHandle);
Result := True;
end; //004B57B1
end; //004B57B1
end;

procedure TEnvirnoment.Initialize(nWidth, nHeight: Integer); //004B53FC
var
nW, nH: Integer;
MapCellInfo: pTMapCellinfo;
begin
if (nWidth > 1) and (nHeight > 1) then begin
if MapCellArray <> nil then begin
for nW := 0 to m_nWidth - 1 do begin
for nH := 0 to m_nHeight - 1 do begin
MapCellInfo := @MapCellArray[nW * m_nHeight + nH];
if MapCellInfo.ObjList <> nil then begin
FreeAndNil(MapCellInfo.ObjList);
end;
end;
end;
FreeMem(MapCellArray);
Pointer(MapCellArray) := nil;
end; //004B54AF
m_nWidth := nWidth;
m_nHeight := nHeight;
Pointer(MapCellArray) := AllocMem((m_nWidth * m_nHeight) * SizeOf(TMapCellinfo));
end; //004B54DB
end;

//nFlag,boFlag,Monster,Item,Quest,boGrouped
function TEnvirnoment.CreateQuest(nFlag, nValue: Integer; s24, s28, s2C: string;
boGrouped: Boolean): Boolean; //004B6C3C
var
MapQuest: pTMapQuestInfo;
MapMerchant: TMerchant;
begin
Result := False;
if nFlag < 0 then Exit;
New(MapQuest);
MapQuest.nFlag := nFlag;
if nValue > 1 then nValue := 1;
MapQuest.nValue := nValue;
if s24 = '*' then s24 := '';
MapQuest.s08 := s24;
if s28 = '*' then s28 := '';
MapQuest.s0C := s28;
if s2C = '*' then s2C := '';

MapQuest.bo10 := boGrouped;
MapMerchant := TMerchant.Create;
MapMerchant.m_sMapName := '0';
MapMerchant.m_nCurrX := 0;
MapMerchant.m_nCurrY := 0;
MapMerchant.m_sCharName := s2C;
MapMerchant.m_nFlag := 0;
MapMerchant.m_wAppr := 0;
MapMerchant.m_sFilePath := 'MapQuest_def\';
MapMerchant.m_boIsHide := True;
MapMerchant.m_boIsQuest := False;

UserEngine.QuestNPCList.Add(MapMerchant);
MapQuest.NPC := MapMerchant;
m_QuestList.Add(MapQuest);
Result := True;
end;

function TEnvirnoment.GetXYObjCount(nX, nY: Integer): Integer;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := 0;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost and
BaseObject.bo2B9 and
not BaseObject.m_boDeath and
not BaseObject.m_boFixedHideMode and
not BaseObject.m_boObMode then begin
Inc(Result);
end;
end;
end;
end;
end;
end;

function TEnvirnoment.GetNextPosition(sX, sY, nDir, nFlag: Integer; var snx: Integer; var sny: Integer): Boolean;
begin
snx := sX;
sny := sY;
case nDir of
DR_UP: if sny > nFlag - 1 then Dec(sny, nFlag);
DR_DOWN: if sny < (m_nHeight - nFlag) then Inc(sny, nFlag);
DR_LEFT: if snx > nFlag - 1 then Dec(snx, nFlag);
DR_RIGHT: if snx < (m_nWidth - nFlag) then Inc(snx, nFlag);
DR_UPLEFT: begin
if (snx > nFlag - 1) and (sny > nFlag - 1) then begin
Dec(snx, nFlag);
Dec(sny, nFlag);
end;
end;
DR_UPRIGHT: begin //004B2B77
if (snx > nFlag - 1) and (sny < (m_nHeight - nFlag)) then begin
Inc(snx, nFlag);
Dec(sny, nFlag);
end;
end;
DR_DOWNLEFT: begin //004B2BAC
if (snx < (m_nWidth - nFlag)) and (sny > nFlag - 1) then begin
Dec(snx, nFlag);
Inc(sny, nFlag);
end;
end;
DR_DOWNRIGHT: begin
if (snx < (m_nWidth - nFlag)) and (sny < (m_nHeight - nFlag)) then begin
Inc(snx, nFlag);
Inc(sny, nFlag);
end;
end;
end;
if (snx = sX) and (sny = sY) then Result := False
else Result := True;

end;

function TEnvirnoment.CanSafeWalk(nX, nY: Integer): Boolean;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
begin
Result := True;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := MapCellInfo.ObjList.Count - 1 downto 0 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_EVENTOBJECT) then begin
if TEvent(OSObject.CellObj).m_nDamage > 0 then Result := False;
end;
end;
end;
end;

function TEnvirnoment.ArroundDoorOpened(nX, nY: Integer): Boolean;
var
I: Integer;
Door: pTDoorInfo;
resourcestring
sExceptionMsg = '[Exception] TEnvirnoment::ArroundDoorOpened ';
begin
Result := True;
try
for I := 0 to m_DoorList.Count - 1 do begin
Door := m_DoorList.Items[I];
if (abs(Door.nX - nX) <= 1) and ((abs(Door.nY - nY) <= 1)) then begin
if not Door.Status.boOpened then begin
Result := False;
break;
end;
end;
end;
except
MainOutMessage(sExceptionMsg);
end;
end;

function TEnvirnoment.GetMovingObject(nX, nY: Integer; boFlag: Boolean): Pointer;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := nil;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if ((BaseObject <> nil) and
(not BaseObject.m_boGhost) and
(BaseObject.bo2B9)) and
((not boFlag) or (not BaseObject.m_boDeath)) then begin

Result := BaseObject;
break;
end;
end;
end;
end;
end;

function TEnvirnoment.GetQuestNPC(BaseObject: TObject; sCharName, sStr: string; boFlag: Boolean): TObject; //004B6E4C
var
I: Integer;
MapQuestFlag: pTMapQuestInfo;
nFlagValue: Integer;
bo1D: Boolean;
begin
Result := nil;
for I := 0 to m_QuestList.Count - 1 do begin
MapQuestFlag := m_QuestList.Items[I];
nFlagValue := TBaseObject(BaseObject).GetQuestFalgStatus(MapQuestFlag.nFlag);
if nFlagValue = MapQuestFlag.nValue then begin
if (boFlag = MapQuestFlag.bo10) or (not boFlag) then begin
bo1D := False;
if (MapQuestFlag.s08 <> '') and (MapQuestFlag.s0C <> '') then begin
if (MapQuestFlag.s08 = sCharName) and (MapQuestFlag.s0C = sStr) then
bo1D := True;
end;
if (MapQuestFlag.s08 <> '') and (MapQuestFlag.s0C = '') then begin
if (MapQuestFlag.s08 = sCharName) and (sStr = '') then
bo1D := True;
end;
if (MapQuestFlag.s08 = '') and (MapQuestFlag.s0C <> '') then begin
if (MapQuestFlag.s0C = sStr) then
bo1D := True;
end;
if bo1D then begin
Result := MapQuestFlag.NPC;
break;
end;
end;
end;
end;
end;

function TEnvirnoment.GetItemEx(nX, nY: Integer;
var nCount: Integer): Pointer;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := nil;
nCount := 0;
bo2C := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 0) then begin
bo2C := True;
if MapCellInfo.ObjList <> nil then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if OSObject <> nil then begin
if OSObject.btType = OS_ITEMOBJECT then begin
Result := Pointer(OSObject.CellObj);
Inc(nCount);
end;
if OSObject.btType = OS_GATEOBJECT then begin
bo2C := False;
end;
if OSObject.btType = OS_MOVINGOBJECT then begin
BaseObject := TBaseObject(OSObject.CellObj);
if not BaseObject.m_boDeath then
bo2C := False;
end;
end;
end;
end;
end;

end;

function TEnvirnoment.GetDoor(nX, nY: Integer): pTDoorInfo;
var
I: Integer;
Door: pTDoorInfo;
begin
Result := nil;
for I := 0 to m_DoorList.Count - 1 do begin
Door := m_DoorList.Items[I];
if (Door.nX = nX) and (Door.nY = nY) then begin
Result := Door;
Exit;
end;
end;
end;

function TEnvirnoment.IsValidObject(nX, nY, nRage: Integer; BaseObject: TObject): Boolean;
var
nXX, nYY, I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
begin
Result := False;
for nXX := nX - nRage to nX + nRage do begin
for nYY := nY - nRage to nY + nRage do begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.CellObj = BaseObject) then begin
Result := True;
Exit;
end;
end;
end;
end;
end;
end;

function TEnvirnoment.GetRangeBaseObject(nX, nY, nRage: Integer; boFlag: Boolean;
BaseObjectList: TList): Integer; //004B59C0
var
nXX, nYY: Integer;
begin
for nXX := nX - nRage to nX + nRage do begin
for nYY := nY - nRage to nY + nRage do begin
GeTBaseObjects(nXX, nYY, boFlag, BaseObjectList);
end;
end;
Result := BaseObjectList.Count;
end;
//boFlag 是否包括死亡对象
//FALSE 包括死亡对象
//TRUE 不包括死亡对象
function TEnvirnoment.GeTBaseObjects(nX, nY: Integer; boFlag: Boolean;
BaseObjectList: TList): Integer; //004B58F8
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject <> nil then begin
if not BaseObject.m_boGhost and BaseObject.bo2B9 then begin
if not boFlag or not BaseObject.m_boDeath then
BaseObjectList.Add(BaseObject);
end;
end;
end;
end;
end;
Result := BaseObjectList.Count;
end;

function TEnvirnoment.GetEvent(nX, nY: Integer): TObject;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
begin
Result := nil;
bo2C := False;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_EVENTOBJECT) then begin
Result := OSObject.CellObj;
end;
end;
end;
end;

procedure TEnvirnoment.SetMapXYFlag(nX, nY: Integer; boFlag: Boolean);
var
MapCellInfo: pTMapCellinfo;
begin
if GetMapCellInfo(nX, nY, MapCellInfo) then begin
if boFlag then MapCellInfo.chFlag := 0
else MapCellInfo.chFlag := 2;
end;
end;

function TEnvirnoment.CanFly(nSX, nSY, nDX, nDY: Integer): Boolean;
var
r28, r30: real;
n14, n18, n1C: Integer;
begin
Result := True;
r28 := (nDX - nSX) / 1.0E1;
r30 := (nDY - nDX) / 1.0E1;
n14 := 0;
while (True) do begin
n18 := ROUND(nSX + r28);
n1C := ROUND(nSY + r30);
if not CanWalk(n18, n1C, True) then begin
Result := False;
break;
end;
Inc(n14);
if n14 >= 10 then break;
end;
end;

function TEnvirnoment.GetXYHuman(nMapX, nMapY: Integer): Boolean;
var
I: Integer;
MapCellInfo: pTMapCellinfo;
OSObject: pTOSObject;
BaseObject: TBaseObject;
begin
Result := False;
if GetMapCellInfo(nMapX, nMapY, MapCellInfo) and (MapCellInfo.ObjList <> nil) then begin
for I := 0 to MapCellInfo.ObjList.Count - 1 do begin
OSObject := MapCellInfo.ObjList.Items[I];
if (OSObject <> nil) and (OSObject.btType = OS_MOVINGOBJECT) then begin
BaseObject := TBaseObject(OSObject.CellObj);
if BaseObject.m_btRaceServer = RC_PLAYOBJECT then begin
Result := True;
break;
end;
end;
end;
end;
end;

function TEnvirnoment.sub_4B5FC8(nX, nY: Integer): Boolean;
var
MapCellInfo: pTMapCellinfo;
begin
Result := True;
if GetMapCellInfo(nX, nY, MapCellInfo) and (MapCellInfo.chFlag = 2) then
Result := False;
end;

function TEnvirnoment.GetEnvirInfo: string;
var
sMsg: string;
begin
sMsg := '地图名:%s(%s) DAY:%s DARK:%s SAFE:%s FIGHT:%s FIGHT3:%s QUIZ:%s NORECONNECT:%s(%s) MUSIC:%s(%d) EXPRATE:%s(%f) PKWINLEVEL:%s(%d) PKLOSTLEVEL:%s(%d) PKWINEXP:%s(%d) PKLOSTEXP:%s(%d) DECHP:%s(%d/%d) INCHP:%s(%d/%d)';
sMsg := sMsg + ' DECGAMEGOLD:%s(%d/%d) INCGAMEGOLD:%s(%d/%d) INCGAMEPOINT:%s(%d/%d) RUNHUMAN:%s RUNMON:%s NEEDHOLE:%s NORECALL:%s NOGUILDRECALL:%s NODEARRECALL:%s NOMASTERRECALL:%s NODRUG:%s MINE:%s NOPOSITIONMOVE:%s';
Result := format(sMsg, [sMapName,
sMapDesc,
BoolToCStr(m_boDAY),
BoolToCStr(m_boDARK),
BoolToCStr(m_boSAFE),
BoolToCStr(m_boFightZone),
BoolToCStr(m_boFight3Zone),
BoolToCStr(m_boQUIZ),
BoolToCStr(m_boNORECONNECT), sNoReconnectMap,
BoolToCStr(m_boMUSIC), m_nMUSICID,
BoolToCStr(m_boEXPRATE), m_nEXPRATE / 100,
BoolToCStr(m_boPKWINLEVEL), m_nPKWINLEVEL,
BoolToCStr(m_boPKLOSTLEVEL), m_nPKLOSTLEVEL,
BoolToCStr(m_boPKWINEXP), m_nPKWINEXP,
BoolToCStr(m_boPKLOSTEXP), m_nPKLOSTEXP,
BoolToCStr(m_boDECHP), m_nDECHPTIME, m_nDECHPPOINT,
BoolToCStr(m_boINCHP), m_nINCHPTIME, m_nINCHPPOINT,
BoolToCStr(m_boDecGameGold), m_nDECGAMEGOLDTIME, m_nDecGameGold,
BoolToCStr(m_boIncGameGold), m_nINCGAMEGOLDTIME, m_nIncGameGold,
BoolToCStr(m_boINCGAMEPOINT), m_nINCGAMEPOINTTIME, m_nINCGAMEPOINT,
BoolToCStr(m_boRUNHUMAN),
BoolToCStr(m_boRUNMON),
BoolToCStr(m_boNEEDHOLE),
BoolToCStr(m_boNORECALL),
BoolToCStr(m_boNOGUILDRECALL),
BoolToCStr(m_boNODEARRECALL),
BoolToCStr(m_boNOMASTERRECALL),
BoolToCStr(m_boNODRUG),
BoolToCStr(m_boMINE),
BoolToCStr(m_boNOPOSITIONMOVE)
]);
end;

procedure TEnvirnoment.AddObject(nType: Integer);
begin
case nType of
0: Inc(m_nHumCount);
1: Inc(m_nMonCount);
end;
end;

procedure TEnvirnoment.DelObjectCount(BaseObject: TObject);
var
btRaceServer: Byte;
begin
btRaceServer := TBaseObject(BaseObject).m_btRaceServer;
if btRaceServer = RC_PLAYOBJECT then Dec(m_nHumCount);
if btRaceServer >= RC_ANIMAL then Dec(m_nMonCount);
end;

procedure TMapManager.Run;
begin

end;

end.

GameOfMir

Thread Tools

GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Re: GameOfMir

Advertisement