edmain.pas

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

function  TFrmMain.GetMidImg (x, y: integer): integer;
begin
   if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then begin
      Result := MArr[x, y].MidImg - 1;
   end;
end;

procedure TFrmMain.PutTileXY (x, y, idx: integer);
var
   bimg: integer;
begin
   if (x >= 0) and (x < MAXX) and (y >= 0) and (y < MAXY) then begin
      //if TileAttrib = 0 then bimg := idx
      //else bimg := $8000 or idx;
      bimg := (MArr[x, y].BkImg and $8000) + idx;
      MArr[x, y].BkImg := bimg;
   end;
end;

procedure TFrmMain.PutMiddleXY (x, y, idx: integer);
begin
   if (x >= 0) and (x < MAXX) and (y >= 0) and (y < MAXY) then begin
      MArr[x, y].MidImg := idx;
   end;
end;

function  TFrmMain.GetBkImgUnit (x, y: integer): integer;
begin
   if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then begin
      Result := ((MArr[x, y].BkImg and $7FFF) - 1) mod UNITBLOCK;
   end;
end;

function  TFrmMain.GetBkUnit (x, y: integer): integer;
begin
   if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then begin
      Result := ((MArr[x, y].BkImg and $7FFF) - 1) div UNITBLOCK;
   end;
end;

procedure TFrmMain.PutBigTileXY (x, y, idx: integer);
var
   bimg: integer;
begin
   if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then begin
      //if TileAttrib = 0 then bimg := idx
      //else bimg := $8000 or idx;
      bimg := (MArr[x, y].BkImg and $8000) + idx;
      MArr[x, y].BkImg := bimg;
      bimg := (MArr[x+1, y].BkImg and $8000) + idx;
      MArr[x+1, y].BkImg := bimg;
      bimg := (MArr[x, y+1].BkImg and $8000) + idx;
      MArr[x, y+1].BkImg := bimg;
      bimg := (MArr[x+1, y+1].BkImg and $8000) + idx;
      MArr[x+1, y+1].BkImg := bimg;
   end;
end;

procedure TFrmMain.PutObjXY (x, y, idx: integer);
var
   bimg: integer;
begin
   if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then begin
      bimg := (MArr[x, y].FrImg and $8000) + idx mod 65535;
      MArr[x, y].FrImg := bimg;
      MArr[x, y].Area := idx div 65535;
   end;
end;

function  TFrmMain.DrawFill (xx, yy: integer; Shift: TShiftState): Boolean;
var
   img, idx, un, drimg: integer;
begin
   if {(RecusionCount < 200000) and }(xx >= 0) and (yy >= 0) and (xx < MapWidth) and (yy < MapHeight) then begin
      Inc (RecusionCount);
      img := GetBkImg (xx, yy);
      idx := img mod UNITBLOCK;
      if img >= 0 then un  := img div UNITBLOCK
      else un := -1;
      if (un = FillIndex) and (((idx >= 0) and (idx < 5)) or (idx = 99) or (idx = -1)) then begin
         if un <> ImageIndex then begin
            DrawOneDr (xx, yy, ImageIndex, Random(5));
            DrawFill (xx - 2, yy, Shift);
            DrawFill (xx, yy - 2, Shift);
            DrawFill (xx + 2, yy, Shift);
            DrawFill (xx, yy + 2, Shift);
         end else begin
            Dec (RecusionCount);
            exit;
         end;
      end;
   end else begin
      Dec (RecusionCount);
      exit;
   end;
end;

function  TFrmMain.DrawFillAttrib (xx, yy: integer; Shift: TShiftState): Boolean;
var
   img, idx, un, drimg, attr: integer;
begin
   if (RecusionCount < 65535) and (xx >= 0) and (yy >= 0) and (xx < MapWidth) and (yy < MapHeight) then begin
      Inc (RecusionCount);
      if ssLeft in Shift then attr := MArr[xx, yy].BkImg and $8000;
      if ssRight in Shift then attr := MArr[xx, yy].FrImg and $8000;
      if (attr = 0) then begin
         if ssLeft in Shift then MArr[xx, yy].BkImg := MArr[xx, yy].BkImg or $8000;
         if ssRight in Shift then MArr[xx, yy].FrImg := MArr[xx, yy].FrImg or $8000;
         DrawFillAttrib (xx - 1, yy, Shift);
         DrawFillAttrib (xx, yy - 1, Shift);
         DrawFillAttrib (xx + 1, yy, Shift);
         DrawFillAttrib (xx, yy + 1, Shift);
      end else begin
         Dec (RecusionCount);
         exit;
      end;
   end else begin
      Dec (RecusionCount);
      exit;
   end;
end;

procedure TFrmMain.DrawEraser (xx, yy: integer; Shift: TShiftState);
var
   i, j, n: integer;
begin
   n := 0;
   if ssCtrl in Shift then n := 1;
   if ssShift in Shift then n := 10;
   if n > 0 then begin
      for i:=xx-n to xx+n do
         for j:=yy-n to yy+n do begin
            //MArr[i, j].BkImg := 0; //MArr[i, j].BkImg and $7FFF;
            if ssAlt in Shift then MArr[i, j].MidImg := 0
            else MArr[i, j].FrImg := 0;
            if ssCtrl in Shift then MArr[i, j].BkImg := MArr[i, j].BkImg and $7FFF;
            MArr[i, j].AniFrame := 0;
            MArr[i, j].AniTick := 0;
            MArr[i, j].DoorIndex := 0;
            MArr[i, j].DoorOffset := 0;
         end;
   end else begin
      //MArr[xx, yy].BkImg := 0; //MArr[xx, yy].BkImg and $7FFF;
      if ssAlt in Shift then MArr[xx, yy].MidImg := 0
      else MArr[xx, yy].FrImg := 0;
      MArr[xx, yy].AniFrame := 0;
      MArr[xx, yy].AniTick := 0;
      MArr[xx, yy].DoorIndex := 0;
      MArr[xx, yy].DoorOffset := 0;
   end;
end;

procedure TFrmMain.DrawObject (xx, yy: integer; Shift: TShiftState);
var
   idx: integer;
begin
   if ssAlt in Shift then begin
      DrawObjDr (xx, yy, -1);
   end else begin
      idx := FrmObj.GetCurrentIndex;
      if idx >= 0 then begin
         if ssCtrl in Shift then begin
            DrawObjDr (xx, yy, idx xor $8000);
         end else begin
            DrawObjDr (xx, yy, idx);
         end;
      end;
   end;
end;

function  TFrmMain.CheckCollision (xx, yy: integer): Boolean;
var
   n: integer;
begin
   if (xx >= 0) and (xx < MAXX-1) and (yy >= 0) and (yy < MAXY-1) then begin
      n := MArr[xx, yy].FrImg and $7FFF;
      if n > 0 then Result := TRUE
      else Result := FALSE;
   end else
      Result := FALSE;      
end;

procedure TFrmMain.DrawObjectSet (xx, yy: integer; Shift: TShiftState);
var
   i, ix, iy: integer;
   plist: TList;
   p: PTPieceInfo;
   flag: Boolean;
begin
   flag := TRUE;
   plist := FrmObjSet.GetCurrentSet;
   if plist <> nil then begin
      for i:=0 to plist.Count-1 do begin
         p := PTPieceInfo (plist[i]);
         if p.img >= 0 then
            if CheckCollision (xx + p.rx, yy + p.ry) then begin
               flag := FALSE;
               break;
            end;
      end;
      if flag then begin
         for i:=0 to plist.Count-1 do begin
            p := PTPieceInfo (plist[i]);
            if (p.rx+xx >= 0) and (p.ry+yy >= 0) then begin
               if p.bkimg >= 0 then begin
                  ix := xx div 2 * 2;
                  iy := yy div 2 * 2;
                  MArr[p.rx + ix, p.ry + iy].BkImg := p.bkimg + 1;
                  DrawCellBk (p.rx + ix, p.ry + iy, 1, 1);
               end;
               if p.img >= 0 then
                  DrawObjDr (xx + p.rx, yy + p.ry, p.img);
               if p.mark > 0 then
                  DrawORAttr (xx + p.rx, yy + p.ry, p.mark);
               if p.Blend then MArr[xx + p.rx, yy + p.ry].AniFrame := $80 or p.AniFrame
               else MArr[xx + p.rx, yy + p.ry].AniFrame := p.AniFrame;
               MArr[xx + p.rx, yy + p.ry].AniTick := p.AniTick;
               if p.light > 0 then
                  MArr[xx + p.rx, yy + p.ry].Light := p.light;
               if p.DoorIndex > 0 then begin
                  MArr[xx + p.rx, yy + p.ry].DoorIndex := p.DoorIndex;
                  MArr[xx + p.rx, yy + p.ry].DoorOffset := p.DoorOffset;
               end;
            end;
         end;
      end else
         Beep;
   end;
end;

procedure TFrmMain.AddLight (x, y: integer);
var
   n: integer;
begin
   if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then begin
      n := MArr[x, y].Light;
      n := FrmGetLight.GetValue (n);
      SetLight (x, y, n);
      DrawCellBk (x-1, y-1, 1, 1);
   end;
end;

procedure TFrmMain.UpdateLight (x, y: integer);
var
   n: integer;
begin
   if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then begin
      n := MArr[x, y].Light;
      if n > 0 then begin
         n := FrmGetLight.GetValue (n);
         MArr[x, y].Light := n;
         DrawCellBk (x-1, y-1, 1, 1);
      end else
         Beep;
   end;
end;

procedure TFrmMain.UpdateDoor (x, y: integer);
var
   idx, offs: integer;
begin
   if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then begin
      idx := MArr[x, y].DoorIndex;
      offs := MArr[x, y].DoorOffset;
      if FrmDoorDlg.Update (idx, offs) then begin
         MArr[x, y].DoorIndex := idx;
         MArr[x, y].DoorOffset := offs;
      end;
   end;
end;

function TFrmMain.GetPoint (idx: integer): integer;
begin
   Result := 0;
   if idx < 0 then exit;
   if idx <= 4 then begin Result := 6; exit; end;
   if idx <= 8 then begin Result := 1; exit; end;
   if idx <= 13 then begin Result := 5; exit; end;
   if idx <= 23 then begin Result := 4; exit; end;
   if idx <= 28 then Result := 2;
end;

function TFrmMain.IsMyUnit (x, y, munit, newidx: integer): Boolean;
var
   idx, uidx: integer;
begin
   Result := FALSE;
   idx := GetBkImg (x, y);
   if (idx <> 99) and (idx <> -1) then begin
      if munit = idx div UNITBLOCK then begin
         if GetPoint (idx mod UNITBLOCK) >= GetPoint(newidx) then
            Result := TRUE;
      end;
   end;
end;

procedure TFrmMain.DrawOne (x, y, munit, idx: integer);
begin
   if not IsMyUnit (x, y, munit, idx) then begin
      PutTileXY (x, y, munit * UNITBLOCK + idx + 1);
      DrawCellBk (x, y, 1, 1);
   end;
end;

procedure TFrmMain.DrawOneDr (x, y, munit, idx: integer);
begin
   PutTileXY (x, y, munit * UNITBLOCK + idx + 1);
   DrawCellBk (x, y, 1, 1);
end;

procedure TFrmMain.DrawObjDr (x, y, idx: integer);
begin
   PutObjXY (x, y, idx + 1);
   DrawCellFr (x, y, 0, 0);
end;

procedure TFrmMain.DrawORAttr (x, y, mark: integer);
begin
   if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then begin
      if (mark and $01) > 0 then
         MArr[x, y].BkImg := MArr[x, y].BkImg or $8000;
      if (mark and $02) > 0 then
         MArr[x, y].FrImg := MArr[x, y].FrImg or $8000;
   end;
end;

procedure TFrmMain.DrawXorAttrib (x, y: integer; button: TMouseButton; Shift: TShiftState);
var
   i, j, n1, n2, xx, yy: integer;
begin
   xx := x;
   yy := y;
   if ssShift in Shift then begin n1 := -2; n2 := 2 end
   else begin n1 := 0; n2 := 0; end;
   for i:=n1 to n2 do begin
      for j:=n1 to n2 do begin
         x := xx + i;
         y := yy + j;
         if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then begin
            if Button = mbLeft then begin //Bk Attrib
               if ssCtrl in Shift then begin
                  MArr[x, y].BkImg := MArr[x, y].BkImg and $7FFF;
               end else
                  MArr[x, y].BkImg := MArr[x, y].BkImg or $8000;
            end;
            if Button = mbRight then begin // Fr Attrib
               if ssCtrl in Shift then begin
                  MArr[x, y].FrImg := MArr[x, y].FrImg and $7FFF;
               end else
                  MArr[x, y].FrImg := MArr[x, y].FrImg or $8000;
            end;
         end;
      end;
   end;
end;

procedure TFrmMain.DrawTileDetail (x, y: integer; Shift: TShiftState);
var
   bimg: integer;
begin
   x := x div 2 * 2;
   y := y div 2 * 2;
   ImageDetail := FrmTile.GetCurrentIndex;
   if ssAlt in Shift then begin
      PutTileXY (x, y, 0);
      DrawCellBk (x, y, 1, 1);
   end else begin
      if ImageDetail >= 0 then begin
         if not (ssCtrl in Shift) then begin
            PutTileXY (x, y, ImageDetail + 1);
            DrawCellBk (x, y, 1, 1);
         end else begin
            PutTileXY (x, y, (ImageDetail + 1)); // xor $8000);
            DrawCellBk (x, y, 1, 1);
         end;
      end;
   end;
end;

procedure TFrmMain.DrawNormalTile (x, y: integer; Shift: TShiftState);
var
   bimg: integer;
begin
   x := x div 2 * 2;