objedit.pas

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

unit ObjEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, ExtCtrls, Buttons, StdCtrls, Spin, HUtil32;

type
  TPieceInfo = packed record
    rx: integer;
    ry: integer;
    bkimg: integer; //-1:none
    img: integer;   //-1:none
    aniframe: byte;  //0捞惑捞搁 俊聪皋捞记 凳
    anitick: byte;   //
    blend: Boolean;
    light: byte;   //蝴狼 灌扁
    doorindex: byte;   //巩阑 侥喊窍扁困窃 0焊促 农搁 巩.  $80捞搁 巩阑 凯荐 乐绰 镑
    dooroffset: byte;  //摧囚柳 弊覆阑 侥喊窍扁 困窃
    mark: byte;  //0: none, 1:Bk, 2:Fr, 3:Bk & Fr
  end;
  PTPieceInfo = ^TPieceInfo;

  TFrmObjEdit = class(TForm)
    Pbox: TPaintBox;
    DetailGrid: TDrawGrid;
    Panel1: TPanel;
    BtnView: TSpeedButton;
    Panel2: TPanel;
    BtnOk: TBitBtn;
    BtnClear: TBitBtn;
    BitBtn1: TBitBtn;
    BtnMark1: TSpeedButton;
    BtnMark2: TSpeedButton;
    BtnTile: TSpeedButton;
    BObj: TSpeedButton;
    BTile: TSpeedButton;
    Panel3: TPanel;
    Label2: TLabel;
    SeAniFrame: TSpinEdit;
    Label3: TLabel;
    SeAniTick: TSpinEdit;
    CkAlpha: TCheckBox;
    Panel4: TPanel;
    BtnLeft: TSpeedButton;
    BtnUp: TSpeedButton;
    BtnDown: TSpeedButton;
    BtnRight: TSpeedButton;
    CkViewMark: TCheckBox;
    BDoor: TSpeedButton;
    BLight: TSpeedButton;
    Label4: TLabel;
    SeLight: TSpinEdit;
    Label5: TLabel;
    SeDoor: TSpinEdit;
    Label1: TLabel;
    Label6: TLabel;
    SeDoorOffset: TSpinEdit;
    CkViewLineNumber: TCheckBox;
    BDoorCore: TSpeedButton;
    BtnDoorTest: TSpeedButton;
    CbWilIndexList: TComboBox;
    Label7: TLabel;
    LabelIndex: TLabel;
    procedure DetailGridDrawCell(Sender: TObject; Col, Row: Longint;
      Rect: TRect; State: TGridDrawState);
    procedure PboxPaint(Sender: TObject);
    procedure PboxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PboxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PboxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BtnClearClick(Sender: TObject);
    procedure BtnLeftClick(Sender: TObject);
    procedure BtnUpClick(Sender: TObject);
    procedure BtnDownClick(Sender: TObject);
    procedure BtnRightClick(Sender: TObject);
    procedure BtnTileClick(Sender: TObject);
    procedure DetailGridClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CkViewMarkClick(Sender: TObject);
    procedure BtnDoorTestClick(Sender: TObject);
    procedure CbWilIndexListChange(Sender: TObject);
  private
    BoxVisible: Boolean;
    BoxX, BoxY, BoxWidth, BoxHeight: integer;
    PieceList: TList;
    starttime: integer;
    ObjWilIndex: integer;
    procedure AddPiece (x, y, bkimg, img, mark: integer);
    procedure AddLight (x, y, light: integer);
    procedure AddDoor (x, y, doorindex, dooroffset: integer; core: Boolean);
    function  GetPiece (x, y: integer): PTPieceInfo;
    procedure DelPiece (x, y: integer);
    procedure ShiftPieces (dir: integer);
    procedure ClearPiece;
    procedure DrawPiece (paper: TCanvas; x, y: integer);
    procedure GetRelPos (x, y: integer; var rx, ry: integer);
    procedure DrawCursor (xx, yy: integer);
    function  GetCurrentIndex: integer;
    procedure InitAniFrame;
    procedure AddAnimationUtitily;
  public
    function  Execute: Boolean;
    procedure SetPieceList (plist: TList);
    procedure DuplicatePieceList (plist: TList);
  end;

var
  FrmObjEdit: TFrmObjEdit;

implementation

uses edmain, SmTile, Tile;

{$R *.DFM}

procedure TFrmObjEdit.FormCreate(Sender: TObject);
var
  i:integer;
begin
   starttime := GetCurrentTime;
   BoxVisible := FALSE;
   BoxX := 0;
   BoxY := 0;
   PieceList := TList.Create;
   CbWilIndexList.ItemIndex := 0;
   ObjWilIndex := 0;
   for i:=0 to WIlcount-1 do
   Begin
     CbWilIndexList.Items.Add(format('objects%d.wil',[i+9]));
   end;
end;

procedure TFrmObjEdit.FormDestroy(Sender: TObject);
begin
   PieceList.Free;
end;

procedure TFrmObjEdit.FormShow(Sender: TObject);
var
   n: integer;
begin
   n := _MIN(65535, FrmMain.ObjWil(ObjWilIndex*65535).ImageCount);
//   n := FrmMain.ObjWil(ObjWilIndex*65535).ImageCount;
   if n >= 1 then DetailGrid.ColCount := n
   else DetailGrid.ColCount := 1;
   FrmTile.Show;
   FrmTile.Parent := self;
   FrmTile.Left := 80;
   FrmTile.Top  := 30;
end;

procedure TFrmObjEdit.CbWilIndexListChange(Sender: TObject);
var
   n: integer;
begin
   n := CbWilIndexList.ItemIndex;
   if n in [0..MAXWIL-1] then

   begin
      ObjWilIndex := n;
      FormShow (self);
   end;
end;

function TFrmObjEdit.Execute: Boolean;
begin
   starttime := GetCurrentTime;
   InitAniFrame;
   if mrOk = ShowModal then begin
      AddAnimationUtitily;  //俊聪皋捞记 矫难具 窍绰 巴 利侩
      Result := TRUE;
   end else Result := FALSE;
end;

procedure TFrmObjEdit.SetPieceList (plist: TList);
var
   i: integer;
   p: PTPieceInfo;
begin
   ClearPiece;
   if plist <> nil then begin
      for i:=0 to plist.Count-1 do begin
         new (p);
         p^ := PTPieceInfo (plist[i])^;
         PieceList.Add (p);
      end;
   end;
end;

procedure TFrmObjEdit.InitAniFrame;
var
   aniframe, anitick: integer;
   blend: Boolean;
begin
   if PieceList.Count > 0 then begin
      aniframe := PTPieceInfo (PieceList[0]).aniframe;
      anitick := PTPieceInfo (PieceList[0]).anitick;
      blend := PTPieceInfo (PieceList[0]).blend;
   end else begin
      aniframe := 0;
      anitick := 0;
      blend := FALSE;
   end;
   SeAniFrame.Value := aniframe;
   SeAniTick.Value := anitick;
   CkAlpha.Checked := blend;
end;

procedure TFrmObjEdit.AddAnimationUtitily;
var
   i, aniframe, anitick: integer;
   blend: Boolean;
   p: PTPieceInfo;
begin
   try
      aniframe := SeAniFrame.Value;
      anitick := SeAniTick.Value;
      if aniframe > 0 then blend := CkAlpha.Checked
      else blend := FALSE;
   except
      aniframe := 0;
      anitick := 0;
      blend := FALSE;
   end;
   if aniframe >= 0 then begin
      for i:=0 to PieceList.Count-1 do begin
         p := PTPieceInfo (PieceList[i]);
         p.aniframe := aniframe;
         p.anitick := anitick;
         p.blend := blend;
      end;

   end;
end;

procedure TFrmObjEdit.DuplicatePieceList (plist: TList);
var
   i: integer;
   p: PTPieceInfo;
begin
   for i:=0 to PieceList.Count-1 do begin
      new (p);
      p^ := PTPieceInfo (PieceList[i])^;
      plist.Add (p);
   end;
end;


{ PieceList }

{img : -2 (not apply), mark -2 (not apply)}
procedure TFrmObjEdit.AddPiece (x, y, bkimg, img, mark: integer);
var
   i, n, m: integer;
   p: PTPieceInfo;
begin
   if (img = -1) or (bkimg = -1) then exit;
   n := -1;
   for i:=0 to PieceList.Count-1 do begin
      p := PTPieceInfo (PieceList[i]);
      if (p.rx = x) and (p.ry = y) then begin
         if img <> -2 then p.img := img;
         if bkimg <> -2 then p.bkimg := bkimg;
         if mark <> -2 then p.mark := p.mark xor mark;
         exit;
      end;
      if p.ry > y then begin
         n := i;
         break;
      end;
   end;
   new (p);
   FillChar (p^, sizeof(TPieceInfo), 0);
   p.bkimg := -1;
   p.img := -1;
   p.rx := x;
   p.ry := y;
   if bkimg <> -2 then p.bkimg := bkimg
   else p.bkimg := -1;
   if img <> -2 then p.img := img
   else p.img := -1;
   if mark <> -2 then p.mark := mark
   else p.mark := 0;
   if n = -1 then PieceList.Add (p)
   else PieceList.Insert (n, p);
end;

procedure TFrmObjEdit.AddLight (x, y, light: integer);
var
   i, n, m: integer;
   p: PTPieceInfo;
begin
   if (light = -1) then exit;
   n := -1;
   for i:=0 to PieceList.Count-1 do begin
      p := PTPieceInfo (PieceList[i]);
      if (p.rx = x) and (p.ry = y) then begin
         p.light := light;
         exit;
      end;
      if p.ry > y then begin
         n := i;
         break;
      end;
   end;
   new (p);
   FillChar (p^, sizeof(TPieceInfo), 0);
   p.bkimg := -1;
   p.img := -1;
   p.rx := x;
   p.ry := y;
   p.light := light;
   if n = -1 then PieceList.Add (p)
   else PieceList.Insert (n, p);
end;

procedure TFrmObjEdit.AddDoor (x, y, doorindex, dooroffset: integer; core: Boolean);
var
   i, n, m: integer;
   p: PTPieceInfo;
begin
   if (doorindex = -1) or (dooroffset = -1) then exit;
   n := -1;
   for i:=0 to PieceList.Count-1 do begin
      p := PTPieceInfo (PieceList[i]);
      if (p.rx = x) and (p.ry = y) then begin
         if core then
            p.doorindex := $80 or p.doorindex //巩阑 咯绰 镑
         else p.doorindex := (p.doorindex and $80) or doorindex;
         p.dooroffset := dooroffset;
         exit;
      end;
      if p.ry > y then begin
         n := i;
         break;
      end;
   end;
   new (p);
   FillChar (p^, sizeof(TPieceInfo), 0);
   p.bkimg := -1;
   p.img := -1;
   p.rx := x;
   p.ry := y;
   if core then
      p.doorindex := $80 or doorindex
   else p.doorindex := doorindex;
   p.dooroffset := dooroffset;
   if n = -1 then PieceList.Add (p)
   else PieceList.Insert (n, p);
end;

function  TFrmObjEdit.GetPiece (x, y: integer): PTPieceInfo;
var
   i: integer;
   p: PTPieceInfo;
begin
   Result := nil;
   for i:=0 to PieceList.Count-1 do begin
      p := PTPieceInfo (PieceList[i]);
      if (p.rx = x) and (p.ry = y) then begin
         Result := p;
      end;
   end;
end;

procedure TFrmObjEdit.DelPiece (x, y: integer);
var
   i: integer;
   p: PTPieceInfo;
begin
   i := 0;
   while TRUE do begin