edmain.pas

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

                  if c >= 8 then
                     PutTile (i, j, IMG(0));

               end;
            end;
         end;
   end;
var
   i, k, n, rx, ry: integer;
begin
   rlist := TList.Create;
   PutTile (x, y, IMG(0));

   DrawSide (x, y);
   WW := 1;
   HH := 1;
   for k:=0 to 30 do begin
      changecount := 0;
      DrawAutoPattern (x, y);
      if changecount = 0 then break;
      Inc (WW);
      Inc (HH);
   end;

   for i:=0 to rlist.Count-1 do begin
      n := Integer(rlist[i]);
      DrawCellBk (Loword(n), Hiword(n), 0, 0);
   end;
   rlist.Free;
end;

procedure TFrmMain.DrawCellBk (x, y, w, h: integer);
var
   i, j, dx, dy, xx, yy, lcorner, tcorner, idx, light, door, dooroffs: integer;
begin
   lcorner := Trunc (MainScroll.HorzScrollBar.Position div UNITX / Zoom);
   tcorner := Trunc (MainScroll.VertScrollBar.Position div UNITY / Zoom);

   if ShowBackgroundTile1.Checked then
      for j:=y to y+h do
         for i:=x to x+w do begin
            xx := i;
            yy := j;
            if (xx >= 0) and (xx < MAXX) and (yy >= 0) and (yy < MAXY) then begin
               if (xx >= lcorner-1) and (yy >= tcorner-1) and
                  (xx <= lcorner + Round (Width div UNITX / Zoom)) and
                  (yy <= tcorner + Round (Height div UNITY / Zoom)) then begin
                  idx := GetBkImg (xx, yy);
                  dx := Trunc (xx * UNITX * Zoom);
                  dy := Trunc (yy * UNITY * Zoom);
                  if (xx mod 2 = 0) and (yy mod 2 = 0) then begin
                     WilTiles.DrawZoom (MapPaint.Canvas, dx, dy, idx, Zoom);
                  end else
                     WilTiles.DrawZoom (MapPaint.Canvas, dx, dy, 99, Zoom);
               end;
            end;
         end;
   if ShowMiddleTile1.Checked then
      for j:=y to y+h do
         for i:=x to x+w do begin
            xx := i;
            yy := j;
            if (xx >= 0) and (xx < MAXX) and (yy >= 0) and (yy < MAXY) then begin
               if (xx >= lcorner-1) and (yy >= tcorner-1) and
                  (xx <= lcorner + Round (Width div UNITX / Zoom)) and
                  (yy <= tcorner + Round (Height div UNITY / Zoom)) then begin
                  idx := GetMidImg (xx, yy);
                  dx := Trunc (xx * UNITX * Zoom);
                  dy := Trunc (yy * UNITY * Zoom);
                  if idx >= 0 then
                     if MiddleTransparent1.Checked then
                        WilSmTiles.DrawZoomEx (MapPaint.Canvas, dx, dy, idx, Zoom, TRUE)
                     else
                        WilSmTiles.DrawZoom (MapPaint.Canvas, dx, dy, idx, Zoom)
               end;
            end;
         end;
   for j:=y to y+h do
      for i:=x to x+w do begin
         xx := i; yy := j;
         if (xx >= 0) and (xx < MAXX) and (yy >= 0) and (yy < MAXY) then begin
            if (xx >= lcorner-1) and (yy >= tcorner-1) and
               (xx <= lcorner + Round (Width div UNITX / Zoom)) and
               (yy <= tcorner + Round (Height div UNITY / Zoom)) then begin
               dx := Trunc (xx * UNITX * Zoom);
               dy := Trunc (yy * UNITY * Zoom);
               light := 0;
               door := 0;
               dooroffs := 0;
               if GetLightAddDoor (xx, yy, light, door, dooroffs) then begin
                  if light > 0 then
                     WilSmTiles.DrawZoomEx (MapPaint.Canvas, dx, dy, LIGHTSPOT, Zoom, TRUE);
                  if (Zoom >= 0.8) and (door > 0) then begin
                     if (door and $80) > 0 then
                        MapPaint.Canvas.TextOut (dx+16, dy-26, 'Dx')
                     else MapPaint.Canvas.TextOut (dx+16, dy-26, 'D');
                  end;
               end;
            end;
         end;
      end;
end;

procedure TFrmMain.DrawCellFr (x, y, w, h: integer);
var
   i, j, dx, dy, lcorner, tcorner, idx: integer;
begin
   lcorner := Trunc (MainScroll.HorzScrollBar.Position div UNITX / Zoom);
   tcorner := Trunc (MainScroll.VertScrollBar.Position div UNITY / Zoom);

   if ShowObject1.Checked then
      if (x >= 0) and (x < MAXX) and (y >= 0) and (y < MAXY) then begin
         if (x >= lcorner-1) and (y >= tcorner-1) and
            (x <= lcorner + Round (Width div UNITX / Zoom)) and
            (y <= tcorner + Round (Height div UNITY / Zoom)) then begin
            idx := GetFrImg (x, y);
            dx := Trunc (x * UNITX * Zoom);
            dy := Trunc ((y+1) * UNITY * Zoom);
            if (idx >= 0) then
               ObjWil(idx).DrawZoomEx (MapPaint.Canvas, dx, dy, idx mod 65535, Zoom, FALSE);
         end;
      end;
   if ShowAttribMarks1.Checked then
      if (x >= lcorner-1) and (y >= tcorner-1) and
         (x <= lcorner + Round (Width div UNITX / Zoom)) and
         (y <= tcorner + Round (Height div UNITY / Zoom)) then begin
         if (x >= 0) and (x < MAXX) and (y >= 0) and (y < MAXY) then begin
            dx := Trunc (x * UNITX * Zoom);
            dy := Trunc (y * UNITY * Zoom);
            idx := GetBk (x, y);
            if idx >= 0 then
               if (idx and $8000) > 0 then WilSmTiles.DrawZoomEx (MapPaint.Canvas, dx, dy, BKMASK, Zoom, TRUE);
            idx := GetFrMask (x, y);
            if idx > 0 then
               WilSmTiles.DrawZoomEx (MapPaint.Canvas, dx, dy, FRMASK, Zoom, TRUE);
         end;
      end;

end;

procedure TFrmMain.MapPaintPaint(Sender: TObject);
var
   i, j, xx, yy, dx, dy, lcorner, tcorner, idx, light, door, dooroffs: integer;
begin
   lcorner := Trunc (MainScroll.HorzScrollBar.Position div UNITX / Zoom);
   tcorner := Trunc (MainScroll.VertScrollBar.Position div UNITY / Zoom);

   if ShowBackgroundTile1.Checked then
      for j:=0 to (Trunc(MapPaint.Height div UNITY / Zoom) + 2) do
         for i:=0 to (Trunc(MapPaint.Width div UNITX / Zoom) + 2) do begin
            xx := i;
            yy := j;
            if (xx >= lcorner-1) and (yy >= tcorner-1) and
               (xx <= lcorner + Round (Width div UNITX / Zoom)) and
               (yy <= tcorner + Round (Height div UNITY / Zoom)) then begin
               if (xx >= 0) and (xx < MAXX) and (yy >= 0) and (yy < MAXY) then begin
                  idx := GetBkImg (xx, yy);
                  if (xx mod 2 = 0) and (yy mod 2 = 0) then begin
                     xx := Trunc (xx * UNITX * Zoom);
                     yy := Trunc (yy * UNITY * Zoom);
                     if idx >= 0 then begin
                        WilTiles.DrawZoom (MapPaint.Canvas, xx, yy, idx, Zoom);
                     end;
                  end;
               end;
            end;
         end;

   if ShowMiddleTile1.Checked then
      for j:=0 to (Trunc(MapPaint.Height div UNITY / Zoom) + 2) do
         for i:=0 to (Trunc(MapPaint.Width div UNITX / Zoom) + 2) do begin
            xx := i;
            yy := j;
            if (xx >= lcorner-1) and (yy >= tcorner-1) and
               (xx <= lcorner + Round (Width div UNITX / Zoom)) and
               (yy <= tcorner + Round (Height div UNITY / Zoom)) then begin
               if (xx >= 0) and (xx < MAXX) and (yy >= 0) and (yy < MAXY) then begin
                  idx := GetMidImg (xx, yy);
                  xx := Trunc (xx * UNITX * Zoom);
                  yy := Trunc (yy * UNITY * Zoom);
                  if idx >= 0 then begin
                     if MiddleTransparent1.Checked then
                        WilSmTiles.DrawZoomEx (MapPaint.Canvas, xx, yy, idx, Zoom, TRUE)
                     else WilSmTiles.DrawZoom (MapPaint.Canvas, xx, yy, idx, Zoom);
                  end;
               end;
            end;
         end;

   if ShowObject1.Checked then
      for j:=0 to (Trunc(MapPaint.Height div UNITY / Zoom) + 10) do
         for i:=0 to (Trunc(MapPaint.Width div UNITX / Zoom) + 2) do begin
            xx := i;
            yy := j;
            if (xx >= lcorner-1) and (yy >= tcorner-1) and
               (xx <= lcorner + Round (Width div UNITX / Zoom)) and
               (yy <= tcorner + Round (Height div UNITY / Zoom)) then begin
               if (xx >= 0) and (xx < MAXX) and (yy >= 0) and (yy < MAXY) then
               begin

                  if (Marr[xx,yy].Area=5) and (Marr[xx,yy].FrImg=12048) then
                    idx := GetFrImg (xx, yy)
                  else
                    idx := GetFrImg (xx, yy);
                  xx := Trunc (xx * UNITX * Zoom);
                  yy := Trunc ((yy+1) * UNITY * Zoom);
                  if (idx >= 0) then
                      ObjWil(idx).DrawZoomEx (MapPaint.Canvas, xx, yy, idx mod 65535, Zoom, FALSE);

               end;
            end;
         end;

   for j:=0 to (Trunc(MapPaint.Height div UNITY / Zoom) + 2) do
      for i:=0 to (Trunc(MapPaint.Width div UNITX / Zoom) + 2) do begin
         xx := i;
         yy := j;
         if (xx >= lcorner-1) and (yy >= tcorner-1) and
            (xx <= lcorner + Round (Width div UNITX / Zoom)) and
            (yy <= tcorner + Round (Height div UNITY / Zoom)) then begin
            if (xx >= 0) and (xx < MAXX) and (yy >= 0) and (yy < MAXY) then begin
               dx := Trunc (xx * UNITX * Zoom);
               dy := Trunc (yy * UNITY * Zoom);
               if ShowAttribMarks1.Checked then begin
                  idx := GetBk (xx, yy);
                  if idx >= 0 then
                     if (idx and $8000) > 0 then
                        WilSmTiles.DrawZoomEx (MapPaint.Canvas, dx, dy, BKMASK, Zoom, TRUE);
                  idx := GetFrMask (xx, yy);
                  if idx > 0 then
                     WilSmTiles.DrawZoomEx (MapPaint.Canvas, dx, dy, FRMASK, Zoom, TRUE);
                  idx := GetAni (xx, yy);
                  if idx > 0 then
                     MapPaint.Canvas.TextOut (dx, dy, '*');
               end;
               light := 0;
               door := 0;
               dooroffs := 0;
               if GetLightAddDoor (xx, yy, light, door, dooroffs) then begin
                  if light > 0 then
                     WilSmTiles.DrawZoomEx (MapPaint.Canvas, dx, dy, LIGHTSPOT, Zoom, TRUE);
                  if (Zoom >= 0.9) and (door > 0) then begin
                     if (door and $80) > 0 then
                        MapPaint.Canvas.TextOut (dx, dy, 'Dx' + intToStr(door and $7F) + '/' + IntToStr(doorOffs))
                     else MapPaint.Canvas.TextOut (dx, dy, 'D' + intToStr(door and $7F) + '/' + IntToStr(doorOffs));
                  end;
               end;
            end;
         end;
      end;

   with MapPaint.Canvas do begin
      Pen.Color := clBlack;
      MoveTo (0, MapPaint.Height-1);
      LineTo (MapPaint.Width-1, MapPaint.Height-1);
      LineTo (MapPaint.Width-1, 0);
   end;
   if BoxVisible then begin
      BoxVisible := FALSE;
   end;
end;

procedure TFrmMain.SpeedButton1Click(Sender: TObject);
begin
   MainBrush := mbAuto;
end;

procedure TFrmMain.SpeedButton2Click(Sender: TObject);
begin
   MainBrush := mbNormal;
end;

procedure TFrmMain.SpeedButton3Click(Sender: TObject);
begin
   MainBrush := mbFill;
end;

procedure TFrmMain.SpeedButton6Click(Sender: TObject);
begin
   MainBrush := mbFillAttrib;
end;

procedure TFrmMain.SpeedButton4Click(Sender: TObject);
begin
   MainBrush := mbAttrib;
end;

procedure TFrmMain.SpeedButton5Click(Sender: TObject);
begin
   MainBrush := mbEraser;
end;


procedure TFrmMain.ZoomInClick(Sender: TObject);
begin
   if Zoom <= 0.21 then begin
      Zoom := Zoom - 0.05;
      if Zoom < 0.05 then Zoom := 0.05;
   end else begin
      Zoom := Zoom - 0.2;
      if Zoom < 0.2 then Zoom := 0.2;
   end;
   Label1.Caption := '100:' + IntToStr(Round(100 * Zoom));
   MapPaint.Width := Round (MapWidth * UNITX * Zoom) + 1;
   MapPaint.Height := Round (MapHeight * UNITY * Zoom) + 1;
   MainScroll.HorzScrollBar.Increment := Round (UNITX * 4 * Zoom);
   MainScroll.VertScrollBar.Increment := Round (UNITY * 4 * Zoom);
   MapPaint.Update; //Refresh;
end;

procedure TFrmMain.ZoomOutClick(Sender: TObject);
begin
   if Zoom < 0.2 then begin
      Zoom := Zoom + 0.05;
   end else begin
      Zoom := Zoom + 0.2;
      if (Zoom > 1.0) and (Zoom < 1.2) then Zoom := 1.0;
      if Zoom > 2.0 then Zoom := 2.0;
   end;
   Label1.Caption := '100:' + IntToStr(Round(100 * Zoom));
   MapPaint.Width := Round (MapWidth * UNITX * Zoom) + 1;
   MapPaint.Height := Round (MapHeight * UNITY * Zoom) + 1;
   MainScroll.HorzScrollBar.Increment := Round (UNITX * 4 * Zoom);
   MainScroll.VertScrollBar.Increment := Round (UNITY * 4 * Zoom);
   MapPaint.Refresh;
end;

procedure TFrmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   case Key of
      VK_F5:
         MapPaint.Refresh;
      word ('z'),
      word ('Z'):
         if ssCtrl in Shift then begin
            Undo;
         end;
   end;
end;

procedure TFrmMain.Tile1Click(Sender: TObject);
begin
   FrmMainPal.Show;
end;

procedure TFrmMain.Object1Click(Sender: TObject);
begin
   FrmObj.Show;
end;

procedure TFrmMain.RunObjEditer1Click(Sender: TObject);
begin
   FrmObjEdit.Execute;
end;

procedure TFrmMain.ObjectSet1Click(Sender: TObject);
begin
   FrmObjSet.Execute;
end;

procedure TFrmMain.TileDetail1Click(Sender: TObject);
begin
   FrmTile.Show;
end;

function  TFrmMain.VerifyWork: Boolean;
var
   r: integer;
begin
   Result := TRUE;
   if Edited then begin
      r := MessageDlg ('文件以被更新，是否保存?',
                       mtWarning,
                       mbYesNoCancel,
                       0);
      if r = mrYes then
         if not SegmentMode then
            SaveAs1Click (self)
         else
            DoSaveSegm