editmaps.pas

N年前有个法国小组用Delphi写了一个2D网游（AD&D类型）

unit EditMaps;

{
 projet ADK-ISO (c)2002-2003 Paul TOTH <[e-mail]>

 http://www.web-synergy.net/naug-land/

}

interface

uses
 Windows,Classes,SysUtils,ADKUtils,ADKImages,ADKMaps,Dialogs;

type
 TEditMap=class;
 TArray=class;

 TEditItem=class
 private
  fMap:TEditMap;
 public
  constructor Create(AMap:TEditMap);
  function Copy:TEditItem; virtual;
  procedure Past(AMap:TEditMap; dx,dy:integer); virtual;
  property Map:TEditMap read fMap;
 end;

 TEditSprite=class(TEditItem)
 public
  procedure Show;
  procedure Hide;
 end;

 TEditImage=class(TEditItem)
 private
  fArray  :TArray;
  function GetText:string;
  procedure SetText(Value:string);
 public
  Mask    :integer;
  Data    :TImageData106;
  destructor Destroy; override;
  procedure SaveToStream(AStream:TStream);
  procedure LoadFromStream105(AStream:TStream);
  procedure LoadFromStream(AStream:TStream);
  procedure SetArray(Width,Height,StepX,StepY:integer);
  procedure RemoveArray;
  procedure SetForeground(Value:boolean);
  function GetPoint(x,y:integer):boolean;
  property GetArray:TArray read fArray;
  function Copy:TEditItem; override;
  procedure Past(AMap:TEditMap; dx,dy:integer); override;
  property Text:string read GetText write SetText;
 end;

 TArray=class(TEditItem)
  Data:TArrayData106;
  Index105:integer;
  procedure SaveToStream(AStream:TStream);
  procedure LoadFromStream105(AStream:TStream);
  procedure LoadFromStream(AStream:TStream);
  property Index :integer read Index105 write Index105;
  property Width :integer read Data.Width write Data.Width;
  property Height:integer read Data.Height write Data.Height;
  property StepX :integer read Data.Step.X write Data.Step.X;
  property StepY :integer read Data.Step.Y write Data.Step.Y;
 end;
(*
 TTeleport=class(TEditItem)
  Index :integer; // image ou animation (voir TImage.Flags)
  Active:boolean;
  Target:TPoint;
 end;

 TPortal=class(TEditItem)
  Index  :integer; // image ou animation (voir TImage.Flags)
  Active :boolean;
  MapName:string;
  Target :TPoint;
 end;

 TSequence=class(TEditItem)
  First :integer; // premi鑢e image
  Count :integer; // nombre d'images
  Times :array {Count} of integer; // nombre de ms entre deux images
 end;

 TAnimation=class(TEditItem)
  Active:boolean; // animation active
  Index:integer;  // image actuelle
  Sequence:TSequence;
 end;
*)
 TEditMap=class(TStreamedObject)
 private
  fHeader    :THeader106;
  fMap       :array of TCell;
  fImages    :TObjectList;
   fArrays    :TObjectList;
//   fAnimations:TObjectList;
//   fPortals   :TObjectList;
//   fTeleports :TObjectList;
  fItems     :TObjectList;
  fImageLib  :TADKImageLib;
  fFlagNames :TStringList;
  fTextList  :TStringList;
  EOnResize:TNotifyEvent;
  fNotFlags:integer;
  function GetCell(x,y:integer):PCell;
  function GetImageCount:integer;
  function GetImage(Index:integer):TEditImage;
  function GetItemCount:integer;
  function GetItem(Index:integer):TEditImage;
  procedure SaveStrings(AStream:TStream; List:TStringList; var Info:TArrayInfo);
  procedure LoadStrings(Stream:TStream; List:TStringList; const Info:TArrayInfo);
 protected
  Client:TRect; // client Rect to draw image inside
  ClientWidth:integer;
  List:TList;
  procedure DrawImage(img:TEditImage;x,y:integer);
  procedure LoadFromStream105(AStream:TStream);
  procedure LoadFromStream(AStream:TStream); override;
  procedure SaveToStream(AStream:TStream); override;
 public
  constructor Create;
  destructor Destroy; override;
  procedure SetSize(AWidth,AHeight:integer);
  procedure Clear;
  procedure Add(Image:TEditImage);
  function NewImage(x,y,Index,Base:integer; Flags:TImageFlags):TEditImage;
  function AddImage(x,y,Index,Base:integer; Flags:TImageFlags):TEditImage;
  procedure Exchange(i,j:integer);
  procedure Move(Old,NewIndex:integer);
  procedure Remove(Index:Integer);
  procedure DrawImages(Front:boolean; AWidth,AHeight,AScrollX,AScrollY:integer);
  procedure _DrawMap(AWidth,AHeight,AScrollX,AScrollY:integer);
  procedure _DrawItems(AWidth,AHeight,AScrollX,AScrollY:integer);
  function GetItemXY(x,y:integer; var Current:TEditImage; ForeGroundOnly:boolean):integer;
  procedure AddFlag(Name:string);
  function FlagIndex(Mask:integer):integer;
  function FlagMask(index:integer):integer;
  property Cells[x,y:integer]:PCell read GetCell;
  property ImageCount:integer read GetImageCount;
  property Images[Index:integer]:TEditImage read GetImage;
  property ItemCount:integer read GetItemCount;
  property Items[Index:integer]:TEditImage read GetItem;
  property ImageLib:TADKImageLib read fImageLib write fImageLib;
  property Width:integer read fHeader.Width;
  property Height:integer read fHeader.Height;
  property Origin:TPoint read fHeader.Origin write fHeader.Origin;
  property Ambient:integer read fHeader.Ambient write fHeader.Ambient;
  property Options:TMapOptions read fHeader.Options write fHeader.Options;
  property Flags:integer read fHeader.Flags write fHeader.Flags;
  property FlagNames:TStringList read fFlagNames;
  property TextList:TStringList read fTextList;
  property OnResize:TNotifyEvent read EOnResize write EOnResize;
 end;

implementation

uses ADKScreens;

//--------------------------------------------------------------------//

function SortItems(Item1,Item2:pointer):integer;
var
 Image1:TEditImage absolute Item1;
 Image2:TEditImage absolute Item2;
begin
 result:=(Image1.Data.Position.y+Image1.Data.BaseLine)-(Image2.Data.Position.y+Image2.Data.BaseLine);
end;

//--------------------------------------------------------------------//
constructor TEditItem.Create(AMap:TEditMap);
begin
 fMap:=AMap;
end;

function TEditItem.Copy:TEditItem;
begin
 raise Exception.Create('Ne peut copier '+ClassName);
end;

procedure TEditItem.Past(AMap:TEditMap; dx,dy:integer);
begin
 fMap:=AMap;
end;

//--------------------------------------------------------------------//
procedure TEditSprite.Show;
begin
 fMap.fItems.Add(Self);
end;

procedure TEditSprite.Hide;
begin
 fMap.fItems.Extract(Self);
end;

//--------------------------------------------------------------------//
destructor TEditImage.Destroy;
begin
 if fArray<>nil then fMap.fArrays.Remove(fArray);
 inherited;
end;

procedure TEditImage.SetArray(Width,Height,StepX,StepY:integer);
begin
 if (Width<=1)and(Height<=1) then begin
  RemoveArray;
  exit;
 end;
 if fArray=nil then begin
  fArray:=TArray.Create(fMap);
//  fArray.Index:=Data.Index;
  fMap.fArrays.Add(fArray);
  include(Data.Flags,ifArray);
 end;
 fArray.Width:=Width;
 fArray.Height:=Height;
 fArray.StepX:=StepX;
 fArray.stepY:=StepY;
end;

procedure TEditImage.RemoveArray;
begin
 if fArray=nil then exit;
 fMap.fArrays.Remove(fArray);
 fArray:=nil;
 exclude(Data.Flags,ifArray);
end;

procedure TEditImage.SetForeground(Value:boolean);
begin
 if Value = (ifForeground in Data.Flags) then exit;
 if Value then begin
  include(Data.Flags,ifForeground);
  fMap.fImages.Extract(Self);
  fMap.fItems.Add(Self);
 end else begin
  exclude(Data.Flags,ifForeground);
  fMap.fItems.Extract(Self);
  fMap.fImages.Add(Self);
 end;
end;

function TEditImage.GetPoint(x,y:integer):boolean;
var
 size:TPoint;
 ox,oy:integer;
 px,py:integer;
 w,h:integer;
begin
 result:=false;
 if (y<Data.Position.Y) then exit;
 if ifArray in Data.Flags then begin
  ox:=Data.Position.x;
  oy:=Data.Position.y;
  size:=fMap.fImageLib.Size[Data.Index];
  for h:=0 to fArray.Height-1 do begin
   px:=ox;
   py:=oy;
   for w:=0 to fArray.Width-1 do begin
    if (x<px) then break;
    if (y<py) then exit;
    if (x<px+size.x)and(y<py+size.y) then begin
     result:=true;
     exit;
    end;
    inc(px,fArray.Stepx);
    inc(py,fArray.Stepy);
   end;
   dec(ox,fArray.Stepx);
   inc(oy,fArray.Stepy);
  end;
 end else begin
  if (x<Data.Position.x) then exit;
  size:=fMap.fImageLib.Size[Data.Index];
  result:=(x<Data.Position.x+size.x)and(y<Data.Position.y+size.y);
 end;
end;

procedure TEditImage.SaveToStream(AStream:TStream);
begin
 if ifArray in Data.Flags then Data.Data:=fMap.fArrays.IndexOf(fArray);
 AStream.WriteBuffer(Data,SizeOf(Data));
end;

procedure TEditImage.LoadFromStream105(AStream:TStream);
var
 Data105:TImageData105;
begin
 AStream.ReadBuffer(Data105,SizeOf(Data105));
 Data.Index:=Data105.Index;
 Data.Position:=Data105.Position;
 Data.BaseLine:=Data105.BaseLine;
 Data.Flags:=Data105.Flags;
 Data.Hidden:=0;
 if ifArray in Data.Flags then begin
  fArray:=fMap.fArrays[Data.Index];
  Data.Data:=Data.Index;
  Data.Index:=fArray.Index105;
 end;
end;

procedure TEditImage.LoadFromStream(AStream:TStream);
begin
 AStream.ReadBuffer(Data,SizeOf(Data));
 if ifArray in Data.Flags then begin
  fArray:=fMap.fArrays[Data.Data];
  //Data.Index:=fArray.Index;
 end;
end;

function TEditImage.Copy:TEditItem;
begin
 Result:=TEditImage.Create(fMap);
 with TEditImage(Result) do begin
  Data:=Self.Data;
  if ifArray in Data.Flags then begin
   fArray:=TArray.Create(fMap);
   //fArray.Index :=Data.Index;
   fArray.Width :=Self.fArray.Width;
   fArray.Height:=Self.fArray.Height;
   fArray.StepX :=Self.fArray.StepX;
   fArray.stepY :=Self.fArray.StepY;
  end;
 end;
end;

procedure TEditImage.Past(AMap:TEditMap; dx,dy:integer);
begin
 if ifForeGround in data.Flags then
  AMap.fItems.add(Self)
 else
  AMap.fImages.Add(Self);
 if ifArray in Data.Flags then AMap.fArrays.Add(fArray);
 inc(Data.Position.x,dx);
 inc(Data.Position.y,dy);
 Mask:=$ff0000;
end;

function TEditImage.GetText:string;
var
 i:integer;
begin
 i:=Map.TextList.IndexOfObject(Self);
 if i<0 then Result:='' else Result:=Map.TextList[i];
end;

procedure TEditImage.SetText(Value:string);
var
 i:integer;
begin
 i:=Map.TextList.IndexOfObject(Self);
 if i<0 then begin
  if Value='' then exit;
  Map.TextList.AddObject(Value,Self);
 end else begin
  if Value='' then Map.TextList.Delete(i) else Map.TextList[i]:=Value;
 end;
end;

//--------------------------------------------------------------------//
procedure TArray.SaveToStream(AStream:TStream);
begin
 AStream.WriteBuffer(Data,SizeOf(Data));
end;

procedure TArray.LoadFromStream105(AStream:TStream);
begin
 AStream.ReadBuffer(Index105,SizeOf(Index105));
 AStream.ReadBuffer(Data,SizeOf(Data));
end;

procedure TArray.LoadFromStream(AStream:TStream);
begin
 AStream.ReadBuffer(Data,SizeOf(Data));
end;
//--------------------------------------------------------------------//

constructor TEditMap.Create;
begin
 FillChar(fHeader,SizeOf(fHeader),0);
 fImages:=TObjectList.Create;
 fArrays:=TObjectList.Create;
//  fAnimations:=TObjectList.Create;