edmain.pas

传奇Map地图编辑源码 一个很不错的源码哦

unit EdMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, mpalett, Menus, ExtCtrls, HUtil32, WIL;

const
   MAXX = 1000;
   MAXY = 1000;
   UNITX = 48;
   UNITY = 32;
   HALFX = 24;
   HALFY = 16;
   UNITBLOCK = 50;
   MIDDLEBLOCK = 60;
   SEGX = 40;
   SEGY = 40;

   LIGHTSPOT = 57;
   BKMASK = 58;
   FRMASK = 59;

   MAXSET = 300;
   MAXWIL = 15;

   TITLEHEADER = 'Legend of mir';


type
  TMapPrjInfo = packed record
     Ident: string[15];
     ColCount: integer;
     RowCount: integer;
  end;

  TMapDrawMode = (mdTile, mdMiddle, mdTileDetail, mdObj, mdObjSet, mdLight, mdDoor);
  TMapBrush = (mbAuto, mbNormal, mbFill, mbFillAttrib, mbAttrib, mbEraser);
  TMapInfo =  record
      BkImg: word;
      MidImg: word;
      FrImg: word;
      DoorIndex: byte;  //$80 (巩娄), 巩狼 侥喊 牢郸胶
      DoorOffset: byte;  //摧腮 巩狼 弊覆狼 惑措 困摹, $80 (凯覆/摧塞(扁夯))
      AniFrame: byte;      //$80(捧疙)  橇贰烙 荐
      AniTick: byte;     //割锅俊 平付促 茄 橇贰烙究 框流捞绰啊
      Area: byte;        //Object.WIL 锅龋
      light: byte;       //0..1..4 堡盔 瓤苞
  end;
  PTMapInfo = ^TMapInfo;

  TMapHeader =packed record
     Width  : word;
     Height : word;
     Title: string[15];
     UpdateDate: TDateTime;
     Reserved  : array[0..23] of char;
  end;

  TFrmMain = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    New1: TMenuItem;
    Save1: TMenuItem;
    SaveAs1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Open1: TMenuItem;
    Palette1: TMenuItem;
    Tile1: TMenuItem;
    Object1: TMenuItem;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Label1: TLabel;
    ZoomIn: TSpeedButton;
    ZoomOut: TSpeedButton;
    LbXY: TLabel;
    ObjEdit1: TMenuItem;
    RunObjEditer1: TMenuItem;
    ObjectSet1: TMenuItem;
    LbMapName: TLabel;
    TileDetail1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Timer1: TTimer;
    NewSegmentMap1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    ClearEditSegments1: TMenuItem;
    BtnLeftSeg: TSpeedButton;
    BtnUpSeg: TSpeedButton;
    BtnDownSeg: TSpeedButton;
    BtnRightSeg: TSpeedButton;
    SpeedButton4: TSpeedButton;
    MainScroll: TScrollBox;
    MapPaint: TPaintBox;
    Option1: TMenuItem;
    ObjectViewNormalSize1: TMenuItem;
    SpeedButton5: TSpeedButton;
    SmallTile1: TMenuItem;
    WILTiles: TWMImages;
    WilSmTiles: TWMImages;
    WilObjects1: TWMImages;
    View1: TMenuItem;
    ShowBackgroundTile1: TMenuItem;
    ShowMiddleTile1: TMenuItem;
    ShowObject1: TMenuItem;
    ShowAttribMarks1: TMenuItem;
    N4: TMenuItem;
    MiddleTransparent1: TMenuItem;
    Tool1: TMenuItem;
    DrawBigTile1: TMenuItem;
    DrawObject1: TMenuItem;
    DrawObjectTileSet1: TMenuItem;
    DrawSmTile1: TMenuItem;
    SetLightEffect1: TMenuItem;
    UpdateDoor1: TMenuItem;
    Resize1: TMenuItem;
    N5: TMenuItem;
    SaveToBitmap1: TMenuItem;
    N6: TMenuItem;
    MapScroll1: TMenuItem;
    SpeedButton6: TSpeedButton;
    N7: TMenuItem;
    CellMove1: TMenuItem;
    WilObjects2: TWMImages;
    WilObjects3: TWMImages;
    WilObjects4: TWMImages;
    WilObjects5: TWMImages;
    WilObjects6: TWMImages;
    WilObjects7: TWMImages;
    OpenOldFormatFile1: TMenuItem;
    N8: TMenuItem;
    OldFromatBatchConvert1: TMenuItem;
    Label2: TLabel;
    N9: TMenuItem;
    N10: TMenuItem;
    WilObjects8: TWMImages;
    procedure FormCreate(Sender: TObject);
    procedure Tile1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure MapPaintMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MapPaintMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MapPaintMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MapPaintPaint(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure ZoomInClick(Sender: TObject);
    procedure ZoomOutClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Object1Click(Sender: TObject);
    procedure RunObjEditer1Click(Sender: TObject);
    procedure ObjectSet1Click(Sender: TObject);
    procedure TileDetail1Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BtnMarkClick(Sender: TObject);
    procedure NewSegmentMap1Click(Sender: TObject);
    procedure ClearEditSegments1Click(Sender: TObject);
    procedure BtnLeftSegClick(Sender: TObject);
    procedure BtnRightSegClick(Sender: TObject);
    procedure BtnUpSegClick(Sender: TObject);
    procedure BtnDownSegClick(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure ObjectViewNormalSize1Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SmallTile1Click(Sender: TObject);
    procedure ShowBackgroundTile1Click(Sender: TObject);
    procedure DrawObject1Click(Sender: TObject);
    procedure Resize1Click(Sender: TObject);
    procedure SaveToBitmap1Click(Sender: TObject);
    procedure MapScroll1Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure CellMove1Click(Sender: TObject);
    procedure OpenOldFormatFile1Click(Sender: TObject);
    procedure OldFromatBatchConvert1Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    RecusionCount: integer;
    FillIndex: integer;
    MArrUndo : array[0..MAXX+10, 0..MAXY+10] of TMapInfo;
    SetArr: array[0..MAXSET-1] of TRect;
    procedure ClearSetCursor;
    function  DrawSetCursor (xx, yy: integer): Boolean;
    procedure DrawCursor (xx, yy: integer);
    function  GetBk (x, y: integer): integer;
    function  GetFrMask (x, y: integer): integer;
    function  GetLightAddDoor (x, y: integer; var light, door, dooroffset: integer): Boolean;
    function  GetAni (x, y: integer): integer;
    procedure SetLight (x, y, value: integer);
    function  GetBkImg (x, y: integer): integer;
    function  GetMidImg (x, y: integer): integer;
    function  GetFrImg (x, y: integer): integer;
    procedure PutTileXY (x, y, idx: integer);
    procedure PutMiddleXY (x, y, idx: integer);
    function  GetBkImgUnit (x, y: integer): integer;
    function  GetBkUnit (x, y: integer): integer;
    procedure PutBigTileXY (x, y, idx: integer);
    procedure PutObjXY (x, y, idx: integer);
    function  DrawFill (xx, yy: integer; Shift: TShiftState): Boolean;
    function  DrawFillAttrib (xx, yy: integer; Shift: TShiftState): Boolean;
    procedure DrawTileDetail (x, y: integer; Shift: TShiftState);
    procedure DrawNormalTile (x, y: integer; Shift: TShiftState);
    procedure DrawAutoTile (x, y: integer; Shift: TShiftState);
    procedure DrawAutoMiddleTile (x, y: integer; Shift: TShiftState);
    procedure DrawEraser (xx, yy: integer; Shift: TShiftState);
    function  CheckCollision (xx, yy: integer): Boolean;
    procedure DrawObject (xx, yy: integer; Shift: TShiftState);
    procedure DrawObjectSet (xx, yy: integer; Shift: TShiftState);
    procedure AddLight (x, y: integer);
    procedure UpdateLight (x, y: integer);
    procedure UpdateDoor (x, y: integer);
    procedure DrawCellBk (x, y, w, h: integer);
    procedure DrawCellFr (x, y, w, h: integer);
    procedure DrawXorAttrib (x, y: integer; button: TMouseButton; Shift: TShiftState);
    function  IsMyUnit (x, y, munit, newidx: integer): Boolean;
    procedure DrawOne (x, y, munit, idx: integer);
    procedure DrawOneDr (x, y, munit, idx: integer);
    procedure DrawObjDr (x, y, idx: integer);
    procedure DrawOrAttr (x, y, mark: integer);
    function  GetPoint (idx: integer): integer;
    function  VerifyWork: Boolean;
    procedure LoadSegment (col, row: integer; flname: string);
    procedure SaveSegment (col, row: integer; flname: string);
  public
    MArr : array[0..MAXX+10, 0..MAXY+10] of TMapInfo;
    MapWidth, MapHeight: integer;
    CurX, CurY: integer;
    MainBrush: TMapBrush;
    ImageIndex, ImageDetail: integer;
    MiddleIndex: integer;
    TileAttrib: integer;
    DrawMode: TMapDrawMode;
    Zoom: Real;
    BoxVisible: Boolean;
    BoxX, BoxY, BoxWidth, BoxHeight: integer;
    CurrentMapName: string;
    Edited: Boolean;
    SegmentMode: Boolean;
    function  ObjWil(idx: integer): TWMImages;
    procedure CopyTemp;
    procedure Undo;
    procedure NewMap;
    function  LoadFromFile (flname: string): Boolean;
    function  SaveToFile (flname: string): Boolean;
    procedure MakeSetCursor (plist: TList);
    procedure DoEditSegment;
    procedure DoSaveSegments;
  end;

var
  FrmMain: TFrmMain;
  BaseDir: string;
  WilArr: Array[0..41] of TWMImages;
  WilCount:Integer;
implementation

uses FObj, ObjEdit, ObjSet, Tile, MapSize, segunit, SmTile, glight, DoorDlg,
  FScrlXY, MoveObj, about;

{$R *.DFM}

procedure TFrmMain.FormCreate(Sender: TObject);
var
  i:integer;
begin
   Zoom := 0.4;
   Label1.Caption := '100:' + IntToStr(Round(100 * Zoom));
   ImageIndex := 0;
   ImageDetail := 0;
   BoxVisible := FALSE;
   BoxX := 0;
   BoxY := 0;
   BoxWidth := 1;
   BoxHeight := 1;
   DrawMode := mdTile;
   CurrentMapName := '';
   Edited := FALSE;
   SegmentMode := FALSE;
   MapWidth := 200;
   MapHeight := 200;
   BaseDir := GetCurrentDir;

   ShowBackgroundTile1.Checked := TRUE;
   ShowMiddleTile1.Checked := TRUE;
   ShowObject1.Checked := TRUE;
   ShowAttribMarks1.Checked := FALSE;
   MiddleTransparent1.Checked := TRUE;

   WilTiles.Initialize;
   WilSmTiles.Initialize;
   WilObjects1.Initialize;
   WilObjects2.Initialize;
   WilObjects3.Initialize;
   WilObjects4.Initialize;
   WilObjects5.Initialize;
   WilObjects6.Initialize;
   WilObjects7.Initialize;
   WilObjects8.Initialize;
 {  WilObjects9.Initialize;
   WilObjects10.Initialize;
   WilObjects11.Initialize;
   WilObjects12.Initialize;
   WilObjects13.Initialize;
   WilObjects14.Initialize;
   WilObjects15.Initialize;
  }
   WilCount:=0;
   for i:=0 to 41 do
   Begin
     if FileExists('objects'+Inttostr(i+9)+'.wil') then
     Begin
        WilArr[i]:=TWMImages.Create(self);
        WilArr[i].LibType:=ltLoadBmp;
        WilArr[i].MaxMemorySize:=1024000;
        WilArr[i].FileName:='objects'+Inttostr(i+9)+'.wil';
        WilArr[i].Initialize;
        inc(WilCount);
     End
     else
       Break;

   End;
   NewMap;
end;

procedure TFrmMain.FormShow(Sender: TObject);
begin
   SpeedButton2Click (self);
   FrmMainPal.SetImageUnitCount ((WilTiles.ImageCount + UNITBLOCK-1) div UNITBLOCK);
   FrmSmTile.SetImageUnitCount ((WilSmTiles.ImageCount + MIDDLEBLOCK-1) div MIDDLEBLOCK);
   FrmObjSet.InitializeObjSet;
//   FrmMainPal.Show;
//   FrmObjSet.Execute;
end;

procedure TFrmMain.NewMap;
begin
   LbMapName.Caption := 'Untitled.map';
   if MapWidth < 0 then MapWidth := 1;
   if MapHeight < 0 then MapHeight := 1;
   FillChar (MArr, sizeof(MArr), #0);
   FillChar (MArrUndo, sizeof(MArrUndo), #0);
   MapPaint.Width := Round (MapWidth * UNITX * Zoom) + 1;
   MapPaint.Height := Round (MapHeight * UNITY * Zoom) + 1;
   CurX := 0;
   CurY := 0;
end;

function  TFrmMain.LoadFromFile (flname: string): Boolean;
var
   i, fhandle: integer;
   header: TMapHeader;
   str:string;

begin
   Result := FALSE;
   if not FileExists (flname) then exit;
   fhandle := FileOpen (flname, fmOpenRead or fmShareDenyNone);
   if fhandle > 0 then begin
      FillChar (MArr, sizeof(MArr), #0);
      FillChar (MArrUndo, sizeof(MArrUndo), #0);
      FileRead (fhandle, header, sizeof(TMapHeader));
      str:=Datetimetostr(Header.UpdateDate);
      //if header.Title = TITLEHEADER then begin
         if (header.Width > 0) and (header.Height > 0) then begin
            MapWidth  := header.Width;
            MapHeight := header.Height;
            for i:=0 to header.Width-1 do
               FileRead (fhandle, MArr[i,0], sizeof(TMapInfo) * MapHeight);

            Result := TRUE;