isoengine.pas

一款RPG游戏的引擎可以自己制作一款RPG游戏的引擎可以自己制作

  if (ImageIndex<0) or (ImageIndex>=length(FImageColors)) then
    result := clRED
  else
    result := fImagecolors[ImageIndex];
end;

{procedure TIsoMap.SetParent(AParent: TWinControl);
begin
  inherited;
end;
}

procedure TIsoMap.LoadImageListFromStream(s: TStream; Version : string);
begin
    if (assigned(FLoadImageListFromStream)) then
    begin
        FLoadImageListFromStream(s,version);
        ResetImageColors;
    end;
end;

procedure TIsoMap.SaveImageListToStream(s: TStream; Version : string);
begin
    if (assigned(FSaveImageListToStream)) then
        FSaveImageListToStream(s,version);
end;

procedure TIsoMap.DrawImage(var IsoCell : TIsoCell; var ImageIndex : Integer; cellx,celly : TGridInt;x, y, layer,PatternIndex: Integer);
begin
    if (assigned(FDrawImage)) then
        FDrawImage(IsoCell,ImageIndex,cellx,celly,x,y,Layer,PatternIndex);
end;

procedure TIsoMap.DrawGrid( x, y, Animation : Integer);
begin
    if (assigned(FDrawGrid)) then
        FDrawGrid(x,y,Animation);
end;


function TIsoMap.GetCanDraw: Boolean;
begin
    if (assigned(FCanDraw)) then
        FCanDraw(result)
    else
        result := false;
end;

function TIsoMap.GetImageHeight(ImageIndex: integer): integer;
begin
    if (assigned(FGetImageHeight)) then
        FGetImageHeight(ImageIndex,result)
    else
        result := 0;
end;

function TIsoMap.GetImageWidth(ImageIndex: integer): integer;
begin
    if (assigned(FGetImageWidth)) then
        FGetImageWidth(ImageIndex,result)
    else
        result := 0;
end;

function TIsoMap.GetPixel(ImageIndex, x, y: integer): TColor;
begin
    if (assigned(fGetPixel)) then
        FGetPixel(ImageIndex,x,y,result)
    else
        result := clred;

end;

function TIsoMap.GetSurfaceHeight: integer;
begin
    if (Assigned(FGetSurfaceHeight)) then
        FGetSurfaceHeight(result)
    else
        result := 0;
end;

function TIsoMap.GetSurfaceWidth: integer;
begin
    if (Assigned(FGetSurfaceWidth)) then
        FGetSurfaceWidth(result)
    else
        result := 0;
end;

function TIsoMap.GetImageCount: integer;
begin
    if (assigned(FGetImageCount)) then
        FGetImageCount(result)
    else
        result := 0;
end;



// Cell at visible surface
function TIsoMap.CellAt(Point: TPoint): TCellsCoord;
procedure Test;
var
  visx, visy, loopx, loopy : integer;
begin
  Point.x := Point.x + (FXOffset + ScrollXOffset);
  Point.y := Point.y + (FYOffset + ScrollYOffset);
  result.X := -1;  // set no tile
  result.y := -1;
  if (FCellWidth =0) then Exit;
  visx := MaxInt(0, Point.x div FCellwidth - 1); // guess what tile left
  visy := MaxInt(0, Point.y div (FCellheightdiv2) - 1); // guess what tile top
  for loopy := visy - 1 to // just loop through 9 tiles
    MinInt(FMapHeight, visy + 1) do
    for loopx := visx - 1 to
      MinInt(FMapWidth, visx + 1) do
      if isoPointInQuad(
        (loopx * FCellwidth) + ((loopy mod 2) * (FCellwidthdiv2)),
        (loopy * (FCellheightdiv2)) + (FCellheightdiv2),
        (loopx * FCellwidth) + ((loopy mod 2) * (FCellwidthdiv2)) + (FCellwidthdiv2),
        (loopy * (FCellheightdiv2)) + FCellheight,
        (loopx * FCellwidth) + ((loopy mod 2) * (FCellwidthdiv2)) + FCellwidth,
        (loopy * (FCellheightdiv2)) + (FCellheight div 2),
        (loopx * FCellwidth) + ((loopy mod 2) * (FCellwidthdiv2)) + (FCellwidthdiv2),
        (loopy * (FCellheightdiv2)),
        Point.x, Point.y) then
      begin
        result.x := loopx;
        result.y := loopy;
        Exit;
      end;
end; // get co-ords relative to tile
begin
  Test;
  if (Result.x < 0) or (Result.X >= Mapwidth) or
    (Result.y < 0) or (Result.y >= MapHeight) then
  begin
    Result.x := -1; Result.y := -1;
  end;
end;

function TIsoMap.CellStyleAt(Point: TPoint): TCellStyle;
var c : TCellsCoord;
begin
  c := CellAt(Point);
  Result := IsoMap[c.X,c.Y].Style;
end;


// what Cell is at a point on the surface (as opposed to the world)
function TIsoMap.CellAtSurface(Point: TPoint): TCellsCoord;
var c : TCellsCoord;
begin
  c := CellAt(Point);
  c.x := c.x + XOffset;
  c.Y := c.y + Yoffset;
  result := c;
end;

// what style is the Cell is at a point on the surface (as opposed to the world)
function TIsoMap.CellStyleAtSurface(Point: TPoint): TCellStyle;
var c : TCellsCoord;
begin
  c := CellAtSurface(Point);
  Result := IsoMap[c.X,c.Y].Style;
end;

procedure TIsoMap.Flip;
begin
  if (Assigned(FFlip)) then
    FFlip;
end;

procedure TIsoMap.Cls;
begin
  if (Assigned(FCls)) then
    FCls;
end;

function TIsoMap.AddState(x, y: TGridInt; state: TCellState): TCellState;
begin
  if (x<0) or (x>=MapWidth) then Exit;
  if (y<0) or (Y>=MapHeight) then Exit;
  Result := IsoMap[x,y].State + state;
  IsoMap[x,y].State := Result;
end;

function TIsoMap.IsState(x, y: TGridInt; state: TCellState): boolean;
begin
  result := false;
  if (x<0) or (x>=MapWidth) then Exit;
  if (y<0) or (Y>=MapHeight) then Exit;
    Result := state <= IsoMap[x,y].State;

end;

function TIsoMap.NotState(x, y: TGridInt; state: TCellState): TCellState;
begin
  if (state <= IsoMap[x,y].State) then
    Result := substate(x,y,state)
  else
    Result := addstate(x,y,state);
end;

function TIsoMap.SubState(x, y: TGridInt; state: TCellState): Tcellstate;
begin
  if (x<0) or (x>=MapWidth) then Exit;
  if (y<0) or (Y>=MapHeight) then Exit;
  Result := IsoMap[x,y].State - state;
  IsoMap[x,y].State := Result;
end;

procedure TIsoMap.SubAllState(state: TCellState);
var Cellx,Celly : TGridInt;
begin
    for cellx := 0 to MapWidth-1 do
      for celly := 0 to MapHeight-1  do
        SubState(cellx,Celly,state);
end;

procedure TIsoMap.AddAllState(state: TCellState);
var Cellx,Celly : TGridInt;
begin
    for cellx := 0 to MapWidth-1 do
      for celly := 0 to MapHeight-1  do
        AddState(cellx,Celly,state);
end;

// if state in set then set image
procedure TIsoMap.FillAllStateImage(state: TCellState;
                                    ImageIndex,Layer: Integer);
var Cellx,Celly : TGridInt;
begin
    for cellx := 0 to MapWidth-1 do
      for celly := 0 to MapHeight-1  do
        if (state <= IsoMap[Cellx,CellY].State) then
          IsoMap[Cellx,Celly].ImageIndexes[Layer].ImageIndex := ImageIndex;
end;

// if image matches set the state
procedure TIsoMap.FillAllImageState(state: TCellState; ImageIndex,
  Layer: Integer);
var Cellx,Celly : TGridInt;
begin
    for cellx := 0 to MapWidth-1 do
      for celly := 0 to MapWidth-1  do
        if (IsoMap[Cellx,Celly].ImageIndexes[Layer].ImageIndex = ImageIndex) then
          AddState(Cellx,Celly,state);
end;

// if state1 matches add the state
procedure TIsoMap.AddAllStateState(TestState,SetState: TCellState);
var Cellx,Celly : TGridInt;
begin
    for cellx := 0 to MapWidth-1 do
      for celly := 0 to MapWidth-1  do
        if IsState(Cellx,Celly,TestState) then
          AddState(Cellx,Celly,SetState);
end;

function TIsoMap.GetLayerVisible(Layer: Integer): Boolean;
begin
    if (assigned(FLayerVisible)) then
        FLayerVisible(Layer,result)
    else
        result := true;
end;

procedure TIsoMap.AppendLayer;
var x,y : integer;

begin
  if (mapwidth=0) or (mapheight=0) then
      raise EStreamError.Create('Map has no width or height, so layers cannot be added');

    for x := 0 to MapWidth-1 do
      for y := 0 to Mapheight-1  do
      begin
        SetLength(IsoMap[x,y].ImageIndexes ,Length(IsoMap[x,y].ImageIndexes)+1);
        IsoMap[x,y].AlwaysDisplayTo :=Length(IsoMap[x,y].ImageIndexes);
        IsoMap[x,y].ImageIndexes[IsoMap[x,y].AlwaysDisplayTo-1].ImageIndex := -1;
      end;
end;

procedure TIsoMap.SwapLayers(L1, l2: Integer);
var x,y : integer;
  t : TIsoLayer;
begin
    for x := 0 to MapWidth-1 do
      for  y := 0 to MapWidth-1  do
      begin
        if (Length(IsoMap[x,y].ImageIndexes)>L1) and
           (Length(IsoMap[x,y].ImageIndexes)>L2) then
        begin
          t := IsoMap[x,y].ImageIndexes[L1];
          IsoMap[x,y].ImageIndexes[L1] := IsoMap[x,y].ImageIndexes[L2];
          IsoMap[x,y].ImageIndexes[L2] := t;
        end;
      end;

end;

destructor TIsoMap.Destroy;
var x,y : integer;
begin
    SetLength(fImageColors,0);

    for x := 0 to MapWidth-1 do
      for  y := 0 to MapHeight-1  do
        setlength(IsoMap[x,y].ImageIndexes,0);
  SetMapSize(0,0);
  inherited;

end;

function TIsoMap.PointAt(x, y: TGridInt): TPoint;
begin
  Result.x := (x * CellWidth) + ((y mod 2) * (fCellWidthDiv2)) - XOffset; //offset x
  Result.y := (y * (fCellHeightDiv2)+ CellHeight) - YOffset; //  variable height
end;

procedure TIsoMap.SetCellHeight(const Value: Integer);
begin
  FCellHeight := Value;
  FCellHeightDiv2 := FCellHeight div 2;
end;

procedure TIsoMap.SetCellWidth(const Value: Integer);
begin
  FCellWidth := Value;
  FCellWidthDiv2 := FCellWidth div 2;
end;

function TIsoMap.LayerCount: Integer;
var x,y,l : integer;
begin
  l := 0;
    for x := 0 to MapWidth-1 do
      for  y := 0 to MapHeight-1  do
        if length(IsoMap[x,y].ImageIndexes) > l then
          l := length(IsoMap[x,y].ImageIndexes);
    result := l;
end;

procedure TIsoMap.LoadUserDataFromStream(s: TStream; Version: String);
var l : integer;
begin
  if (Assigned(FLoadUserDataFromStream)) then
    FLoadUserDataFromStream(s,Version)
  else
  begin
    s.read(l,SizeOf(Integer));// get length
    s.Seek(l,soFromCurrent);  // skip/ignore any data that might have been saved from some other program
  end;

end;

procedure TIsoMap.SaveUserDataToStream(s: TStream; Version: string);
var l : Integer;
begin
  if (Assigned(FSaveUserDataToStream)) then
    FSaveUserDataToStream(s,Version)
  else
  begin
    l := 0;
    s.Write(l,SizeOf(Integer)); // set length of user data to 0
  end;
end;

procedure TIsoMap.LoadBmpFromStream(Index : Integer; s: TStream; Version: String);
begin
  if assigned(FLoadBmpFromStream) then
    FLoadBmpFromStream(Index,s,version);
end;

procedure TIsoMap.SaveBmpToStream(Index : Integer; s: TStream; Version: string);
begin
  if (assigned(fsavebmptostream)) then
    FSaveBmpToStream(Index,s,version);
end;

procedure TIsoMap.SwapImages(i1, i2: Integer);
var x,y,l : integer;
begin
    for x := 0 to MapWidth-1 do
      for  y := 0 to MapWidth-1  do
      begin
        for l := 0 to length(IsoMap[x,y].ImageIndexes)-1 do
        begin
          with (IsoMap[x,y].ImageIndexes[l]) do
          begin
            if ImageIndex = i1 then
              ImageIndex := i2
            else
              if (ImageIndex = i2) then
                ImageIndex := i1;
          end;
        end;
      end;
end;