edmain.pas

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

         end;
      //end;
      FileClose (fhandle);
   end;

end;
function  TFrmMain.ObjWil(idx: integer): TWMImages;
begin
   Result := WilObjects1;
   case (idx div 65535) of
      0: Result := WilObjects1;
      1: Result := WilObjects2;
      2: Result := WilObjects3;
      3: Result := WilObjects4;
      4: Result := WilObjects5;
      5: Result := WilObjects6;
      6: Result := WilObjects7;
      7: Result := WilObjects8;
      8..49:
         Result:=WilArr[(idx div 65535)-8];

   end;
end;

procedure TFrmMain.CopyTemp;
begin
   Move (MArr, MArrUndo, sizeof(MArr));
end;

procedure TFrmMain.Undo;
begin
   Move (MArrUndo, MArr, sizeof(MArr));
   MapPaint.Refresh;
end;

function  TFrmMain.SaveToFile (flname: string): Boolean;
var
   i,j, fhandle: integer;
   header: TMapHeader;
begin
   header.Width := MapWidth;
   header.Height := MapHeight;
   header.Title := TITLEHEADER;
   if FileExists (flname) then
      fhandle := FileOpen (flname, fmOpenWrite or fmShareDenyNone)
   else fhandle := FileCreate (flname);
   if fhandle > 0 then begin
      FileWrite (fhandle, header, sizeof(TMapHeader));
      for i:=0 to MapWidth-1 do begin
         for j:=0 to MapHeight-1 do Begin
           if MArr[i,j].Area=7 then Begin
             MArr[i,j].Area:=6;
             MArr[i,j].FrImg:=(MArr[i,j].FrImg and $7fff) + 9999;
           End;
         End;
         FileWrite (fhandle, MArr[i,0], sizeof(TMapInfo) * MapHeight);
      end;
      Result := TRUE;
      FileClose (fhandle);
   end;
end;

procedure TFrmMain.ClearSetCursor;
var
   i: integer;
begin
   for i:=0 to MAXSET-1 do begin
      SetArr[i].Left := 0;
      SetArr[i].Top  := 0;
      SetArr[i].Right := 0;
      SetArr[i].Bottom := 0;
   end;
end;

procedure TFrmMain.MakeSetCursor (plist: TList);
var
   i, n: integer;
   p: PTPieceInfo;
begin
   ClearSetCursor;
   if plist <> nil then begin
      n := 0;
      for i:=0 to plist.Count-1 do begin
         p := PTPieceInfo (plist[i]);
         if p.Img >= 0 then begin
            SetArr[n].Left := p.rx;
            SetArr[n].Top  := p.ry;
            SetArr[n].Right := p.rx + 1;
            SetArr[n].Bottom := p.ry + 1;
            Inc (n);
         end;
      end;
   end;
end;

function TFrmMain.DrawSetCursor (xx, yy: integer): Boolean;
var
   i: integer;
begin
   if SetArr[0].Left <> SetArr[0].Right then begin
      for i:=0 to MAXSET-1 do begin
         if SetArr[i].Left <> SetArr[i].Right then
         begin
            MapPaint.Canvas.DrawFocusRect (
                     Rect (xx + SetArr[i].Left * Round(UNITX*Zoom),
                           yy + SetArr[i].Top * Round(UNITY*Zoom),
                           xx + SetArr[i].Left * Round(UNITX*Zoom) + Round (BoxWidth*UNITX * Zoom),
                           yy + SetArr[i].Top * Round(UNITY*Zoom) + Round (BoxHeight*UNITY * Zoom)));
         end else
            break;
      end;
      Result := TRUE;
   end else
      Result := FALSE;
end;

procedure TFrmMain.DrawCursor (xx, yy: integer);
begin
   xx := Trunc (xx * UNITX * Zoom);
   yy := Trunc (yy * UNITY * Zoom);
   if MainBrush <> mbEraser then begin
      if DrawMode = mdObjSet then begin
         if DrawSetCursor (xx, yy) then
            exit;
      end;
   end;
   MapPaint.Canvas.DrawFocusRect (
            Rect (xx,
                  yy,
                  xx + Round (UNITX * Zoom),
                  yy + Round (UNITY * Zoom)));
end;

procedure TFrmMain.MapPaintMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
   xx, yy, n: integer;
begin
   if BoxVisible then
   begin
      DrawCursor (BoxX, BoxY);
      BoxVisible := FALSE;
   end;
   xx := Trunc (word(X) / UNITX / Zoom);
   yy := Trunc (word(Y) / UNITY / Zoom);
   if MainBrush = mbEraser then
   begin
      DrawEraser (xx, yy, Shift);
      exit;
   end;
   if MainBrush = mbAttrib then
   begin
      DrawXorAttrib (xx, yy, Button, Shift);
      exit;
   end;
   if (DrawMode = mdTile) and (MainBrush = mbFillAttrib) then begin
      RecusionCount := 0;
      CopyTemp;
      DrawFillAttrib (xx, yy, Shift);
      Edited := TRUE;
   end;
   if mbLeft = Button then begin
      case DrawMode of
         mdTile:
            case MainBrush of
               mbAuto:
                  begin
                     xx := xx div 4 * 4;
                     yy := yy div 4 * 4;
                     CopyTemp;
                     DrawAutoTile (xx, yy, Shift);
                     Edited := TRUE;
                  end;
               mbNormal:
                  begin
                     CopyTemp;
                     DrawTileDetail (xx, yy, Shift);
                     //DrawNormalTile (xx, yy, Shift);
                     Edited := TRUE;
                  end;
               mbFill:
                  begin
                     xx := xx div 2 * 2;
                     yy := yy div 2 * 2;
                     RecusionCount := 0;
                     n := GetBkImg(xx, yy);
                     if n >= 0 then FillIndex := n div UNITBLOCK
                     else FillIndex := -1;
                     CopyTemp;
                     DrawFill (xx, yy, Shift);
                     Edited := TRUE;
                  end;
            end;
         mdMiddle:
            case MainBrush of
               mbAuto:
                  begin
                     CopyTemp;
                     DrawAutoMiddleTile (xx, yy, Shift);
                     Edited := TRUE;
                  end;
            end;
         mdTileDetail:
            begin
               //CopyTemp;
               //DrawTileDetail (xx, yy, Shift);
               //Edited := TRUE;
            end;
         mdObj:
            begin
               CopyTemp;
               DrawObject (xx, yy, Shift);
               Edited := TRUE;
            end;
         mdObjSet:
            begin
               CopyTemp;
               DrawObjectSet (xx, yy, Shift);
               Edited := TRUE;
            end;
         mdLight:
            begin
               CopyTemp;
               if ssAlt in Shift then
                  UpdateLight (xx, yy)
               else AddLight (xx, yy);
               Edited := TRUE;
            end;
         mdDoor:
            begin
               CopyTemp;
               UpdateDoor (xx, yy);
               Edited := TRUE;
            end;
      end;
   end;
end;

procedure TFrmMain.MapPaintMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   ;
end;

procedure TFrmMain.MapPaintMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
   xx, yy: integer;
   button: TMouseButton;
begin
   if BoxVisible then begin
      DrawCursor (BoxX, BoxY);
      BoxVisible := FALSE;
   end;
   xx := Trunc (word(X) / UNITX / Zoom);
   yy := Trunc (word(Y) / UNITY / Zoom);
   
   if MainBrush = mbAttrib then begin
      button := mbMiddle;
      if ssLeft in Shift then button := mbLeft;
      if ssRight in Shift then button := mbRight;
      DrawXorAttrib (xx, yy, Button, Shift);
      exit;
   end;
   if MainBrush = mbEraser then begin
      if ssLeft in Shift then
         DrawEraser (xx, yy, Shift);
   end else begin
      case DrawMode of
         mdTile:
            case MainBrush of
               mbAuto:
                  begin
                     xx := xx div 4 * 4;
                     yy := yy div 4 * 4;
                     if (ssLeft in Shift) and (ssCtrl in Shift) then
                        MapPaintMouseDown (self, mbLeft, Shift, X, Y);
                  end;
               mbNormal:
                  begin
                     if (ssLeft in Shift) and ((ssCtrl in Shift) or (ssAlt in Shift)) then
                        MapPaintMouseDown (self, mbLeft, Shift, X, Y);
                  end;
               mbFill:
                  begin

                  end;
            end;
         mdMiddle:
            case MainBrush of
               mbAuto:
                  begin
                     if (ssLeft in Shift) and (ssCtrl in Shift) then begin
                        CopyTemp;
                        DrawAutoMiddleTile (xx, yy, Shift);
                        Edited := TRUE;
                     end;     
                  end;
            end;
         mdTileDetail:
            ;
         mdObjSet:
            ;
         mdObj:
            ;
      end;
   end;

   if Segmentmode then
   begin
      LbXY.Caption := IntToStr(xx + FrmSegment.Offsx) + ' : ' + IntToStr(yy + FrmSegment.OffsY);
  //    Label3.Caption:=inttostr(MArr[xx + FrmSegment.Offsx,yy + FrmSegment.OffsY].Area)+'('+inttostr(MArr[xx + FrmSegment.Offsx,yy + FrmSegment.OffsY].FrImg mod $7fff)+')';
   end
   else
   Begin
      LbXY.Caption := IntToStr(xx) + ' : ' + IntToStr(yy);
 //    Label3.Caption:=inttostr(MArr[xx ,yy ].Area)+'('+inttostr(MArr[xx,yy ].FrImg mod $7fff)+')'+inttostr(MArr[xx ,yy ].Area)+'('+inttostr(MArr[xx,yy ].BkImg mod $7fff)+')'+inttostr(MArr[xx ,yy ].Area)+'('+inttostr(MArr[xx,yy ].MidImg )+')'+'Light:('+Inttostr(MArr[xx,yy ].light)+')'+'AniFrame:('+Inttostr(MArr[xx,yy ].AniFrame)+')'+'AniTick:('+Inttostr(MArr[xx,yy ].AniTick)+')';

   end;
   if not BoxVisible then begin
      BoxX := xx;
      BoxY := yy;
      DrawCursor (BoxX, BoxY);
      BoxVisible := TRUE;
   end;
end;

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

function  TFrmMain.GetLightAddDoor (x, y: integer; var light, door, dooroffset: integer): Boolean;
begin
   Result := FALSE;
   if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then begin
      light := MArr[x, y].Light;
      door  := MArr[x, y].DoorIndex;
      dooroffset := MArr[x, y].DoorOffset;
      Result := TRUE;
   end;
end;

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

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

function  TFrmMain.GetBk (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;
   end;
end;

function  TFrmMain.GetFrImg (x, y: integer): integer;
begin
   if (x >= 0) and (x < MAXX-1) and (y >= 0) and (y < MAXY-1) then
   begin
      if MArr[x, y].Area=8 then
        Result := MArr[x, y].Area * 65535 + (MArr[x, y].FrImg and $7FFF) - 1
      else
        Result := MArr[x, y].Area * 65535 + (MArr[x, y].FrImg and $7FFF) - 1;

   end;
end;

function  TFrmMain.GetBkImg (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;
   end;
end;