objset.pas

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

unit ObjSet;

interface

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

type
  TFrmObjSet = class(TForm)
    SetGrid: TDrawGrid;
    Panel1: TPanel;
    BtnSave: TSpeedButton;
    BtnLoad: TSpeedButton;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SetGridDblClick(Sender: TObject);
    procedure SetGridDrawCell(Sender: TObject; Col, Row: Longint;
      Rect: TRect; State: TGridDrawState);
    procedure BtnSaveClick(Sender: TObject);
    procedure BtnLoadClick(Sender: TObject);
    procedure SetGridClick(Sender: TObject);
    procedure SetGridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    SetList: TList;  // list of list
    Buffers: TList;
    procedure ClearSet;
    procedure GetSet (idx: integer; var plist: TList);
    procedure UpdateSet (idx: integer; plist: TList);
    procedure InsertSet (idx: integer; plist: TList);
    procedure CopySet (idx: integer);
    procedure PasteSet (idx: integer);
    procedure DelSet (idx: integer; delsolid: Boolean);
  public
    procedure InitializeObjSet;
    procedure Execute;
    function  GetCurrentSet: TList;
    procedure LoadFromFile (flname: string);
    procedure SaveToFile (flname: string);
  end;

var
  FrmObjSet: TFrmObjSet;
     SetType:Boolean;
implementation

uses edmain;

{$R *.DFM}


procedure TFrmObjSet.FormCreate(Sender: TObject);
begin
   SetList := TList.Create;
   Buffers := TList.Create;
end;

procedure TFrmObjSet.FormDestroy(Sender: TObject);
var
   i, j: integer;
   p: PTPieceInfo;
begin
   {for i:=0 to SetList.Count-1 do begin
      for j:=0 to TList (SetList[i]).Count-1 do begin
         p := PTPieceInfo (TList (SetList[i])[j]);
         Dispose (p);
      end;
      TList (SetList[i]).Free;
   end;
   SetList.Free;}
end;

procedure TFrmObjSet.InitializeObjSet;
begin
   LoadFromFile ('mir.set');
end;

procedure TFrmObjSet.ClearSet;
var
   i, j: integer;
   p: PTPieceInfo;
begin
   for i:=0 to SetList.Count-1 do begin
      for j:=0 to TList (SetList[i]).Count-1 do begin
         p := PTPieceInfo (TList (SetList[i])[j]);
         Dispose (p);
      end;
      TList (SetList[i]).Free;
   end;
   SetList.Clear;
end;
function Str_ToInt1 (Str: string; def: Longint): Longint;
var
  i,j,k:Longint;
begin
   if SetType then
   Begin
     Result:=Str_ToInt(str,def);
     Exit;
   End;
   Result := def;
   if Str <> '' then begin
      if ((word(Str[1]) >= word('0')) and (word(str[1]) <= word('9'))) or
         (str[1] = '+') or (str[1] = '-') then
         try
            k := StrToInt64 (Str);
            i:=k div 10000;
            j:=k mod 10000;
            Result:=i*65535+j;
         except
         end;
   end;
end;
procedure TFrmObjSet.LoadFromFile (flname: string);
var
   i, j: integer;
   slist: TStringList;
   plist: TList;
   p: PTPieceInfo;
   str, data: string;
begin
   SetType:=False;
   plist := nil;
   slist := TStringList.Create;
   if FileExists (flname) then
   begin
      ClearSet;
      slist.LoadFromFile (flname);
      for i:=0 to slist.Count-1 do
      begin
         str := Trim (slist[i]);
         if str='NEW' then
           SetType:=True;
         if (str <> '')  and (str<>'NEW') then
         begin
            if str[1] = '[' then
            begin
               if plist <> nil then
               begin
                  SetList.Add (plist);
               end;
               plist := TList.Create;
            end
            else
            begin
               if plist <> nil then
               begin
                  new (p);
                  FillChar(p^, sizeof(TPieceInfo), 0);
                  str := GetValidStr3 (str, data, [' ']);
                  p.rx := Str_ToInt1 (data, 0);
                  str := GetValidStr3 (str, data, [' ']);
                  p.ry := Str_ToInt1 (data, 0);
                  str := GetValidStr3 (str, data, [' ']);
                  p.bkimg := Str_ToInt1 (data, 0);
                  str := GetValidStr3 (str, data, [' ']);
                  p.img := Str_ToInt1 (data, 0);
                  str := GetValidStr3 (str, data, [' ']);
                  p.mark := Str_ToInt1 (data, 0);
                  str := GetValidStr3 (str, data, [' ']);
                  p.AniFrame := Str_ToInt1 (data, 0);
                  str := GetValidStr3 (str, data, [' ']);
                  p.AniTick := Str_ToInt1 (data, 0);
                  str := GetValidStr3 (str, data, [' ']);
                  if CompareText (data, 't') = 0 then
                     p.blend := TRUE
                  else p.blend := FALSE;
                  str := GetValidStr3 (str, data, [' ']);
                  p.light := Str_ToInt1 (data, 0);
                  str := GetValidStr3 (str, data, [' ']);
                  p.doorindex := Str_ToInt1 (data, 0);
                  str := GetValidStr3 (str, data, [' ']);
                  p.dooroffset := Str_ToInt1 (data, 0);
                  plist.Add (p);
               end;
            end;
         end;
      end;
   end;
   if plist <> nil then begin
      if plist.Count > 0 then
         SetList.Add (plist);
   end;
   slist.Free;
   SetGrid.RowCount := SetList.Count + 1;
end;

procedure TFrmObjSet.SaveToFile (flname: string);
var
   i, j: integer;
   slist: TStringList;
   plist: TList;
   blendstr: string;
   p: PTPieceInfo;
begin
   slist := TStringList.Create;
   SList.Add('NEW');
   for i:=0 to SetList.Count-1 do begin
      plist := SetList[i];
      if plist <> nil then begin
         slist.Add ('[' + IntToStr(i) + ']');
         for j:=0 to plist.Count-1 do begin
            p := PTPieceInfo (plist[j]);
            if p.blend then blendstr := 't'
            else blendstr := 'f';
            slist.Add (IntToStr (p.rx) + ' ' +
                       IntToStr (p.ry) + ' ' +
                       IntToStr (p.bkimg) + ' ' +
                       IntToStr (p.img) + ' ' +
                       IntToStr (p.mark) + ' ' +
                       IntToStr (p.AniFrame) + ' ' +
                       IntToStr (p.AniTick) + ' ' +
                       blendstr + ' ' +
                       IntToStr (p.light) + ' ' +
                       IntToStr(p.doorindex) + ' ' +
                       IntToStr (p.dooroffset) + ' ');
         end;
      end;
   end;
   slist.SaveToFile (flname);
   slist.Free;
end;

procedure TFrmObjSet.Execute;
begin
   Show;
end;

procedure TFrmObjSet.SetGridDrawCell(Sender: TObject; Col, Row: Longint;
  Rect: TRect; State: TGridDrawState);
var
   i, idx, nx, ny, dx, dy, tick: integer;
   plist: TList;
   p: PTPieceInfo;
   aniflag: Boolean;
begin
   aniflag := FALSE;
   idx := Row;
   if idx < SetList.Count then begin
      plist := SetList[idx];
      if plist <> nil then begin
         nx := SetGrid.DefaultColWidth div 2 - 12;
         ny := SetGrid.DefaultRowHeight div 2;
         for i:=0 to plist.Count-1 do begin
            p := PTPieceInfo (plist[i]);
            if p.bkimg >= 0 then begin
               dx := nx + p.rx * 12;
               dy := ny + p.ry * 8;
               with FrmMain.WilTiles do
                  DrawZoom (SetGrid.Canvas,
                            Rect.Left + dx,
                            Rect.Top + dy,
                            p.bkimg,
                            0.25);
            end;
         end;
      end;
   end;
   if idx < SetList.Count then begin
      plist := SetList[idx];
      if plist <> nil then begin
         nx := SetGrid.DefaultColWidth div 2 - 12;
         ny := SetGrid.DefaultRowHeight div 2 + 8;
         for i:=0 to plist.Count-1 do begin
            p := PTPieceInfo (plist[i]);
            if p.img >= 0 then begin
               if p.aniframe > 0 then begin
                  aniflag := TRUE;
                  tick := p.anitick;
               end;     
               dx := nx + p.rx * 12;
               dy := ny + p.ry * 8;
               with FrmMain.ObjWil(p.img) do
                  DrawZoomEx (SetGrid.Canvas,
                              Rect.Left + dx,
                              Rect.Top + dy,
                              p.img mod 65535,
                              0.25, FALSE);
            end;
         end;
      end;
      if aniflag then
         SetGrid.Canvas.TextOut (Rect.Left, Rect.Top, 'animation ' + IntToStr(p.anitick));
   end;
end;

procedure TFrmObjSet.GetSet (idx: integer; var plist: TList);
var
   i: integer;
begin
   plist := nil;
   if (idx >= 0) and (idx <= SetList.Count-1) then begin
      plist := SetList[idx];
   end;
end;

procedure TFrmObjSet.UpdateSet (idx: integer; plist: TList);
var
   i: integer;
   p: TList;
begin
   if idx <= SetList.Count-1 then begin
      p := SetList[idx];
      if p <> nil then begin
         for i:=0 to p.Count-1 do begin
            Dispose (PTPieceInfo (p[i]));
         end;
         p.Free;
      end;
      SetList.Delete (idx);
   end else begin
      idx := SetList.Count;
   end;
   SetList.Insert (idx, plist);
   SetGrid.RowCount := SetList.Count + 1;
end;

procedure TFrmObjSet.InsertSet (idx: integer; plist: TList);
begin
   SetList.Insert (idx, plist);
   SetGrid.RowCount := SetList.Count + 1;
end;

procedure TFrmObjSet.CopySet (idx: integer);
var
   i: integer;
   p: PTPieceInfo;
   plist: TList;
begin
   if idx < SetList.Count then begin
      for i:=0 to Buffers.Count-1 do
         Dispose(PTPieceInfo (Buffers[i]));
      Buffers.Clear;

      plist := TList (SetList[idx]);
      for i:=0 to plist.Count-1 do begin
         new (p);
         p^ := PTPieceInfo (plist[i])^;
         if Buffers = nil then Buffers := TList.Create;
         Buffers.Add (p);
      end;
   end;
end;

procedure TFrmObjSet.PasteSet (idx: integer);
var
   i: integer;
   p: PTPieceInfo;
   plist: TList;
begin
   if Buffers.Count <= 0 then exit;
   plist := TList.Create;
   for i:=0 to Buffers.Count-1 do begin
      new (p);
      p^ := PTPieceInfo (Buffers[i])^;
      plist.Add (p);
   end;
   SetList.Insert (idx, plist);
end;

procedure TFrmObjSet.DelSet (idx: integer; delsolid: Boolean);
var
   i: integer;
   p: TList;
begin
   if idx <= SetList.Count-1 then begin
      p := SetList[idx];
      if (p <> nil) and (delsolid) then begin
         for i:=0 to p.Count-1 do begin
            Dispose (PTPieceInfo (p[i]));
         end;
         p.Free;
         SetList.Delete (idx);
      end else begin
         if p = nil then
            SetList.Delete (idx);
      end;       
   end;
   SetGrid.RowCount := SetList.Count + 1;
end;


function  TFrmObjSet.GetCurrentSet: TList;
var
   plist: TList;
begin
   GetSet (SetGrid.Row, plist);
   Result := plist;
end;

procedure TFrmObjSet.SetGridDblClick (Sender: TObject);
var
   plist: TList;
begin
   GetSet (SetGrid.Row, plist);
   FrmObjEdit.SetPieceList (plist);
   if FrmObjEdit.Execute then begin
      plist := TList.Create;
      FrmObjEdit.DuplicatePieceList (plist);
      UpdateSet (SetGrid.Row, plist);
   end;
end;

procedure TFrmObjSet.BtnSaveClick(Sender: TObject);
begin
   with SaveDialog1 do begin
      FileName := '';
      if Execute then begin
         SaveToFile (FileName);
      end;
   end;
end;

procedure TFrmObjSet.BtnLoadClick(Sender: TObject);
begin
   with OpenDialog1 do begin
      FileName := '';
      if Execute then begin
         LoadFromFile (FileName);
      end;
   end;
end;

procedure TFrmObjSet.SetGridClick(Sender: TObject);
var
   plist: TList;
begin
   FrmMain.DrawMode := mdObjSet;
   plist := GetCurrentSet;
   FrmMain.MakeSetCursor (plist);
end;

procedure TFrmObjSet.SetGridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   case Key of
      VK_INSERT:
         begin
            if [ssCtrl] = Shift then begin
               CopySet (SetGrid.Row);
            end else begin
               if [ssShift] = Shift then begin
                  PasteSet (SetGrid.Row);
                  SetGrid.Refresh;
               end else begin
                  InsertSet (SetGrid.Row, nil);
                  SetGrid.Refresh;
               end;      
            end;
         end;
      VK_DELETE:
         begin
            if ssCtrl in Shift then DelSet (SetGrid.Row, TRUE)
            else DelSet (SetGrid.Row, FALSE);
            SetGrid.Refresh;
         end;
      VK_F5:
         FrmMain.MapPaint.Refresh;
      VK_RETURN:
         begin
            SetGridDblClick (self);
         end;
   end;
end;

end.