isomap1.pas

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

unit IsoMap1;

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

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

}

interface
{-$define FPS}
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MapFrames, ExtCtrls, ComCtrls, ToolWin, ImgList, Menus,
  StdActns, ActnList, StdCtrls, ADKImages, ImageTrees, DXError, EditMaps,
  CheckLst;

type
  TCopyPast=record
   Index,x,y:integer;
  end;

  TMainForm = class(TForm)
    ActionList1: TActionList;
    acShowGrid: TAction;
    acResetFPS: TAction;
    acFileOpen: TFileOpen;
    FileExit1: TFileExit;
    acImportMA2: TFileOpen;
    acNew: TAction;
    acShowText: TAction;
    acShowCurrent: TAction;
    acShowActive: TAction;
    FileSave: TAction;
    FileSaveAs1: TFileSaveAs;
    acShowSelection: TAction;
    acShowObjects: TAction;
    FileSaveAs2: TFileSaveAs;
    MainMenu1: TMainMenu;
    Fichier1: TMenuItem;
    Nouveau1: TMenuItem;
    Ouvrir1: TMenuItem;
    Enregistrer1: TMenuItem;
    Enregistrersous1: TMenuItem;
    ReOpen: TMenuItem;
    Enregistrerlesimagessous1: TMenuItem;
    N1: TMenuItem;
    Importer1: TMenuItem;
    N3: TMenuItem;
    Quitter1: TMenuItem;
    Edition1: TMenuItem;
    miMapProps: TMenuItem;
    Afficher1: TMenuItem;
    ShowGrid: TMenuItem;
    Afficherlesobjets1: TMenuItem;
    Minivue1: TMenuItem;
    N4: TMenuItem;
    Affichertout1: TMenuItem;
    Cachertout1: TMenuItem;
    N2: TMenuItem;
    AboutIsoMapper1: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet3: TTabSheet;
    MapFrame1: TMapFrame;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton3: TToolButton;
    ToolButton7: TToolButton;
    ToolButton4: TToolButton;
    ToolButton2: TToolButton;
    Label1: TLabel;
    StatusBar1: TStatusBar;
    ImageTree1: TImageTree;
    Splitter1: TSplitter;
    ToolButton14: TToolButton;
    acSaveAll: TAction;
    BibliothquedimageLBA1: TMenuItem;
    CarteADKMA21: TMenuItem;
    acImportLBA: TFileOpen;
    lbBack: TListBox;
    ToolBar2: TToolBar;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    acListUp: TAction;
    acListDown: TAction;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    acListDel: TAction;
    acShowMiniMap: TAction;
    acBackground: TAction;
    acGrid: TAction;
    acObjects: TAction;
    acShowBack: TAction;
    Fond1: TMenuItem;
    Dslectionner1: TMenuItem;
    Panel1: TPanel;
    TabControl1: TTabControl;
    Terrain1: TMenuItem;
    N6: TMenuItem;
    outslectionner1: TMenuItem;
    Inverserslection1: TMenuItem;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    acImgProperties: TAction;
    TabSheet2: TTabSheet;
    clbSwitches: TCheckListBox;
    ToolBar3: TToolBar;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    acAddSwitch: TAction;
    acDelSwitch: TAction;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    N5: TMenuItem;
    Couleurdufond1: TMenuItem;
    ColorSelect1: TColorSelect;
    N7: TMenuItem;
    Copier1: TMenuItem;
    Coller1: TMenuItem;
    cbForeGroundSelect: TToolButton;
    Fusionnerunelibgraphique1: TMenuItem;
    acMergeLib: TFileOpen;
    procedure FormCreate(Sender: TObject);
    procedure acSaveAllExecute(Sender: TObject);
    procedure acImportLBAAccept(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure acImportMA2Accept(Sender: TObject);
    procedure MapFrame1PaintBox1Paint(Sender: TObject);
    procedure MapFrame1PaintBox1MouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MapFrame1PaintBox1MouseMove(Sender: TObject;
      Shift: TShiftState; X, Y: Integer);
    procedure acFileOpenAccept(Sender: TObject);
    procedure lbBackDblClick(Sender: TObject);
    procedure acListUpExecute(Sender: TObject);
    procedure acListDownExecute(Sender: TObject);
    procedure lbBackDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure lbBackDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure lbBackClick(Sender: TObject);
    procedure acListDelExecute(Sender: TObject);
    procedure FileSaveExecute(Sender: TObject);
    procedure MapFrame1PaintBox1DragOver(Sender, Source: TObject; X,
      Y: Integer; State: TDragState; var Accept: Boolean);
    procedure MapFrame1PaintBox1DragDrop(Sender, Source: TObject; X,
      Y: Integer);
    procedure lbBackData(Control: TWinControl; Index: Integer;
      var Data: String);
    procedure acShowMiniMapExecute(Sender: TObject);
    procedure acModesExecute(Sender: TObject);
    procedure miMapPropsClick(Sender: TObject);
    procedure acShowBackExecute(Sender: TObject);
    procedure Dslectionner1Click(Sender: TObject);
    procedure TabControl1Change(Sender: TObject);
    procedure Inverserslection1Click(Sender: TObject);
    procedure outslectionner1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FileSaveAs1Accept(Sender: TObject);
    procedure acImgPropertiesExecute(Sender: TObject);
    procedure acAddSwitchExecute(Sender: TObject);
    procedure clbSwitchesDblClick(Sender: TObject);
    procedure lbBackMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ColorSelect1Accept(Sender: TObject);
    procedure Copier1Click(Sender: TObject);
    procedure Coller1Click(Sender: TObject);
    procedure acNewExecute(Sender: TObject);
    procedure clbSwitchesData(Control: TWinControl; Index: Integer;
      var Data: String);
    procedure clbSwitchesClick(Sender: TObject);
  private
    { Private declarations }
    fSelected:TEditImage;
  {$ifdef FPS}
    fMegaFrames:integer;
    fStartTime:Cardinal;
  {$endif}
    fMapName:string;
    fBackground:TColor;
    fClipBoard:TList;
    fCopyX,fCopyY:integer;
    penYellow,penLime,penRed:THandle;
    procedure OnHint(Sender:TObject);
    procedure OnException(Sender:TObject; E:Exception);
    procedure ObstacleClick(Sender:TObject);
    procedure SetSelected(Value:TEditImage);
    procedure ClearSelection;
  public
    { Public declarations }
    property Selected:TEditImage read fSelected write SetSelected;
  end;

var
  MainForm: TMainForm;

implementation

uses ImportBitmaps, ADKUtils, CommonData, ImportLBAs, ImportMA2s,
  ImageProperties, MiniViews, MapProperties, ADKMaps, ADKScreens;

{$R *.dfm}

procedure ClearObjectList(List:TList);
var
 i:integer;
begin
 for i:=0 to List.Count-1 do TObject(List[i]).Free;
 List.Clear;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
 m:TMenuItem;
 o:TObstacle;
begin
 fClipBoard:=TList.Create;
 Application.OnHint:=OnHint;
 Application.OnException:=OnException;
 acImportLBA.Dialog.Filter:=LBAFilter+'|'+ALLFilter;
 acImportMA2.Dialog.Filter:=MA2Filter+'|'+ALLFilter;
 acFileOpen.Dialog.Filter :=ADKFilter+'|'+ALLFilter;
 acMergeLib.Dialog.Filter :=IMLFilter+'|'+ALLFilter;
 LoadDialog(acImportLBA.Dialog);
 LoadDialog(acImportMA2.Dialog);
 LoadDialog(acFileOpen.Dialog);
 LoadDialog(acMergeLib.Dialog);
 for o:=low(TObstacle) to High(TObstacle) do begin
  m:=NewItem(ObstacleNames[o],0,False, True, ObstacleClick,0,'');
  m.Tag:=ord(o);
  Terrain1.Add(m);
 end;
 penYellow:=CreatePen(PS_DOT,1,clYellow);
 penLime:=CreatePen(PS_DOT,1,clLime);
 penRed:=CreatePen(PS_SOLID,1,clRed);
end;

procedure TMainForm.OnException(Sender:TObject; E:Exception);
begin
//- if E is EDXError then CloseDX;
 Application.ShowException(E);
end;

procedure TMainForm.OnHint(Sender:TObject);
begin
 StatusBar1.Panels[2].Text:=getLongHint(Application.Hint);
end;

procedure TMainForm.ObstacleClick(Sender:TObject);
begin
 MapFrame1.SetObstacle(TObstacle(TComponent(Sender).Tag));
 MiniView.Redraw;
end;

procedure TMainForm.SetSelected(Value:TEditImage);
begin
// if fSelected<>nil then fSelected.Mask:=0;
 fSelected:=Value;
 if fSelected<>nil then fSelected.Mask:=$ff0000;
 if (ImageEditor<>nil) and ImageEditor.Visible then ImageEditor.Image:=fSelected;
end;

procedure TMainForm.ClearSelection;
var
 i:integer;
begin
 with MapFrame1.EditMap do begin
  for i:=0 to ImageCount-1 do Images[i].Mask:=0;
  for i:=0 to ItemCount-1 do Items[i].Mask:=0;
 end;
end;

procedure TMainForm.acSaveAllExecute(Sender: TObject);
begin
 ImageTree1.acSaveTree.Execute;
end;

procedure TMainForm.acImportLBAAccept(Sender: TObject);
begin
 LBAImport(OpenFileName(acImportLBA.Dialog),ImageTree1);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
 SaveDialog(acImportLBA.Dialog);
 SaveDialog(acImportMA2.Dialog);
 SaveDialog(acFileOpen.Dialog);
 SaveDialog(acMergeLib.Dialog);
 ClearObjectList(fClipBoard);
 fClipBoard.Free;
end;

procedure TMainForm.acImportMA2Accept(Sender: TObject);
begin
 fMapName:=MA2Import(OpenFileName(acImportMA2.Dialog));
 if fMapName='' then exit;
 MapFrame1.LoadFromFile(fMapName);
 lbBack.Count:=MapFrame1.EditMap.ImageCount+MapFrame1.EditMap.ItemCount;
end;

procedure TMainForm.MapFrame1PaintBox1Paint(Sender: TObject);
var
 x,y:integer;
 size:TPoint;
 dc:HDC;
 pen,oldpen:THandle;
 org:TPoint;
{$IFDEF FPS}
 StartDraw:Cardinal;
 i:integer;
{$ENDIF}
begin
 if ADKScreen=nil then exit;
{$IFDEF FPS}
 StartDraw:=GetTickCount;
{$ENDIF}
 MapFrame1.EditMap.ImageLib:=ImageTree1.ImageLib;
 //ClearDX(fBackground);
 ADKScreen.Clear(fBackground);
 MapFrame1.PaintBox1Paint(Sender);
 if (MapFrame1.Mode<>mmGrid)and(fSelected<>nil) then begin
  size:=ImageTree1.ImageLib.Size[fSelected.Data.Index];
  x:=fSelected.Data.Position.x+MapFrame1.ScrollX;
  y:=fSelected.Data.Position.y+MapFrame1.ScrollY;

  dc:=ADKScreen.GetDC;//GetDirectDC;
  try
   if ifForeground in fSelected.Data.Flags then pen:=penLime else pen:=penYellow;
   oldpen:=SelectObject(dc,pen);
   SetBkMode(dc,TRANSPARENT);
   MoveToEx(dc,x,y,nil);
   LineTo(dc,x+size.X,y);
   LineTo(dc,x+size.x,y+size.y);
   LineTo(dc,x,y+size.y);
   LineTo(dc,x,y);
   if ifForeground in fSelected.Data.Flags then begin
    inc(y,fSelected.Data.BaseLine);
    MoveToEx(dc,0,y,nil);
    LineTo(dc,MapFrame1.Width,y);
    dec(y,fSelected.Data.BaseLine);
   end;
   SelectObject(dc,oldpen);
   oldpen:=SelectObject(dc,penRed);
   org:=ImageTree1.ImageOrg(fSelected);
   inc(x,org.x);
   inc(y,org.y);
   MoveToEx(dc,x-4,y,nil); LineTo(dc,x+4,y);
   MoveToEx(dc,x,y-4,nil); LineTo(dc,x,y+4);
   SelectObject(dc,oldpen);
  finally
   //ReleaseDirectDC;
   ADKScreen.ReleaseDC;
  end;

 end;
 //SwapDX;
 ADKScreen.Flip;
{$IFDEF FPS}
 inc(fMegaFrames,1000);
 if fStartTime=0 then fStartTime:=GetTickCount;
 i:=GetTickCount;
 StatusBar1.Panels[0].Text:=IntToStr(fMegaFrames div (i-fStartTime+1))+' fps';
 StatusBar1.Panels[1].Text:=IntToStr(i-StartDraw)+' ms/frame';
 Application.ProcessMessages;
 if not (Application.Terminated) then InvalidateRect(MapFrame1.Handle,nil,False);
{$ENDIF}
end;

procedure TMainForm.MapFrame1PaintBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 i:integer;
begin
 FileSave.Enabled:=True;
 MapFrame1.PaintBox1MouseDown(Sender, Button, Shift, X, Y);
 if (Button=mbLeft) then begin
  if (MapFrame1.Mode=mmBack) then begin
   lbBack.Items.BeginUpdate;
   try
    if Shift * [ssShift, ssCtrl]=[] then begin
     ClearSelection;
     lbBack.ClearSelection;
    end;
    i:=MapFrame1.GetItemXY(cbForegroundSelect.Down);
    if i>=0 then lbBack.Selected[i]:=True;
    lbBack.ItemIndex:=i;
    lbBackClick(nil);
   finally
    lbBack.Items.EndUpdate;
   end;
   if i>=0 then exit;
  end;
  MapFrame1.Invalidate;
 end;
end;

procedure TMainForm.MapFrame1PaintBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
 p:TPoint;
 s:string;
begin
 MapFrame1.PaintBox1MouseMove(Sender, Shift, X, Y);
 if ssRight in Shift then MiniView.Invalidate;
 p:=MapFrame1.ScreenToGrid(x,y);
 if (p.x>=0)and(p.x<MapFrame1.EditMap.Width)
 and(p.y>=0)and(p.y<MapFrame1.EditMap.Height) then
  s:=ObstacleNames[MapFrame1.EditMap.Cells[p.x,p.y].Obstacle]
 else
  s:='out';
 StatusBar1.Panels[0].Text:=Format(
  '(%d,%d) %s',
  [p.x,p.y,s]
 );
end;

procedure TMainForm.acFileOpenAccept(Sender: TObject);
var
 i:integer;
begin