isoengine.pas

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

procedure ReadVersion1;
var x,y,l : TGridInt;
  i,len,ImageCount : integer;
  c : TColor;
  il : TIsoLayer;
  tempstr : string;
begin
  if (v = Version1_2) then
  begin
    s.Read(Imagecount,sizeof(integer));
    setlength(FImageStrings,ImageCount);
    for i := 0 to imagecount - 1 do
    begin
      FImageStrings[i] := readstr(S);
    end;
    v := Version1_1;  // let the rest follow through as version 1.1
  end;
  if (V = Version1_1) then
  begin
    s.read(ImageCount,sizeof(Integer));
    for i := 0 to ImageCount-1 do
    begin
      S.Read(len,SizeOf(Integer));
      len := len + S.Position;  // mark position after the bmp in case subclass messes up
      LoadBmpFromStream(i,S,V);
      s.Seek(len,soFromBeginning);  // go to where the bitmap should end.
      tempstr := readstr(S);
      if Assigned(OnSetImageName) then
        OnSetImageName(i,tempstr);
      S.Read(c,SizeOf(c));
      if Assigned(onsetImageTransparentcolor) then
        OnSetImageTransparentColor(i,c);
    end;
  end;
  if (V = Version1) then
    LoadImageListFromStream(s,v); // virtual function will call decendent for whatever type of Image list is needed
  MapName := ReadStr(S);
  LoadUserDataFromStream(S,v);
  S.read(MaxX,SizeOf(MaxX));
  S.Read(MaxY,SizeOf(MaxY));
  SetMapSize(MaxX,MaxY);
  S.read(FCellWidth,sizeof(FCellWidth));
  S.Read(FCellHeight,sizeof(FCellHeight));
  FCellWidthDiv2 := FCellWidth div 2;
  FCellHeightDiv2 := FCellHeight div 2;
  S.Read(FXOffset,sizeof(FXOffset));
  S.Read(FYOffset,sizeof(FYOffset));
  S.read(FOptions,SizeOf(TIsoRenderOptions));
  S.Read(l,SizeOf(l));
  SetLength(FImageColors,l);
  for y := 0 to l -1 do
  begin
    S.Read(c,SizeOf(c));
    FImageColors[y] := c;
  end;
  S.read(fshowgrid,SizeOf(FShowGrid));
  if (v = Version1) or (v = Version1_1) then
    S.read(expansion,SizeOf(expansion))  // some space to grow for version 1.1 etc
  else
  begin
      // do it a different way as long as the size is the same as expansion
  end;
  for x := 0 to MapWidth-1 do
        for y := 0 to MapHeight-1 do
        begin
           S.Read(Isomap[x,y].AlwaysDisplayFrom,SizeOf(integer));
           S.Read(Isomap[x,y].AlwaysDisplayTo,SizeOf(integer));
           S.Read(Isomap[x,y].AnimateFrom,SizeOf(integer));
           S.Read(Isomap[x,y].AnimateTo,SizeOf(integer));
           S.Read(Isomap[x,y].AnimateNext,SizeOf(integer));
           S.Read(Isomap[x,y].AnimateCount,SizeOf(integer));
           S.Read(IsoMap[x,y].AnimateSpeed,SizeOf(integer));
           S.Read(Isomap[x,y].Style,SizeOf(TCellStyle));
           s.Read(isomap[x,y].state,sizeof(tcellstate));
           IsoMap[x,y].CommentID := AddComment(ReadStr(S));
           S.Read(l,SizeOf(l));
           SetLength(Isomap[x,y].imageindexes,l);
           for l := 0 to length(Isomap[x,y].imageindexes)-1 do
           begin
            s.Read(il,SizeOf(il));
            IsoMap[x,y].ImageIndexes[l] := il;
           end;
        end;
end;
procedure ReadVersion2;
begin
  // do any reading you want for version2 or call ReadVersion1 first depending
  //  on how the data in future versions is coded
  raise EStreamError.create('There is no version 2 yet!!!');
end;
begin
  v := ReadStr(s);
  if (v=Version1) or (v=Version1_1) or (v=Version1_2) then
    ReadVersion1
  else
  if (v=Version2) then  //example of next version
    readversion2
  else
    raise EStreamError.Create('Invalid Format');
  AddAllState([tsDirty]);
end;

procedure TIsoMap.SaveToFile(filename: string);
var f : TFileStream;
begin
  f := TFileStream.Create(FileName,fmCreate);
  try
    SaveToStream(f);
  finally
    f.Free;
  end;

end;

procedure TIsoMap.SaveToStream(S: TStream);
var expansion : array[0..1024] of Byte;
    il : TIsoLayer;
procedure WriteVersion1;
var x,y,l : TGridInt;
  i,len,ImageCount : integer;
  c : TColor;
  ms : TMemorystream;
  tempstr : string;
begin
{$ifdef V1_2 }
  ImageCount := length(FImageStrings);
  s.Write(ImageCount,sizeof(ImageCount));
  for i := 0 to imagecount - 1 do
  begin
    Tempstr := FImageStrings[i];
    WriteStr(s,tempstr);
  end;
{$endif}

{$ifdef V1_1 }
// Version1_1 save images as bmps
  ImageCount := GetImageCount;
  ms := TMemoryStream.Create;
  try
  s.Write(ImageCount,sizeof(ImageCount));
  for i := 0 to ImageCount-1 do
  begin
    ms.Clear;
    ms.Seek(0,soFromBeginning);
    SaveBmpToStream(i,ms,Version1_1);
    len := ms.Position;
    ms.Position := 0;
    S.Write(len,SizeOf(integer));
    S.CopyFrom(ms,len);
    tempstr := '';
    if Assigned(ongetImageName) then
      OnGetImageName(i,tempstr);
    WriteStr(S,tempstr);
    c := $ff00ff;// default transparent color
    if Assigned(OnGetImageTransparentcolor) then
      OnGetImageTransparentColor(i,c);
    S.Write(c,SizeOf(c));
  end;
  finally
    ms.Free;
  end;
{$else}
// version1 saves as a stream
  SaveImageListToStream(s,Version1); // virtual will call derived classes\
{$endif}
  WriteStr(S,MapName);
  SaveUserDataToStream(S,Version1);
  S.Write(FMapWidth,SizeOf(FMapWidth));
  S.Write(FMapHeight,SizeOf(FMapHeight));
  S.Write(FCellWidth,sizeof(FCellWidth));
  S.Write(FCellHeight,sizeof(FCellHeight));
  S.Write(FXOffset,sizeof(FXOffset));
  S.Write(FYOffset,sizeof(FYOffset));
  S.Write(FOptions,SizeOf(TIsoRenderOptions));
  l := Length(FImageColors);
  S.Write(l,SizeOf(l));
  for y := 0 to l-1 do
  begin
    c := FImageColors[y];
    S.Write(c,SizeOf(c));
  end;
  S.Write(FShowGrid,SizeOf(FShowGrid));
  S.Write(expansion,SizeOf(expansion));  // some space to grow for version 1.1 etc
  for x := 0 to MapWidth -1 do
        for y := 0 to MapHeight-1 do
        begin
           S.Write(Isomap[x,y].AlwaysDisplayFrom,SizeOf(integer));
           S.Write(Isomap[x,y].AlwaysDisplayTo,SizeOf(integer));
           S.Write(Isomap[x,y].AnimateFrom,SizeOf(integer));
           S.Write(Isomap[x,y].AnimateTo,SizeOf(integer));
           S.Write(Isomap[x,y].AnimateNext,SizeOf(integer));
           S.Write(Isomap[x,y].AnimateCount,SizeOf(integer));
           S.Write(IsoMap[x,y].AnimateSpeed,SizeOf(integer));
           S.Write(Isomap[x,y].Style,SizeOf(TCellStyle));
           s.write(isomap[x,y].state,sizeof(tcellstate));
           WriteStr(S,GetComment(isomap[x,y].CommentID));
           l := Length(Isomap[x,y].imageindexes);
           S.Write(l,SizeOf(l));
           for l := 0 to length(Isomap[x,y].imageindexes)-1 do
           begin
             il := IsoMap[x, y].ImageIndexes[l];
             s.Write(il,SizeOf(il));
           end;
        end;
end;

begin
{$ifdef V1_2}
  WriteStr(S,Version1_2);
  WriteVersion1;
  Exit;
{$endif}
{$ifdef V1_1}
  WriteStr(S,Version1_1);
{$else}
  WriteStr(s,Version1);
{$endif}
  WriteVersion1;
end;


function TIsoMap.GetCell(x, y: TGridInt): TIsoCell;
begin
    result := IsoMap[x,y];
end;


function TIsoMap.GetCell(GridPoint: TCellsCoord): TIsoCell;
begin
    result := IsoMap[GridPoint.x,GridPoint.y];
end;

function TIsoMap._GetCell(x, y: TGridInt): TIsoCell;
begin
    result := IsoMap[x,y];
end;

procedure TIsoMap.SetMapSize(MaxX, MaxY: TGridInt);
var ox,oy,x,y,l : TGridInt;
begin
  if (mapwidth>0) then
    l := Length(isomap[0,0].imageindexes)
  else l := 1;
  ox := Length(isomap);
  for x := MaxX to MapWidth-1 do  // if making map smaller, set excess length to 0
    SetLength(isomap[x],0);
  SetLength(isomap,MaxX);

  for x := 0 to MaxX-1 do
  begin
    oy := Length(isomap[x]);
    SetLength(isomap[x],MaxY);
    for y := 0 to MaxY-1 do
    begin
      if (y>=oy) or (x>=ox) then  // only initialize new cells.
      begin
        SetLength(Isomap[x,y].ImageIndexes,l);
        IsoMap[x,y].ImageIndexes[0].ImageIndex := -1; // no Image
        IsoMap[x,y].AlwaysDisplayFrom := 1;
        IsoMap[x,y].AlwaysDisplayTo := 1;
        IsoMap[x,y].AnimateFrom := 1;
        IsoMap[x,y].AnimateTo := -1;
        IsoMap[x,y].AnimateSpeed := 1;
        IsoMap[x,y].AnimateCount := 1;
        IsoMap[x,y].Style := 0;       // no style
        IsoMap[x,y].State := [tsSelected];  // selected
      end;
    end;
  end;
  FMapWidth := MaxX;
  FMapHeight := MaxY;
end;

procedure TIsoMap.LoadMapFromStream(s: TStream);  // oldstyle map
var x,y,MaxX,MaxY : integer;
  dummy : TGridInt;
begin
    s.Read(maxX, sizeof(MaxX)); // map
    s.read(MaxY, sizeof(MaxY));
    self.SetMapSize(MaxX,MaxY);  // old map sizes
    s.read(dummy,SizeOf(dummy));
    CellWidth := dummy;
    s.read(dummy,SizeOf(dummy));
    CellHeight := dummy;
    s.read(dummy,SizeOf(dummy));// vertoffset
    s.read(dummy,SizeOf(dummy));
    s.read(dummy,SizeOf(dummy));
    s.read(dummy,SizeOf(dummy));
    s.read(dummy,SizeOf(dummy));
    s.read(dummy,SizeOf(dummy));
    for x := 0 to length(isomap)-1 do
        for y := 0 to length(isomap[0])-1 do
        begin
           SetLength(Isomap[x,y].ImageIndexes,1);
           s.read(IsoMap[x, y].ImageIndexes[0] , sizeof(integer));
           IsoMap[x,y].AlwaysDisplayFrom := 0;
           IsoMap[x,y].AlwaysDisplayTo := 0;
           IsoMap[x,y].AnimateFrom := 0;
           IsoMap[x,y].AnimateTo := -1;
           IsoMap[x,y].AnimateNext := 0;
           IsoMap[x,y].AnimateSpeed := 1;
           IsoMap[x,y].AnimateCount := 1;
           IsoMap[x,y].Style := 0;
           IsoMap[x,y].State := [tsSelected];
        end;
end;

function TIsoMap.ReadStr(Stream: TStream): string;
var
  Size: Integer;
  S: string;
begin
    stream.Read(size,sizeof(Size));
    SetString(S, nil, Size);
    Stream.Read(Pointer(S)^, Size);
    result :=s ;
end;

procedure TIsoMap.WriteStr(Stream: TStream; s: string);
var Size : integer;
begin
     Size := length(s);
     Stream.Write(Size,sizeof(Size));
     Stream.WriteBuffer(Pointer(S)^, Length(S));
end;


procedure TIsoMap.ResetImageColors;
var i : integer;

procedure ResetTileColor(ImageIndex : integer);
var w,h : integer;
    c,r,g: integer;
    rgb : TColor;
    srgb : array [0..20] of tcolor;
    freq : array [0..20] of TColor;
begin
  // old method finds center pixel and uses that as color guide

    fImageColors[ImageIndex] := GetPixel(ImageIndex,GetImageWidth(ImageIndex) div 2,
        GetImageHeight(ImageIndex) div 2);
//    FImageList.Items[ImageIndex].PatternSurfaces[0].Canvas.Release; // first pattern

    exit;

  // new method finds most common color in Image and uses that as color guide
    c := -1;
    for w := 0 to GetImageWidth(ImageIndex)-1 do
        for h := 0 to FCellHeight-1 do
        begin
            rgb := GetPixel(ImageIndex,w,h);
            r := 0;
            while (r <= c) do
            begin
                if (rgb = srgb[r]) then
                begin
                    Inc(freq[r]);
                    Break;
                end;
                Inc(r);
            end;
            if (r>c) then
            begin
              Inc(c);
              if (c>20) then
              begin
                  r := 0;
                  for c := 1 to 20 do // find least used color
                      if (freq[c]<freq[r]) then r := c;
                  srgb[r] := rgb;
                  c := 20;
                  freq[r] := 1;
              end
              else
              begin
                  srgb[c] := rgb;
                  freq[c] := 1;
              end;
            end;
        end;
    g := 1;
    for r := 1 to c do
        if (freq[r]>freq[g]) then g := r;
    fImageColors[ImageIndex] := srgb[g];
//    FImageList.Items[ImageIndex].PatternSurfaces[0].Canvas.Release; // first pattern
end;
begin
  SetLength(fImageColors,GetImageCount);
  for i := 0 to length(fImageColors)-1 do
  begin
    if (assigned(Onprogress)) and (length(fimagecolors)>0) then
      OnProgress(i div length(fImageColors));
    ResetTileColor(i);
  end;
end;

function TIsoMap._GetImageColor(ImageIndex: Integer): TColor;
begin
  // assume anything out of range of color map is RED