editmaps.pas

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

//  fPortals:=TObjectList.Create;
//  fTeleports:=TObjectList.Create;
 fItems:=TObjectList.Create;
 fFlagNames:=TStringList.Create;
 fTextList:=TStringList.Create;
 List:=TList.Create;
 fHeader.Options:=[moDayLight];
end;

destructor TEditMap.Destroy;
begin
 fImages.Free;
  fArrays.Free;
//  fAnimations.Free;
//  fPortals.Free;
//  fTeleports.Free;
 fItems.Free;
 List.Free;
 inherited;
end;

function TEditMap.GetCell(x,y:integer):PCell;
begin
 result:=@fMap[x+fHeader.Width*y];
end;

function TEditMap.GetImageCount:integer;
begin
 result:=fImages.Count;
end;

function TEditMap.GetImage(Index:integer):TEditImage;
begin
 result:=fImages[Index];
end;

function TEditMap.GetItemCount:integer;
begin
 result:=fItems.Count;
end;

function TEditMap.GetItem(Index:integer):TEditImage;
begin
 result:=fItems[Index];
end;

procedure TEditMap.SetSize(AWidth,AHeight:integer);
var
 i:integer;
begin
 fHeader.Width:=AWidth;
 fHeader.Height:=AHeight;
 i:=AWidth*AHeight;
 SetLength(fMap,i);
 FillChar(fMap[0],i*SizeOf(TCell),0);
 if Assigned(EOnResize) then EOnResize(Self);
end;

procedure TEditMap.Clear;
begin
 fImages.Clear;
 fArrays.Clear;
// fAnimations.Clear;
// fPortals.Clear;
// fTeleports.Clear;
 fItems.Clear;
 fFlagNames.Clear;
 fTextList.Clear;
end;

procedure TEditMap.LoadFromStream105(AStream:TStream);
var
 Header105:THeader105;
 i:integer;
 img:TEditImage;
 arr:TArray;
begin
 AStream.ReadBuffer(Header105,SizeOf(Header105));
 if Header105.Sign<>cardinal(MAP_SIGNATURE) then Error('Carte invalide');
 if Header105.Ver<>MAP_105 then Error('Version de carte non support閑');
 FillChar(fHeader,SizeOf(fHeader),0);
 fHeader.Signature:=cardinal(MAP_SIGNATURE);
 fHeader.Version:=MAP_VERSION;
 fHeader.Width:=Header105.Width;
 fHeader.Height:=Header105.Height;
 fHeader.Origin:=Header105.Origin;
 fHeader.Options:=[moDayLight];
 fHeader.Arrays:=Header105.Arrays;
 fHeader.Images:=Header105.Images;
 fHeader.Items :=Header105.Items;
// les cases
 i:=fHeader.Width*fHeader.Height;
 SetLength(fMap,i);
 if Assigned(EOnResize) then EOnResize(Self);
 AStream.ReadBuffer(fMap[0],i*SizeOf(TCell));
// les tableaux
 for i:=0 to fHeader.Arrays.Count-1 do begin
  arr:=TArray.Create(Self);
  arr.LoadFromStream105(AStream);
  fArrays.Add(arr)
 end;
// les images
 for i:=0 to fHeader.Images.Count-1 do begin
  img:=TEditImage.Create(Self);
  img.LoadFromStream105(AStream);
  fImages.Add(img)
 end;
// les objets 3D
 for i:=0 to fHeader.Items.Count-1 do begin
  img:=TEditImage.Create(Self);
  img.LoadFromStream105(AStream);
  fItems.add(img);
 end;
 ShowMessage(
  'Attention ! cette carte est dans un ancien format (105).'#13#10+
  'Si vous la sauvegardez elle sera automatiquement au nouveau format ('+IntToStr(MAP_VERSION)+').'
 );
end;

procedure TEditMap.LoadFromStream(AStream:TStream);
var
 i,j:integer;
 img:TEditImage;
 arr:TArray;
begin
 Clear;
 AStream.ReadBuffer(fHeader,SizeOf(fHeader));
 if fHeader.Signature<>cardinal(MAP_SIGNATURE) then Error('Carte invalide');
 if fHeader.Version=MAP_105 then begin
  AStream.Position:=0;
  LoadFromStream105(AStream);
  exit;
 end;
 if fHeader.Version<>MAP_VERSION then Error('Version de carte non support閑');
// les cases
 i:=fHeader.Width*fHeader.Height;
 SetLength(fMap,i);
 if Assigned(EOnResize) then EOnResize(Self);
 AStream.ReadBuffer(fMap[0],i*SizeOf(TCell));
// les tableaux
 for i:=0 to fHeader.Arrays.Count-1 do begin
  arr:=TArray.Create(Self);
  arr.LoadFromStream(AStream);
  fArrays.Add(arr)
 end;
// les images
 for i:=0 to fHeader.Images.Count-1 do begin
  img:=TEditImage.Create(Self);
  img.LoadFromStream(AStream);
  fImages.Add(img)
 end;
// les objets 3D
 for i:=0 to fHeader.Items.Count-1 do begin
  img:=TEditImage.Create(Self);
  img.LoadFromStream(AStream);
  fItems.add(img);
 end;
// Les Textes
 LoadStrings(AStream,fTextList,fHeader.Texts);
 for i:=0 to fTextList.Count-1 do begin
  j:=integer(fTextList.Objects[i]);
  if j>=fImages.Count then
   img:=fItems[j-fImages.Count]
  else
   img:=fImages[j];
  fTextList.Objects[i]:=img;
 end;
// Les Indicateurs
 LoadStrings(AStream,fFlagNames,fHeader.FlagNames);
end;

procedure TEditMap.SaveStrings(AStream:TStream; List:TStringList; var Info:TArrayInfo);
var
 Strings:array of TStringInfo;
 i,l,o:integer;
 s:string;
begin
 Info.Count:=List.Count;
 Info.Offset:=AStream.Position;
 SetLength(Strings,Info.Count);
 o:=Info.Offset+cardinal(Info.Count*SizeOf(TStringInfo));
 for i:=0 to Info.Count-1 do begin
  l:=Length(List[i]);
  Strings[i].ObjectID:=integer(List.Objects[i]);
  Strings[i].Offset:=o;
  Strings[i].Length:=l;
  inc(o,l);
 end;
 AStream.WriteBuffer(Strings[0],Info.Count*SizeOf(TStringInfo));
 for i:=0 to Info.Count-1 do begin
  s:=List[i];
  l:=Length(s);
  AStream.WriteBuffer(s[1],l);
 end;
end;

procedure TEditMap.LoadStrings(Stream:TStream; List:TStringList; const Info:TArrayInfo);
var
 i:integer;
 Sizes:array of TStringInfo;
 s:string;
 l:integer;
begin
 SetLength(Sizes,Info.Count);
 Stream.ReadBuffer(Sizes[0],Info.Count*SizeOf(TStringInfo));
 for i:=0 to Info.Count-1 do begin
  l:=sizes[i].Length;
  SetLength(s,l);
  Stream.ReadBuffer(s[1],l);
  List.AddObject(s,TObject(sizes[i].ObjectID));
 end;
end;

procedure TEditMap.SaveToStream(AStream:TStream);
var
 i,j:integer;
 img:TEditImage;
begin
 fHeader.Signature:=cardinal(MAP_SIGNATURE);
 fHeader.Version :=MAP_VERSION;
 AStream.WriteBuffer(fHeader,SizeOf(fHeader));

 AStream.WriteBuffer(fMap[0],fHeader.Width*fHeader.Height*SizeOf(TCell));

 fHeader.Arrays.Count:=fArrays.Count;
 fHeader.Arrays.Offset:=AStream.Position;
 for i:=0 to fArrays.Count-1 do begin
  TArray(fArrays[i]).SaveToStream(AStream);
 end;

 fHeader.Images.Count:=fImages.Count;
 fHeader.Images.Offset:=AStream.Position;
 for i:=0 to fImages.Count-1 do begin
  TEditImage(fImages[i]).SaveToStream(AStream);
 end;

 fHeader.Items.Count:=fItems.Count;
 fHeader.Items.Offset:=AStream.Position;
 for i:=0 to fItems.Count-1 do begin
  TEditImage(fItems[i]).SaveToStream(AStream);
 end;

 for i:=0 to fTextList.Count-1 do begin
  img:=fTextList.Objects[i] as TEditImage;
  if ifForeGround in img.Data.Flags then begin
   j:=fHeader.Images.Count+cardinal(fItems.IndexOf(img));
  end else begin
   j:=fImages.IndexOf(img);
  end;
  fTextList.Objects[i]:=TObject(j);
 end;
 SaveStrings(AStream,fTextList,fHeader.Texts);
 for i:=0 to fTextList.Count-1 do begin
  j:=integer(fTextList.Objects[i]);
  if j>=fImages.Count then
   img:=fItems[j-fImages.Count]
  else
   img:=fImages[j];
  fTextList.Objects[i]:=img;
 end;
 SaveStrings(AStream,fFlagNames,fHeader.FlagNames);

 AStream.Position:=0;
 AStream.WriteBuffer(fHeader,SizeOf(fHeader));
end;

procedure TEditMap.Add(Image:TEditImage);
begin
 fImages.Add(Image);
end;

function TEditMap.NewImage(x,y,Index,Base:integer; Flags:TImageFlags):TEditImage;
begin
 Result:=TEditImage.Create(Self);
 Result.Data.Index:=Index;
 Result.Data.Position.x:=x;
 Result.Data.Position.Y:=y;
 Result.Data.BaseLine:=Base;
 Result.Data.Flags:=Flags;
end;

function TEditMap.AddImage(x,y,Index,Base:integer; Flags:TImageFlags):TEditImage;
begin
 Result:=NewImage(x,y,Index,Base,Flags);
 Add(Result);
end;

procedure TEditMap.DrawImage(Img:TEditImage; x,y:integer);
var
 size:TPoint;
 clip:TRect;
 step:integer;
 pitch:integer;
begin
 size:=fImageLib.Size[Img.Data.Index];
 if x+size.x<Client.Left then exit;
 if y+size.y<Client.Left then exit;
 pitch:=ADKScreen.Pitch;//ClientWidth;
 if ClipRect(Client,x,y,size.x,size.y,clip) then begin
  if ifSwap in img.Data.Flags then begin
   step:=-1;
   inc(x,size.x-1);
   SwapRect(clip,size.x);
  end else begin
   step:=+1;
  end;
  if ifFlip in img.Data.Flags then begin
   pitch:=-pitch;
   inc(y,size.y-1);
   FlipRect(clip,size.y);
  end;
  fImageLib.DrawRect(img.Data.Index,ADKScreen.Pixels[x,y],pitch,step,Clip,img.Mask);
 end else begin
  if ifSwap in img.Data.Flags then begin
   step:=-1;
   inc(x,size.x-1);
  end else begin
   step:=+1;
  end;
  if ifFlip in img.Data.Flags then begin
   pitch:=-pitch;
   inc(y,size.y-1);
  end;
  fImageLib.Draw(img.Data.Index,ADKScreen.Pixels[x,y],pitch,step,img.Mask);
 end;
end;

procedure TEditMap.DrawImages(Front:boolean; AWidth,AHeight,AScrollX,AScrollY:integer);
var
 list:TList;
 i:integer;
 img:TEditImage;
 imgindex:integer;
 x,y:integer;
 size:TPoint;

 procedure DrawArray;
 var
  ar:TArray;
  ox:integer;
  oy:integer;
  ay:integer;
  ax:integer;
 begin
  ar:=img.GetArray;
  //imgindex:=ar.Index;
  size:=fImageLib.Size[imgIndex];
  ox:=x;
  oy:=y;
  for ay:=0 to ar.Height-1 do begin
   x:=ox;
   y:=oy;
   for ax:=0 to ar.Width-1 do begin
    if x>AWidth then break;
    if y>AHeight then break;
    if ((x+size.x)>=0)and((y+size.y)>=0) then DrawImage(img,x,y);
    inc(x,ar.Stepx);
    inc(y,ar.Stepy);
   end;
   dec(ox,ar.Stepx);
   inc(oy,ar.Stepy);
   if oy>AHeight then exit;
  end;
 end;

begin
 if fImageLib<>nil then begin
  fNotFlags:=not fHeader.Flags;
  if Front then begin
   fItems.Sort(SortItems);
   list:=fItems;
  end else begin
   list:=fImages;
  end;
  Client:=Rect(0,0,AWidth-1,AHeight-1);
  ClientWidth:=AWidth;
  for i:=0 to list.Count-1 do begin
   img:=list[i];
   // test les flags !
   if ifNotFlag in img.Data.Flags then begin
    if (img.Data.Hidden and fHeader.Flags)<>0 then continue;
   end else begin
    if (img.Data.Hidden and fNotFlags)<>0 then continue;
   end;
   x:=img.Data.Position.x+AScrollX;
   y:=img.Data.Position.y+AScrollY;
   // image trop