basicobj.pas

千年源代码,只缺少控件,可以做二次开发用,好不容易得来的

   if (myx = xx) and (myy = yy) then begin Result := 99; exit; end;       //85

   tempdir := GetRightDirection (tempdir);
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 99; exit; end;       //85

   tempdir := GetRightDirection (tempdir);
   xx := ax; yy := ay;
   GetNextPosition (tempdir, xx, yy);
   if (myx = xx) and (myy = yy) then begin Result := 99; exit; end;       //85
end;

function  TBasicObject.isHitedArea (adir, ax, ay: integer; afunc: byte; var apercent: integer) : Boolean;
var
   xx, yy: word;
begin
   apercent := 0;
   Result := FALSE;
   case afunc of
      MAGICFUNC_NONE   :
         begin
            xx := ax; yy := ay;
            GetNextPosition (adir, xx, yy);
            if (BasicData.x = xx) and (BasicData.y = yy) then begin
               apercent := 100;
               Result := TRUE;
            end;
         end;
      MAGICFUNC_8HIT   :
         begin
            if GetLargeLength (ax, ay, BasicData.x, BasicData.y) > 1 then exit;
            apercent := Check8Hit (adir, ax, ay, BasicData.x, BasicData.y);
            if apercent = 0 then exit;
            Result := TRUE;
         end;
      MAGICFUNC_5HIT   :
         begin
            if GetLargeLength (ax, ay, BasicData.x, BasicData.y) > 1 then exit;
            apercent := Check5Hit (adir, ax, ay, BasicData.x, BasicData.y);
            if apercent = 0 then exit;
            Result := TRUE;
         end;
   end;
end;

procedure TBasicObject.SetManagerClass (aManager : TManager);
begin
   Manager := aManager;
   ServerID := Manager.ServerID;
   Maper := TMaper(Manager.Maper);
   Phone := TFieldPhone (Manager.Phone);
end;

function  TBasicObject.GetPosX: integer;
begin
   Result := BasicData.x;
end;

function  TBasicObject.GetPosY: integer;
begin
   Result := BasicData.y;
end;

function  TBasicObject.GetFeatureState: TFeatureState;
begin
   Result := BasicData.Feature.rfeaturestate;
end;

procedure TBasicObject.Initial (aName, aViewName: String);
begin
   FillChar (BasicData, sizeof(BasicData), 0);
   BasicData.P := Self;
   StrPCopy (@BasicData.Name, aName);
   StrPCopy (@BasicData.ViewName, aViewName);

   BasicData.LifePercent := 100;
   
   FboAllowDelete := FALSE;
   FboRegisted := FALSE;
   FboHaveGuardPos := FALSE;

   FCreateX := 0; FCreateY := 0;
end;

procedure TBasicObject.StartProcess;
begin
   FboRegisted := TRUE;
   FboAllowDelete := FALSE;
   
   BasicData.dir := DR_4;
   BasicData.Feature.rfeaturestate := wfs_normal;

   FCreateX := BasicData.x;
   FCreateY := BasicData.y;
   FCreateTick := mmAnsTick;
   FAlarmTick := 0;

   ViewObjectList.Clear;
end;

procedure TBasicObject.EndProcess;
begin
   ViewObjectList.Clear;

   FboRegisted := FALSE;
end;

function TBasicObject.GetViewObjectById (aid: integer): TBasicObject;
var i : integer;
begin
   Result := nil;
   for i := 0 to ViewObjectList.Count - 1 do begin
      if TBasicObject (ViewobjectList[i]).BasicData.id = aid then begin
         Result := ViewObjectList[i];
         exit;
      end;
   end;
end;

// function    TBasicObject.GetViewObjectByName (aName: string; aRace: integer): TBasicObject;
// 2000.09.18 鞍篮 捞抚狼 按眉啊 乐阑锭 惯积登绰 滚弊荐沥阑 困秦 牢磊眠啊
// 茫栏妨绰 按眉狼 捞抚苞 辆幅肺 八祸茄促 by Lee.S.G
function    TBasicObject.GetViewObjectByName (aName: string; aRace: integer): TBasicObject;
var
   i : integer;
   BObject: TBasicObject;
begin
   Result := nil;
   for i := 0 to ViewObjectList.Count -1 do begin
      BObject := ViewObjectList[i];
      if (BObject.BasicData.Feature.rRace = aRace) and (StrPas (@BObject.BasicData.Name) = aName) then begin
         Result := BObject;
         exit;
      end;
   end;
end;

procedure   TBasicObject.BocSay (astr: string);
var SubData : TSubData;
begin
   SetWordString (SubData.SayString, StrPas (@BasicData.ViewName) + ': '+ astr);
   SendLocalMessage (NOTARGETPHONE, FM_SAY, BasicData, SubData);
end;

procedure   TBasicObject.BocChangeFeature;
var SubData : TSubData;
begin
   SendLocalMessage (NOTARGETPHONE, FM_CHANGEFEATURE, BasicData, SubData);
end;

procedure   TBasicObject.BocChangeProperty;
var SubData : TSubData;
begin
   SendLocalMessage (NOTARGETPHONE, FM_CHANGEPROPERTY, BasicData, SubData);
end;

procedure   TBasicObject.BoSysopMessage (astr: string; aSysopScope: integer);
var SubData : TSubData;
begin
   if not boShowHitedValue then exit;

   SetWordString (SubData.SayString, StrPas (@BasicData.ViewName) + ': '+ astr);
   SubData.SysopScope := aSysopScope;
   SendLocalMessage (NOTARGETPHONE, FM_SYSOPMESSAGE, BasicData, SubData);
end;

function    TBasicObject.SendLocalMessage (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;
var
   i : integer;
   Bo : TBasicObject;
begin
   Result := PROC_FALSE;

   if hfu = 0 then begin
      Result := FieldProc (hfu, Msg, SenderInfo, aSubData);
      {
      for i := 0 to ViewObjectList.Count -1 do begin
         Bo := ViewObjectList[i];
         if Bo <> Self then begin
            Bo.FieldProc (hfu, Msg, SenderInfo, aSubData)
         end;
      end;
      }
      i := 0;
      while i < ViewObjectList.Count do begin
         Bo := ViewObjectList[i];
         try
            if Bo <> Self then begin
               Bo.FieldProc (hfu, Msg, SenderInfo, aSubData)
            end;
            Inc (i);
         except
            {
            frmMain.WriteLogInfo (format ('TBasicObject.SendLocalMessage (%s) failed', [ViewObjectNameList[i]]));
            ViewObjectNameList.Delete (i);
            }
            ViewObjectList.Delete (i);
            frmMain.WriteLogInfo (format ('TBasicObject.SendLocalMessage (%s) failed', [StrPas (@BasicData.Name)]));
         end;
      end;

   end else begin
      for i := 0 to ViewObjectList.Count -1 do begin
         Bo := ViewObjectList[i];
         try
            if Bo.BasicData.id = hfu then begin
               result := Bo.FieldProc (hfu, Msg, SenderInfo, aSubData);
               exit;
            end;
         except
            {
            frmMain.WriteLogInfo (format ('TBasicObject.SendLocalMessage (%s) failed', [ViewObjectNameList[i]]));
            ViewObjectNameList.Delete (i);
            }
            ViewObjectList.Delete (i);
            frmMain.WriteLogInfo (format ('TBasicObject.SendLocalMessage (%s) failed', [StrPas (@BasicData.Name)]));
            exit;
         end;
      end;
   end;
end;

function  TBasicObject.isRange ( xx, yy: word) : Boolean;
var x1,x2,y1,y2:integer;
begin
   Result := TRUE;
   x1 := BasicData.x; y1 := BasicData.y;
   x2 := xx; y2 := yy;
   if (x2 < x1-VIEWRANGEWIDTH) then begin Result := FALSE; exit; end;
   if (x2 > x1+VIEWRANGEWIDTH) then begin Result := FALSE; exit; end;
   if (y2 < y1-VIEWRANGEHEIGHT) then begin Result := FALSE; exit; end;
   if (y2 > y1+VIEWRANGEHEIGHT) then begin Result := FALSE; exit; end;
end;

function  TBasicObject.isRangeMessage (hfu: Longint; Msg: word; var SenderInfo: TBasicData): Boolean;
begin
   Result := FALSE;
   if (hfu = BasicData.id) then begin Result := TRUE; exit; end;
   if hfu = NOTARGETPHONE then begin
      if isRange ( SenderInfo.x, SenderInfo.y) then begin Result := TRUE; exit; end;
      if (msg = FM_MOVE) and isRange (SenderInfo.nx, SenderInfo.ny) then begin Result := TRUE; exit; end;
   end;
   if Msg = FM_SHOUT then Result := TRUE;
end;

function  TBasicObject.FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;
var
   i : integer;
   BasicObject : TBasicObject;
   SubData : TSubData;
   bo1, bo2 : boolean;
begin
   Result := PROC_FALSE;

   if not FboRegisted then begin
      frmMain.WriteLogInfo ('UnRegisted BasicObject.FieldProc was called');
      exit;
   end;

   case Msg of
      FM_GIVEMEADDR : if hfu = BasicData.id then Result := Integer (Self);

      FM_CLICK : if hfu = BasicData.id then SetWordString (aSubData.SayString, StrPas (@BasicData.viewName));
      FM_SHOW :
         begin
            if SenderInfo.id = Basicdata.id then begin
               ViewObjectList.Clear;
               // ViewObjectNameList.Clear;
            end;

            if FindViewObject (SenderInfo.P) = true then begin
               frmMain.WriteLogInfo ('ViewObjectList Duplicate');
               exit;
            end;

            if SenderInfo.Feature.rrace = RACE_HUMAN then begin
               ViewObjectList.Insert (0, SenderInfo.p);
               // ViewObjectNameList.Insert (0, StrPas (@SenderInfo.Name));
            end else begin
               ViewObjectList.Add (SenderInfo.p);
               // ViewObjectNameList.Add (StrPas (@SenderInfo.Name));
            end;
         end;
      FM_HIDE :
         begin
            for i := 0 to ViewObjectList.Count - 1 do begin
               if ViewObjectList[i] = SenderInfo.P then begin
                  ViewObjectList.Delete (i);
                  // ViewObjectNameList.Delete (i);
                  break;
               end;
            end;
         end;
      FM_CREATE :
         begin
            Phone.SendMessage ( BasicData.Id, FM_SHOW, SenderInfo, aSubData);
            if SenderInfo.Id = BasicData.id then begin
               BasicData := SenderInfo;
               if (BasicData.Feature.rRace = RACE_HUMAN) and (BasicData.Feature.rfeaturestate = wfs_die) then exit;
               Maper.MapProc ( BasicData.Id, MM_SHOW, BasicData.x, BasicData.y, BasicData.x, BasicData.y, BasicData);
            end else begin
               Result := PROC_TRUE;
               Phone.SendMessage ( SenderInfo.Id, FM_SHOW, BasicData, SubData);
            end;
         end;
      FM_DESTROY :
         begin
            if SenderInfo.Id = BasicData.id then
               Maper.MapProc (BasicData.Id, MM_HIDE, BasicData.x, BasicData.y, BasicData.x, BasicData.y, BasicData);
            Phone.SendMessage ( BasicData.Id, FM_HIDE, SenderInfo, aSubData);
         end;
      FM_MOVE:
         begin
            bo1 := isRange (SenderInfo.x, SenderInfo.y);
            bo2 := isRange (SenderInfo.nx, SenderInfo.ny);
            if (bo1 = TRUE) and (bo2 = FALSE) then begin
               Phone.SendMessage (SenderInfo.Id, FM_HIDE, BasicData, SubData);
               Phone.SendMessage (BasicData.id, FM_HIDE, SenderInfo, aSubData);
               exit;
            end;
            if (bo1 = FALSE) and (bo2 = TRUE) then begin
               Phone.SendMessage (SenderInfo.Id, FM_SHOW, BasicData, SubData);
               Phone.SendMessage (BasicData.ID, FM_SHOW, SenderInfo, aSubData);
               exit;
            end;
         end;
   end;
end;

procedure TBasicObject.Update(CurTick: integer);
begin
end;


////////////////////////////////////////////////////
//
//             ===  ItemObject  ===
//
////////////////////////////////////////////////////

constructor TItemObject.Create;
begin
   inherited Create;
   boAllowPickup := true;
end;

destructor  TItemObject.Destroy;
begin
   inherited destroy;
end;

function  TItemObject.FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;
var
   SubData : TSubData;
begin
   Result := PROC_FALSE;
   if isRangeMessage ( hfu, Msg, SenderInfo) = FALSE then exit;
   Result := inherited FieldProc (hfu, Msg, Senderinfo, aSubData);
   if Result = PROC_TRUE then exit;

   case Msg of
      FM_ADDITEM:
         begin
            if aSubData.ItemData.rCount <> 1 then exit;
            if SelfItemData.rKind = ITEM_KIND_COLORDRUG then exit;
            if SelfItemData.rKind = ITEM_KIND_CHANGER then exit;
            
            if aSubData.ItemData.rKind = ITEM_KIND_COLORDRUG then begin
               if SelfItemData.rboColoring = FALSE then begin Result := PROC_FALSE; exit; end;
               if INI_WHITEDRUG <> StrPas (@aSubData.ItemData.rName) then begin
                  SelfItemData.rColor := aSubData.ItemData.rColor;
                  BasicData.Feature.rImageColorIndex := aSubData.ItemData.rColor;
                  Phone.SendMessage (NOTARGETPHONE, FM_CHANGEFEATURE, BasicData, SubData);
               end else begin
                  SelfItemdata.rColor := SelfItemdata.rColor + aSubData.ItemData.rColor;
                  BasicData.Feature.rImageColorIndex := SelfItemdata.rColor;
                  Phone.SendMessage (NOTARGETPHONE, FM_CHANGEFEATURE, BasicData, SubData);
               end;
               Result := PROC_TRUE;
               exit;
            end;
            if aSubData.ItemData.rKind = ITEM_KIND_CHANGER then begin
               if StrPas (@BasicData.Name) <> aSubData.ItemData.rNameParam [0] then exit;
               FboAllowDelete := true;

               ItemClass.GetItemData (aSubData.ItemData.rNameParam [1], SubData.ItemData);
               if SubData.ItemData.rName [0] <> 0 then begin
                  BasicData.nX := BasicData.X;
                  BasicData.nY := BasicData.Y;
                  SubData.ServerId := Manager.ServerId;
                  Phone.SendMessage (MANAGERPHONE, FM_ADDITEM, BasicData, SubData);
                  Result := PROC_TRUE;
               end;
               exit;
            end;
         end;
      FM_PICKUP :
         begin
            if FboAllowDelete then exit;
            {