imagetrees.pas

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

unit ImageTrees;

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

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

}

interface

uses
  ADKImages, EditMaps, ADKDepth,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, ExtCtrls, ActnList, StdActns;

type
  TImageDef=record
   Index :Integer;
   Origin:TPoint;
  end;
  PImageDef=^TImageDef;

  TImageTree = class(TFrame)
    ToolBar2: TToolBar;
    ToolButton19: TToolButton;
    ToolButton18: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    TreeView: TTreeView;
    ScrollBox1: TScrollBox;
    Splitter2: TSplitter;
    ActionList1: TActionList;
    acSaveImages: TFileSaveAs;
    acOpenImages: TFileOpen;
    acDelImage: TAction;
    acAddImage: TFileOpen;
    Image1: TImage;
    ToolButton1: TToolButton;
    acNewFolder: TAction;
    acSaveTree: TAction;
    ToolButton2: TToolButton;
    acMoveUp: TAction;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    acAnim: TAction;
    procedure acSaveImagesAccept(Sender: TObject);
    procedure acOpenImagesAccept(Sender: TObject);
    procedure acAddImageAccept(Sender: TObject);
    procedure TreeViewChange(Sender: TObject; Node: TTreeNode);
    procedure acDelImageExecute(Sender: TObject);
    procedure acNewFolderExecute(Sender: TObject);
    procedure TreeViewDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TreeViewDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure acSaveTreeExecute(Sender: TObject);
    procedure TreeViewEdited(Sender: TObject; Node: TTreeNode;
      var S: String);
    procedure acMoveUpExecute(Sender: TObject);
    procedure acAnimExecute(Sender: TObject);
    procedure TreeViewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    fImageLib:TADKImageLib;
    fNodes:array of TTreeNode;
    procedure SaveTree(AFileName:string);
    procedure LoadTree(AFileName:string);
    procedure OpenLib(AFileName:string);
    procedure RecursiveDelNode(Node:TTreeNode);
    function ParentFolder(Node:TTreeNode):TTreeNode;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure AddDIB(node:TTreeNode; AName:string; const Palette:TPalette32; TransparentColor,Width,Height:integer; DIB:pointer; const AOrg:TPoint);
    procedure AddBitmap(node:TTreeNode; AName:string; ABitmap:TBitmap; const AOrg:TPoint);
    procedure Select(Index:integer);
    function NewFolder(Parent:TTreeNode; Caption:string):TTreeNode;
    function GetNode(Image:TEditImage):TTreeNode;
    function ImageDef(Image:TEditImage):PImageDef;
    function ImageName(Image:TEditImage):string;
    function ImageOrg(Image:TEditImage):TPoint;
    property ImageLib:TADKImageLib read fImageLib;
  end;

implementation

uses IsoMap1, ADKUtils, ImportBitmaps, CommonData;

{$R *.dfm}

const
 IMAGE_INDEX=8;
 CLOSED_FOLDER_INDEX=12;
 OPEN_FOLDER_INDEX=13;
 CLIP_INDEX=21;

constructor TImageTree.Create(AOwner:TComponent);
begin
 inherited;
 fImageLib:=TADKImageLib.Create;

 LoadDialog(acOpenImages.Dialog);
 LoadDialog(acSaveImages.Dialog);
 LoadDialog(acAddImage.Dialog);

 acOpenImages.Dialog.Filter:=IMLFilter+'|'+ALLFilter;
 acSaveImages.Dialog.Filter:=IMLFilter+'|'+ALLFilter;
end;

destructor TImageTree.Destroy;
begin
 SaveDialog(acOpenImages.Dialog);
 SaveDialog(acSaveImages.Dialog);
 SaveDialog(acAddImage.Dialog);
 fImageLib.Free;
 inherited;
end;

procedure TImageTree.SaveTree(AFileName:string);
var
 s:TFileStream;
 i,count:integer;
 n:TTreeNode;
 d:PImageDef;
begin
 s:=TFileStream.Create(AFileName,fmCreate);
 try
  count:=TreeView.Items.Count;
  putInteger(s,count);
  for i:=0 to count-1 do begin
   n:=TreeView.Items[i];
   putInteger(s,n.Level);
   putString(s,n.Text);
   d:=n.data;
   putBoolean(s,d<>nil);
   if d<>nil then s.WriteBuffer(d^,sizeof(TImageDef));
  end;
 finally
  s.Free;
 end;
end;

procedure TImageTree.LoadTree(AFileName:string);
var
 s:TFileStream;
 i,count:integer;
 l,level:integer;
 n:TTreeNode;
 d:PImageDef;
begin
 s:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyNone);
 try
  count:=getInteger(s);
  level:=0;
  n:=nil;
  for i:=0 to count-1 do begin
   l:=getInteger(s);
   if l>level then begin
    n:=TreeView.Items.AddChild(n,getString(s));
   end else begin
    while l<level do begin
     n:=n.Parent;
     dec(level);
    end;
    n:=TreeView.Items.Add(n,getString(s));
   end;
   level:=l;
   if getBoolean(s) then begin
    new(d);
    s.ReadBuffer(d^,sizeof(TImageDef));
    if d.Index<Length(fNodes) then begin
     if fNodes[d.Index]=nil then
      fNodes[d.Index]:=n
     else begin
      n.Free;
      n:=fNodes[d.Index];
      Dispose(d);
      d:=n.Data;
     end;
    end;
    n.Data:=d;
    n.ImageIndex:=IMAGE_INDEX;
    n.SelectedIndex:=IMAGE_INDEX;
    //n.Text:=n.Text+' ['+IntToStr(d.Index)+']';
   end else begin
    n.ImageIndex:=CLOSED_FOLDER_INDEX;
    n.SelectedIndex:=OPEN_FOLDER_INDEX;
   end;
  end;
  for i:=0 to ImageLib.Count-1 do begin
   if (fNodes[i]=nil)and (not ImageLib.Deleted(i)) then begin
    n:=TreeView.Items.AddChild(nil,IntToStr(i));
    new(d);
    d.Index:=i;
    d.Origin:=Point(0,0);
    n.Data:=d;
    n.ImageIndex:=IMAGE_INDEX;
    n.SelectedIndex:=IMAGE_INDEX;
    fNodes[i]:=n;
   end; 
  end;
 finally
  s.Free;
 end;
end;

procedure TImageTree.OpenLib(AFileName:string);
var
 i:integer;
 node:TTreeNode;
 def:PImageDef;
begin
 for i:=0 to TreeView.Items.Count-1 do begin
  def:=TreeView.Items[i].Data;
  if def<>nil then dispose(def);
 end;
 TreeView.Items.Clear;
 ImageLib.LoadFromFile(AFileName,False);
 fNodes:=nil;
 SetLength(fNodes,fImageLib.Count);
 try
  LoadTree(ChangeFileExt(AFileName,'.TRE'));
 except
  acSaveTree.Enabled:=True;
 end;
 acAddImage.Enabled:=True;
 acDelImage.Enabled:=TreeView.Items.Count>0{ImageLib.Count>0};
 if TreeView.Items.Count>0 then exit;
 for i:=0 to ImageLib.Count-1 do
  if not ImageLib.Deleted(i) then begin
   node:=TreeView.Items.AddChild(nil,IntToStr(i));
   fNodes[i]:=node;
   node.ImageIndex:=IMAGE_INDEX;
   node.SelectedIndex:=IMAGE_INDEX;
   new(def);
   def.Index:=i;
   def.Origin:=Point(0,0);
   node.Data:=def;
  end;
end;

procedure TImageTree.acSaveImagesAccept(Sender: TObject);
var
 s:string;
 m:TMemoryStream;
begin
 s:=acSaveImages.Dialog.FileName;
 if ImageLib.Empty then
  CreateEmptyLib(s)
 else begin
  m:=TMemoryStream.Create;
  try
   ImageLib.Close;
   m.LoadFromFile(ImageLib.FileName);
   m.SaveToFile(s);
   SaveTree(ChangeFileExt(s,'.TRE'));
  finally
   m.Free;
  end;
 end;
 OpenLib(s);
end;

procedure TImageTree.acOpenImagesAccept(Sender: TObject);
begin
 OpenLib(OpenFileName(acOpenImages.Dialog));
end;

procedure TImageTree.acAddImageAccept(Sender: TObject);
begin
 ImportBitmap(Self,acAddImage.Dialog);
 acDelImage.Enabled:=TreeView.Items.Count>0{ImageLib.Count>0};
 acSaveTree.Enabled:=True;
end;

procedure TImageTree.AddDIB(node:TTreeNode; AName:string; const Palette:TPalette32; TransparentColor,Width,Height:integer; DIB:pointer; const AOrg:TPoint);
var
 PalIndex:integer;
 tc:cardinal;
 cl:integer;
 pitch:integer;
 def:PImageDef;

 procedure checkColor;
 var
  x,y:integer;
  p:pchar;
 begin
  p:=DIB;
  for y:=0 to height-1 do
   for x:=0 to width-1 do begin
    if ord(p[x+y*pitch])=cl then exit;
   end;
  cl:=ord(p[0])
 end;

begin
 while (node<>nil)and(node.data<>nil) do node:=node.Parent;
 node:=TreeView.Items.AddChild(node,AName);
 node.ImageIndex:=IMAGE_INDEX;
 node.SelectedIndex:=IMAGE_INDEX;
 PalIndex:=ImageLib.AddPalette(Palette);
 tc:=bgr(TransparentColor and $FFFFFF);
 cl:=255; while (cl>=0)and(Palette[cl] and $FFFFFF<>tc) do dec(cl);
 if cl<0 then cl:=byte(DIB^);
// dimensions de l'images
 pitch:=(Width+3) and (not 3);
// v閞ification de la couleur de transparence
 checkColor;
// cr閑r la r閒閞ence
 new(def);
 def.Index:=ImageLib.AddImage(DIB,Width,Height,pitch,PalIndex,cl);
 def.Origin:=AOrg;
// dans le noeud
 node.Data:=def;
 acSaveTree.Enabled:=True;
end;

procedure TImageTree.AddBitmap(node:TTreeNode; AName:string; ABitmap:TBitmap; const AOrg:TPoint);
var
 def :PImageDef;
 Colors:TPalette32;
 palette:integer;
 tc:cardinal;
 cl:integer;
 w,h,pitch:integer;
begin
 if ABitmap.PixelFormat<>pf8bit then exit;
//
 while (node<>nil)and(node.data<>nil) do node:=node.Parent;
 node:=TreeView.Items.AddChild(node,AName);
 node.ImageIndex:=IMAGE_INDEX;
 node.SelectedIndex:=IMAGE_INDEX;
// ajouter la palette
 GetPaletteEntries(ABitmap.Palette,0,256,Colors);
 for w:=0 to 255 do colors[w]:=bgr(colors[w]);
 Palette:=ImageLib.AddPalette(Colors);
// trouver la couleur transparente
 tc:=bgr(ABitmap.TransparentColor and $FFFFFF);
 cl:=0; while (cl<255)and(colors[cl] and $FFFFFF<>tc) do inc(cl);
// dimensions de l'images
 w:=ABitmap.Width;
 h:=ABitmap.Height;
 pitch:=(w+3) and (not 3);
// cr閑r la r閒閞ence
 new(def);
 def.Index:=ImageLib.AddImage(ABitmap.ScanLine[h-1],w,h,pitch,palette,cl);
 def.Origin:=AOrg;
 SetLength(fNodes,Length(fNodes)+1);
 fNodes[def.Index]:=node;
// dans le noeud
 node.Data:=def;
 acSaveTree.Enabled:=True;
end;

function NoSubFolder(Node:TTreeNode):boolean;
var
 i:integer;
begin
 for i:=0 to Node.Count-1 do begin
  if Node.Item[i].Data=nil then begin
   Result:=False;
   exit;
  end;
 end;
 Result:=True;
end;

procedure TImageTree.TreeViewChange(Sender: TObject; Node: TTreeNode);
var
 def:PImageDef;
 bmp:TBitmap;
 w,h:integer;
begin
 Image1.Picture:=nil;
 if node=nil then begin
  acAnim.Enabled:=False;
  exit;
 end;
 def:=node.data;
 if def=nil then begin
  acAnim.Enabled:=NoSubFolder(node);
  exit;
 end;
 acAnim.Enabled:=False;
 with ImageLib.Size[def.Index] do begin
  w:=x;
  h:=y;
 end;
 if (w=0)or(h=0) then exit;
 bmp:=ImageLib.GetBitmap(def.Index);
 Image1.Picture.Assign(bmp);
 bmp.Free;
end;

procedure TImageTree.RecursiveDelNode(Node:TTreeNode);
var
 i:integer;
 def:PImageDef;
begin
 for i:=Node.Count-1 downto 0 do RecursiveDelNode(Node.Item[i]);
 def:=Node.data;
 if def<>nil then begin
  ImageLib.DelImage(def.Index);
  dispose(def);
 end; 
 Node.Free;
end;

procedure TImageTree.acDelImageExecute(Sender: TObject);
var
 node:TTreeNode;
 def:PImageDef;
begin
 node:=TreeView.Selected;
 if (node=nil) then exit;
 if (node.data=nil) then begin
  if node.Count>0 then
   if MessageDlg('Voulez-vous supprimer TOUTES les images de ce dossier ?',mtConfirmation,[mbYes,mbNo],0)<>mrYes then exit;
  RecursiveDelNode(node);
 end else begin
  if MessageDlg('Voulez-vous supprimer cette image ?',mtConfirmation,[mbYEs,mbNo],0)<>mrYes then exit;
  def:=node.data;
  ImageLib.DelImage(def.Index);
  dispose(def);
  node.free;
 end;
 acSaveTree.Enabled:=True;
end;

procedure TImageTree.acNewFolderExecute(Sender: TObject);
var
 node:TTreeNode;
begin
 if ImageLib.FileName='' then exit;
 node:=TreeView.Selected;
 while (node<>nil)and(node.data<>nil) do node:=node.Parent;
 node:=NewFolder(node,'Nouveau dossier');
 node.Selected:=True;
 SaveTree(ChangeFileExt(ImageLib.FileName,'.TRE'));
 node.EditText;
end;

function TImageTree.ParentFolder(Node:TTreeNode):TTreeNode;
begin
 Result:=Node;
 while (Result<>nil)and(Result.Data<>nil) do Result:=Result.Parent;
end;

procedure TImageTree.TreeViewDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
 Accept:=(Source=TreeView)and(TreeView.DropTarget<>nil){and(TreeView.DropTarget.Data=nil)};
end;

procedure TImageTree.TreeViewDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
 n1,n2:TTreeNode;
 exp:boolean;
begin
 n1:=TreeView.Selected;
 n2:=ParentFolder(TreeView.DropTarget);
 if n2<>nil then exp:=n2.Expanded else exp:=false; { avoid warning... }
 TreeView.Selected:=nil;
 n1.MoveTo(n2,naAddChild);
 if n2<>nil then n2.Expanded:=exp;
 acSaveTree.Enabled:=True;
end;

procedure TImageTree.acSaveTreeExecute(Sender: TObject);
begin
 SaveTree(ChangeFileExt(ImageLib.FileName,'.TRE'));
 acSaveTree.Enabled:=False;
end;

procedure TImageTree.TreeViewEdited(Sender: TObject; Node: TTreeNode;
  var S: String);
begin
 acSaveTree.Enabled:=True;
end;

procedure TImageTree.acMoveUpExecute(Sender: TObject);
var
 node:TTreeNode;
begin
 node:=TreeView.Selected;
 if (node<>nil)and(node.Parent<>nil) then node.MoveTo(node.Parent,naAdd);
 acSaveTree.Enabled:=True;
end;

function TImageTree.NewFolder(Parent:TTreeNode; Caption:string):TTreeNode;
begin
 if Parent=nil then
  result:=TreeView.Items.Add(nil,Caption)
 else
  result:=TreeView.Items.AddChild(Parent,Caption);
 Result.ImageIndex:=CLOSED_FOLDER_INDEX;
 Result.SelectedIndex:=OPEN_FOLDER_INDEX;
end;

function TImageTree.GetNode(Image:TEditImage):TTreeNode;
var
 i:integer;
begin
 i:=Image.Data.Index;
 if i>=Length(fNodes) then raise Exception.Create('Probl鑝e sur GetNode()');
 Result:=fNodes[i];
end;

function TImageTree.ImageDef(Image:TEditImage):PImageDef;
begin
 Result:=GetNode(Image).Data;
end;

function TImageTree.ImageName(Image:TEditImage):string;
var
 i:integer;
 n:TTreeNode;
begin
 i:=Image.Data.Index;
 if i<Length(fNodes) then begin
  n:=fNodes[i];
  if (n<>nil)and(n.data<>nil) then begin
   result:=n.Text;
   exit;
  end;
 end;
 result:='#'+IntToStr(i);
end;

function TImageTree.ImageOrg(Image:TEditImage):TPoint;
var
 i:integer;
 n:TTreeNode;
 d:PImageDef;
begin
 i:=Image.Data.Index;
 if i<Length(fNodes) then begin
  n:=fNodes[i];
  if (n<>nil)and(n.data<>nil) then begin
   d:=n.Data;
   result:=d.Origin;
   exit;
  end;
 end;
 result.x:=0;
 result.y:=0;
end;

procedure TImageTree.Select(index:integer);
begin
 fNodes[index].Selected:=True;
end;

procedure TImageTree.acAnimExecute(Sender: TObject);
var
 node:TTreeNode;
begin
 node:=ParentFolder(TreeView.Selected);
 if node=nil then exit;
 if node.ImageIndex=CLIP_INDEX then begin
  node.ImageIndex:=CLOSED_FOLDER_INDEX;
  node.SelectedIndex:=OPEN_FOLDER_INDEX;
 end else begin
  node.ImageIndex:=CLIP_INDEX;
  node.SelectedIndex:=CLIP_INDEX;
 end;
end;

procedure TImageTree.TreeViewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if (Key=VK_F2)and(TreeView.Selected<>nil) then TreeView.Selected.EditText;
end;

end.