charcls.pas

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

//        Char List
///////////////////////////////////

constructor TCharList.Create (aAtzClass: TAtzClass);
begin
{
   for i := 0 to 32-1 do
      ColorIndex[i] := WinRGB (Color16Table[i*3] shr 3, Color16Table[i*3+1] shr 3, Color16Table[i*3+2] shr 3);
}
   FAtzClass := aAtzClass;
   CharDataList := TList.Create;
   ItemDataList := TList.Create;
   DynamicObjDataList := TList.Create;

   MagicDataList := TList.Create;
end;

destructor  TCharList.Destroy;
var i : integer;
begin
   for i := 0 to MagicDataList.Count -1 do TMovingMagicClass (MagicDataList[i]).Free;
   MagicDataList.Free;

   for i := 0 to ItemDataList.Count -1 do TItemClass (ItemDataList[i]).Free;
   ItemDataList.Free;

   for i := 0 to DynamicObjDataList.Count -1 do TDynamicObject (DynamicObjDataList[i]).Free; // Dynamicitem
   DynamicObjDataList.Free;

   for i := 0 to CharDataList.Count -1 do TCharClass (CharDataList[i]).Free;
   CharDataList.Free;

   inherited destroy;
end;

procedure   TCharList.Clear;
var
   i : integer;
begin
   for i := 0 to ItemDataList.Count -1 do TItemClass (ItemDataList[i]).Finalize;
   for i := 0 to CharDataList.Count -1 do TCharClass (CharDataList[i]).Finalize;
   for i := 0 to MagicDataList.Count -1 do TMovingMagicClass (MagicDataList[i]).Free;
   MagicDataList.Clear;
   for i := 0 to DynamicObjDataList.Count -1 do TDynamicObject (DynamicObjDataList[i]).Finalize;
end;

procedure   TCharList.AddChar (aName: Widestring; aId, adir, ax, ay: integer; afeature: TFeature);
var
   i : integer;
   CharClass : TCharClass;
begin
   for i := 0 to CharDataList.Count -1 do begin
      CharClass := CharDataList[i];
      if CharClass.Used = FALSE then begin
         CharClass.Initialize (aName, aId, adir, ax, ay, afeature);
         exit;
      end;
   end;
   CharClass := TCharClass.Create (FAtzClass);
   CharClass.Initialize (aName, aId, adir, ax, ay, afeature);
   CharDataList.Add (CharClass);
//   if opening then Charclass.ProcessMessage (SM_MOTION,
end;

function    TCharList.GetChar (aId: integer): TCharClass;
var i : integer;
begin
   Result := nil;
   for i := 0 to CharDataList.Count -1 do begin
      if TCharClass(CharDataList[i]).Used = FALSE then continue;
      if TCharClass(CharDataList[i]).Id = aId then begin
         Result := TCharClass (CharDataList[i]);
         exit;
      end;
   end;
end;

procedure   TCharList.DeleteChar (aId: integer);
var i : integer;
begin
   for i := 0 to CharDataList.Count -1 do begin
      if TCharClass(CharDataList[i]).Used = FALSE then continue;
      if TCharClass(CharDataList[i]).Id = aId then begin
         TCharClass (CharDataList[i]).Finalize;
         exit;
      end;
   end;
end;

procedure   TCharList.AddItem (aItemName: string; aRace: byte;aId, ax, ay, aItemShape, aItemColor: integer);
var
   i : integer;
   ItemClass : TItemClass;
begin
   for i := 0 to ItemDataList.Count -1 do begin
      ItemClass := ItemDataList[i];
      if ItemClass.Used = FALSE then begin
         ItemClass.Initialize (aItemName, aRace, aId, ax, ay, aitemShape, aItemColor);
         exit;
      end;
   end;
   ItemClass := TItemClass.Create (FAtzClass);
   ItemClass.Initialize (aItemName, aRace, aId, ax, ay, aItemShape, aItemColor);
   ItemDataList.Add (ItemClass);
end;

function    TCharList.GetItem (aId: integer): TItemClass;
var i : integer;
begin
   Result := nil;
   for i := 0 to ItemDataList.Count -1 do begin
      if TItemClass(ItemDataList[i]).Used = FALSE then continue;
      if TItemClass(ItemDataList[i]).Id = aId then begin
         Result := TItemClass (ItemDataList[i]);
         exit;
      end;
   end;
end;

procedure   TCharList.DeleteItem (aId: integer);
var i : integer;
begin
   for i := 0 to ItemDataList.Count -1 do begin
      if TItemClass(ItemDataList[i]).Used = FALSE then continue;
      if TItemClass(ItemDataList[i]).Id = aId then begin
         TItemClass (ItemDataList[i]).Finalize;
         exit;
      end;
   end;
end;

procedure   TCharList.AddDynamicObjItem (aItemName: string; aId, ax, ay, aItemShape: integer; aStartFrame, aEndFrame: Word; aState: byte; aDynamicGuard: TDynamicGuard);
var
   i : integer;
   DynamicObject : TDynamicObject;
begin
   for i := 0 to DynamicObjDataList.Count -1 do begin
      DynamicObject := DynamicObjDataList[i];
      if DynamicObject.Used = FALSE then begin
         DynamicObject.Initialize (aItemName, aId, ax, ay, aItemShape, aStartFrame, aEndFrame, aState, aDynamicGuard);
         exit;
      end;
   end;
   DynamicObject := TDynamicObject.Create (FAtzClass);
   DynamicObject.Initialize (aItemName, aId, ax, ay, aItemShape, aStartFrame, aEndFrame, aState, aDynamicGuard);
   DynamicObjDataList.Add (DynamicObject);
end;

procedure   TCharList.SetDynamicObjItem (aId : integer; aState: byte; aStartFrame, aEndFrame: Word);
var
   i : integer;
   DynamicObject : TDynamicObject;
begin
   for i := 0 to DynamicObjDataList.Count -1 do begin
      DynamicObject := DynamicObjDataList[i];
      if DynamicObject.Id = aID then begin
         DynamicObject.DynamicObjectState := aState;
         DynamicObject.FStartFrame := aStartFrame;
         DynamicObject.FEndFrame := aEndFrame;
         exit;
      end;
   end;
end;

function    TCharList.GeTDynamicObjItem (aId: integer): TDynamicObject;
var i : integer;
begin
   Result := nil;
   for i := 0 to DynamicObjDataList.Count -1 do begin
      if TDynamicObject(DynamicObjDataList[i]).Used = FALSE then continue;
      if TDynamicObject(DynamicObjDataList[i]).Id = aId then begin
         Result := TDynamicObject (DynamicObjDataList[i]);
         exit;
      end;
   end;
end;

procedure   TCharList.DeleteDynamicObjItem (aId: integer);
var
   i : integer;
begin
   for i:= 0 to DynamicObjDataList.Count -1 do begin
      if TDynamicObject(DynamicObjDataList[i]).Used = FALSE then continue;
      if TDynamicObject(DynamicObjDataList[i]).Id = aId then begin
         TDynamicObject(DynamicObjDataList[i]).Finalize;
         exit;
      end;
   end;
end;


function TCharList.UpDate (CurTick: integer): integer;
var
   i : integer;
begin
   Result := 0;
   for i := MagicDataList.Count -1 downto 0 do begin
      if TMovingMagicClass (MagicDataList[i]).Used = FALSE then continue;
      if TMovingMagicClass (MagicDataList[i]).MagicCurAction = MAT_DESTROY then
         TMovingMagicClass (MagicDataList[i]).Finalize;
   end;
   for i := 0 to MagicDataList.Count -1 do begin
      if TMovingMagicClass (MagicDataList[i]).Used = FALSE then continue;
      if TMovingMagicClass (MagicDataList[i]).Update (CurTick) <> 0 then Result := 1;
   end;

   for i := 0 to CharDataList.Count -1 do begin
      if TCharClass (CharDataList[i]).Used = FALSE then continue;
      if TCharClass (CharDataList[i]).Update (CurTick) <> 0 then Result := 1;
      {
      if TCharClass (CharDataList[i]).BgEffect <> nil then
         if TCharClass (CharDataList[i]).BgEffect.Update (CurTicK) <> 0 then Result := 1; // BgEffect;
      }
   end;

   for i := 0 to ItemDataList.Count -1 do begin
      if TItemClass (ItemDataList[i]).Used = FALSE then continue;
      if TItemClass (ItemDataList[i]).Update (CurTick) <> 0 then Result := 1;
   end;

   for i := 0 to DynamicObjDataList.Count -1 do begin // aniitem
      if TDynamicObject (DynamicObjDataList[i]).Used = FALSE then continue;
      if TDynamicObject (DynamicObjDataList[i]).Update (CurTick) <> 0 then Result := 1;
   end;

end;

function    TCharList.UpDataBgEffect (CurTick: integer): integer;
var
   i : integer;
begin
   Result := 0;
   for i := 0 to CharDataList.Count -1 do begin
      if TCharClass (CharDataList[i]).BgEffect <> nil then
         if TCharClass (CharDataList[i]).BgEffect.Update (CurTicK) <> 0 then Result := 1; // BgEffect;
   end;
end;

procedure   TCharList.GetVarRealPos (var aid, ax, ay: integer);
var i : integer;
begin
   if aid = 0 then exit;
   for i := 0 to CharDataList.Count -1 do begin
      if TCharClass (CharDataList[i]).Used = FALSE then continue;
      if TCharClass (CharDataList[i]).id = aid then begin
         ax := TCharClass(CharDataList[i]).RealX;
         ay := TCharClass(CharDataList[i]).RealY;
         exit;
      end;
   end;
end;

function    TCharList.isMovable (xx, yy: integer): Boolean;
var
   i, n : integer;
begin
   Result := FALSE;
   for i := 0 to CharDataList.Count -1 do begin
      if TCharClass (CharDataList[i]).Used = FALSE then continue;
      // 2000.12.05 磷菌阑版快 纳腐磐啊 瘤唱哎荐 乐档废 汲沥 by ankudo
      if CharMoveFrontdieFlag then begin // 辑滚俊辑 CharMoveFrontdieFlag甫 TRUE肺 汲沥矫 磷绢乐阑版快 瘤唱皑
         if TCharClass (CharDataList[i]).Feature.rfeaturestate <> wfs_die then
            if (TCharClass (CharDataList[i]).X = xx) and (TCharClass (CharDataList[i]).Y = yy) then exit;
      end else begin
         if (TCharClass (CharDataList[i]).X = xx) and (TCharClass (CharDataList[i]).Y = yy) then exit;
      end;
      if TCharClass (CharDataList[i]).ID = CharCenterId then
         BackScreen.CenterchangeIDPos(TCharClass (CharDataList[i]).X-xx, TCharClass(CharDataList[i]).Y-yy);
   end;
   // 2000.10.01 巩颇檬籍阑 StaticItem栏肺结 埃林窍咯 某腐磐啊 棵扼啊瘤 给窍档废 荐沥 by Lee.S.G
   for i := 0 to ItemDataList.Count - 1 do begin
      if TItemClass (ItemDataList[i]).Used = FALSE then continue;
      if TItemClass (ItemDataList[i]).Race = RACE_STATICITEM then begin // race肺 备盒 010127 ankudo
         if (TItemClass (ItemDataList[i]).X = xx) and (TItemClass (ItemDataList[i]).Y = yy) then exit;
      end;
   end;
   // DynamicObject item
   for i := 0 to DynamicObjDataList.Count - 1 do begin
      with TDynamicObject (DynamicObjDataList[i]) do begin
         if Used = FALSE then continue;
         if isDynamicObjectStaticItemID(Id) then begin
            if (X = xx) and (Y = yy) then exit;
            for n := 0 to DynamicGuard.aCount -1 do begin
               if (DynamicGuard.aGuardX[n] + X = xx) and (DynamicGuard.aGuardY[n] + Y = yy) then exit;
            end;
         end;
      end;
   end;
   Result := TRUE;
end;

procedure   TCharList.MouseMove (x, y: integer);
var i : integer;
begin
   SelectedItem := 0;
   for i := 0 to ItemDataList.Count -1 do begin
      if TItemClass (ItemDataList[i]).Used = FALSE then continue;
      if TItemClass (ItemDataList[i]).IsArea ( x, y) then
         SelectedItem := TItemClass (ItemDataList[i]).id;
   end;

   SelectedDynamicItem := 0;  // Dynamicitem
   for i := 0 to DynamicObjDataList.Count -1 do begin
      if TDynamicObject (DynamicObjDataList[i]).Used = FALSE then continue;
      if TDynamicObject (DynamicObjDataList[i]).IsArea ( x, y) then
         SelectedDynamicItem := TDynamicObject (DynamicObjDataList[i]).id;
   end;

   SelectedChar := 0;
   for i := 0 to CharDataList.Count -1 do begin
      if TCharClass (CharDataList[i]).Used = FALSE then continue;
      if TCharClass (CharDataList[i]).IsArea ( x, y) then
         SelectedChar := TCharClass (CharDataList[i]).id;
   end;
end;

procedure   TCharList.Paint (CurTick: integer);
   function GetGap (a1, a2:integer):integer;
   begin
      if a1 > a2 then Result := a1 - a2
      else Result := a2 - a1;
   end;
var
   i, j, oi, cy, n, m: integer;
   Cl : TCharClass;
   IC : TItemClass;
   AIC : TDynamicObject;
   po : PTObjectData;
   MapCell : TMapCell;
   subMapCell : TMapCell;
   chardieidx : integer;
begin
   for i := 0 to ItemDataList.Count -1 do begin
      IC := TItemClass(ItemDataList[i]);
      if IC.Used = FALSE then continue;
      if IC.Race = RACE_STATICITEM then continue;
//      if isStaticItemID(IC.Id) then continue; race肺 魄窜窃
      TItemClass (ItemDataList[i]).Paint;
   end;

   chardieidx := 0; // 磷菌阑版快 刚历 弊覆
   for i := 0 to CharDataList.Count -1 do begin
      if TCharClass (CharDataList[i]).Used = FALSE then continue;
      Cl := CharDataList[i];
      if Cl.Feature.rfeaturestate = wfs_die then begin
         CharDataList.Exchange (chardieidx, i);
         inc (chardieidx);
      end;
   end;

   for i := 0 to MagicDataList.Count -1 do begin
      if TMovingMagicClass (MagicDataList[i]).Used = FALSE then continue;
      TMovingMagicClass (MagicDataList[i]).Paint;
   end;

   for j := Map.Cy-VIEWHEIGHT-3 to Map.Cy+VIEWHEIGHT-1+14 do begin


      for i := Map.Cx-VIEWWIDTH-8 to Map.Cx+VIEWWIDTH do begin
         MapCell := Map.GetCell (i, j);
         oi := MapCell.ObjectId;
         if oi <> 0 then begin
            po := ObjectDataList[oi];
            if po <> nil then begin
               if po.Style = TOB_follow then begin
                  if CurTick > Map.GetMapCellTick(i,j) + po.AniDelay then begin
                     Map.SetMapCellTick (i,j,CurTick);
                     if po.StartID = po.ObjectId then begin