unit1.pas

游戏地图编辑器游戏地图编辑器游戏地图编辑器游戏地图编辑器

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, Menus, ComCtrls, ToolWin, ImgList, ExtCtrls, XPMan,
  jpeg;

const
  BitmapSize = 32;

  MaxMapWidth = 50;
  MaxMapHeight = 50;

  FileIdentifier = 'Map Editor Generated. Programed by Yang.';

type

  TObjectType = ( Floor, Wall, Door,  Lift);

  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N3: TMenuItem;
    MenuFileOpen: TMenuItem;
    MenuFileSave: TMenuItem;
    ImageList1: TImageList;
    N4: TMenuItem;
    MenuExit: TMenuItem;
    ControlBar1: TControlBar;
    ToolBar2: TToolBar;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ObjectImage: TImageList;
    Panel1: TPanel;
    ToolBar1: TToolBar;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    Panel2: TPanel;
    Panel3: TPanel;
    StatusBar1: TStatusBar;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    MenuFileNew: TMenuItem;
    N5: TMenuItem;
    MenuFloor: TMenuItem;
    MenuWall: TMenuItem;
    MenuDoor: TMenuItem;
    MenuLift: TMenuItem;
    OpenDialog1: TOpenDialog;
    ToolButton1: TToolButton;
    ToolButton5: TToolButton;
    ToolButton10: TToolButton;
    N2: TMenuItem;
    MenuInit: TMenuItem;
    ToolButton11: TToolButton;
    N6: TMenuItem;
    SaveDialog1: TSaveDialog;
    N7: TMenuItem;
    procedure MenuExitClick(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MenuFileNewClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MenuFloorClick(Sender: TObject);
    procedure MenuWallClick(Sender: TObject);
    procedure MenuDoorClick(Sender: TObject);
    procedure MenuLiftClick(Sender: TObject);
    procedure MenuFileOpenClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MenuFileSaveClick(Sender: TObject);
    procedure MenuInitClick(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
  private
    { Private declarations }
    Draging : boolean;
    ObjectType : TObjectType;

    InitX, InitY : integer; // 初始位置
    SettingInitPos : boolean; // 状态是否为设置初始位置

    CurX, CurY : integer; // 鼠标当前位置

    Map : array [ 0 .. MaxMapWidth + 1 , 0 .. MaxMapHeight + 1 ] of TObjectType;
    MapWidth, MapHeight : integer;
    MapFileName : string;
    FileSaved : boolean;

    procedure DrawObject(X, Y : integer; ObjectType : TObjectType);
    procedure OpenMapFile(FileName : String);
    procedure SaveMapFile(FileName : String);
    function WarningSave : boolean;
    procedure CreateNewFile(Width, Height : integer; FileName : string);
    procedure UpdateScene;
    procedure ShowInitPos(X, Y : integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure TForm1.DrawObject(X, Y : integer; ObjectType : TObjectType);
begin
  if ObjectType = door then
    if ( not (((Map[X-1, Y] = Floor) and (Map[X+1, Y] = Floor)
                and (Map[X, Y+1] = Wall) and (Map[X, Y-1] = Wall))
         or
              ((Map[X-1, Y] = Wall) and (Map[X+1, Y] = Wall)
                and (Map[X, Y+1] = Floor) and (Map[X, Y-1] = Floor))) ) then
    begin
      showmessage('此处不能放门！');
      if Map[X, Y] = Door then
      begin
        ObjectType := Floor;
        Map[X, Y] := Floor;
        ObjectImage.Draw(Image1.Canvas, (X - 1) * BitmapSize, (Y - 1) * BitmapSize, integer(ObjectType), True);
      end;
      exit;
    end;

  if ((ObjectType <> Floor ) and (InitX = X) and (InitY = Y)) then
  begin
    showmessage('初始位置只能是地板！');
    exit;
  end;

  Map[X, Y]:= ObjectType;
  ObjectImage.Draw(Image1.Canvas, (X - 1) * BitmapSize, (Y - 1) * BitmapSize, integer(ObjectType), True);
end;

procedure TForm1.CreateNewFile(Width, Height : integer; FileName : string);
  var i, j : integer;
begin
  MapFileName := FileName;
  Caption := FileName;
  MapWidth := Width;
  MapHeight := Height;

  for i:= 0 to MapWidth+1 do
    for j:= 0 to MapHeight+1 do
    begin
      Map[i, j]:= Wall;
    end;

  for i := 1 to MapWidth do
    for j := 1 to MapHeight do
    begin
      Map[i, j] := Floor;
    end;

  InitX := 1;
  InitY := 1;

  FileSaved := False;
  SettingInitPos := False;
  UpdateScene;
end;

procedure TForm1.OpenMapFile(FileName : string);
  var FileStr : TStringList;
      i, j : integer;
begin

try

  FileStr := TStringList.Create;
  FileStr.LoadFromFile(FileName);
  if (FileStr.Count=0) or (FileStr[0] <> FileIdentifier) then
  begin
    showmessage('不是地图文件！');
    exit;
  end;

  MapWidth := StrToInt( FileStr[2] ) - 2;
  MapHeight := StrToInt( FileStr[3] ) - 2;
  InitX := StrToInt( FileStr[4] );
  InitY := StrToInt( FileStr[5] );

  for i := 0 to MapHeight+1 do
    for j := 0 to MapWidth+1 do
    begin
      Map[j, i] := TObjectType(Ord(FileStr[i + 7] [ j + 1 ]) - Ord('0'));
    end;

  FileSaved := True;
  MapFileName := FileName;
  Caption := FileName;

  UpdateScene;

finally
  FileStr.Free;
end;

end;

procedure TForm1.SaveMapFile(FileName : string);
  var FileStr : TStringList;
      TmpStr : String;
      i, j : integer;
begin
  FileStr := TStringList.Create;
  FileStr.Add(FileIdentifier);
  FileStr.Add(' ');
  FileStr.Add(IntToStr(MapWidth+2));
  FileStr.Add(IntToStr(MapHeight+2));
  FileStr.Add(IntToStr(InitX));
  FileStr.Add(IntToStr(InitY));
  FileStr.Add(' ');

  for i:= 0 to MapHeight+1 do
  begin
    TmpStr := '';
    for j:= 0 to MapWidth+1 do
    begin
      TmpStr := TmpStr + IntToStr(integer(Map[j, i]));
    end;
    FileStr.Add(TmpStr);
  end;

  FileStr.SaveToFile(FileName);
  MapFileName := FileName;
  Caption := FileName;
  FileSaved := True;
  FileStr.Free;
end;

function TForm1.WarningSave : boolean;
begin
  Result := False;

  if MessageDlg('文件' + MapFileName + '尚未保存，现在保存吗?',
    mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    SaveMapFile(MapFileName);
    Result := True;
  end;
end;

procedure TForm1.UpdateScene;
  var i, j : integer;
begin
  Image1.Width := MapWidth * BitmapSize;
  Image1.Height := MapHeight * BitmapSize;

  for i:= 1 to MapWidth do
    for j:= 1 to MapHeight do
    begin
      DrawObject(i, j, Map[i, j]);
    end;

  ShowInitPos(InitX, InitY);

  Image1.Refresh;
end;

procedure TForm1.ShowInitPos(X, Y : integer);
begin
  if Map[X, Y] <> Floor then
  begin
    showmessage('初始位置不能设在此处！');
    exit;
  end;

  DrawObject(InitX, InitY, Map[InitX, InitY]);
  InitX := X;
  InitY := Y;
  ObjectImage.Draw(Image1.Canvas, (X-1)*BitmapSize, (Y-1)*BitmapSize, MenuInit.ImageIndex);
  Image1.Refresh;
end;

procedure TForm1.MenuExitClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if SettingInitPos then exit;

  Draging:=True;

end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var PosX, PosY : integer;
begin
  Draging:=False;
  FileSaved := False;
  PosX := X div BitmapSize + 1;
  PosY := Y div BitmapSize + 1;

  if SettingInitPos then
  begin
    ShowInitPos(PosX, PosY);
    exit;
  end;

  if (Map[PosX, PosY] <> ObjectType) then
  begin
    DrawObject(PosX, PosY, ObjectType);
    Image1.Refresh;
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var PosX, PosY : integer;
begin
  if SettingInitPos then exit;
  PosX := X div BitmapSize + 1;
  PosY := Y div BitmapSize + 1;
  StatusBar1.Panels[1].Text := '  ' + IntToStr(PosX) + ' : ' + intToStr(PosY);
  if (Draging and (Map[PosX, PosY] <> ObjectType))then
  begin
    DrawObject(PosX, PosY, ObjectType);
    Image1.Refresh;
  end;
end;

procedure TForm1.MenuFileNewClick(Sender: TObject);
begin
  if Form2.ShowModal = mrOK  then
    CreateNewFile(Form2.SpinEdit1.Value, Form2.SpinEdit2.Value, Form2.Edit1.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ObjectType := Wall;

  if not FileExists('demo1.map') then
    CreateNewFile(20, 15, 'demo1.map')
  else
    OpenMapFile('demo1.map');
  FileSaved := True;
end;

procedure TForm1.MenuFloorClick(Sender: TObject);
begin
  ObjectType := Floor;
  SettingInitPos := False;
end;

procedure TForm1.MenuWallClick(Sender: TObject);
begin
  ObjectType := Wall;
  SettingInitPos := False;
end;

procedure TForm1.MenuDoorClick(Sender: TObject);
begin
  ObjectType := Door;
  SettingInitPos := False;
end;

procedure TForm1.MenuLiftClick(Sender: TObject);
begin
  ObjectType := Lift;
  SettingInitPos := False;
end;

procedure TForm1.MenuFileOpenClick(Sender: TObject);
begin
  if not FileSaved then
    WarningSave;
  if OpenDialog1.Execute then
    OpenMapFile(OpenDialog1.FileName);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Not FileSaved then
    WarningSave;
end;

procedure TForm1.MenuFileSaveClick(Sender: TObject);
begin
  SaveMapFile(MapFileName);
end;

procedure TForm1.MenuInitClick(Sender: TObject);
begin
  SettingInitPos := not SettingInitPos;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    SaveMapFile(SaveDialog1.FileName);
end;

procedure TForm1.N7Click(Sender: TObject);
begin
  Form3.ShowModal;
end;

end.