childwin.pas

一款RPG游戏的引擎可以自己制作一款RPG游戏的引擎可以自己制作

  IsoMap.ScrollYOffset := VertScrollBar.Position;
  Application.ProcessMessages;
  isomap.DrawIsoMap;
end;

procedure TMDIChild.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (ssShift in Shift) then Exit;
  if (LastOperation <> nil) and (
        MainForm.Select.Down or
        MainForm.SelSame.Down or
        MainForm.EyeDropper.Down or
        MainForm.Fill.Down) then
    lastoperation.down := True;
end;

procedure TMDIChild.LayerVisible(_Layer: Integer; var Result: Boolean);
begin
  if (((layers.LG.RowCount - _Layer-1) < 0) or
     ((_Layer-1) > layers.lg.RowCount)) then
  begin
    Result :=False;
    Exit;
  end;
  Result := (Layers.LG.Cells[0,layers.LG.RowCount - _Layer]='Y');
  if Result and (_Layer<>0) then
    Result := _Layer <> 0;
end;


//  we are using the drawimage function here only to draw the image on the layer form
// we let the Engine draw on the main form when we return
procedure TMDIChild.DrawImage(var IsoCell : TIsoCell;
                    var ImageIndex : integer;
                    cellx,celly : TGridInt;x, y, layer,PatternIndex: Integer);
var CellImage : TPictureCollectionItem;
  ok : Boolean;
  imageheight,celltop,cellbottom,layerwidth,layerheight,i : Integer;
  MinCellX,MinCellY,MaxCellX,MaxCellY : Integer; // bounds of display range
  lCellCoord : TCellsCoord;
  rect : TRect;
begin                      { DONE : Need overview type display to happen on layer cell }
  if (layers.WindowState = wsMinimized) then exit;
  if (not Layers.Visible) then exit;
  layervisible(layer,ok);
  try
    if (ImageIndex<0) then
      Exit;

    lCellCoord := CellCoord;
    CellImage := IsoMap.FImageList.Items[ImageIndex];
    imageheight := cellimage.Height;
    layerwidth := layers.LG.ColWidths[1];
    layerheight := layers.LG.RowHeights[1]; // all layers are shown at the same height so just use first 1


  // check to see if we want to display this cell
    // first set the boundaries
    MinCellX := 2*(layerwidth div IsoMap.CellWidth); // number of cells displayed horizantly
    if (lcellcoord.x < (MinCellX div 2)) then
      lcellcoord.x := MinCellx div 2;
      // lcellcoord marks the last cell the mouse was over
    MinCellX := lcellcoord.X - (MinCellX div 2);
    MaxCellX := lcellcoord.X + (MinCellX div 2);
    MinCellY := 2*(layerheight div IsoMap.CellHeight); // number of cells displayed vertically
    if (lcellcoord.y < (MinCellY div 2)) then
      lcellcoord.y := mincelly div 2;
    MaxCellY := MinCellY;
    MinCellY := lcellcoord.Y - (MinCellY div 2);
    MaxCellY := lcellcoord.Y + (MaxCellY div 2);
    Dec(MinCellY,2);
    Dec(MinCellX,2);
    Inc(MaxCellY,2);
    Inc(MaxCellX,2);
    if (cellx < mincellx) or (cellx > maxcellx) or (celly < mincelly) or (celly > maxcelly) then
      Exit;  // out of layers range let engine draw the rest of it

    x := x - CellCoord.X * (IsoMap.CellWidth div 2);
    y := y - CellCoord.Y * (IsoMap.CellHeight div 2);
    celltop :=0;
    rect.Left := layers.LG.ColWidths[0];
    rect.Right := rect.Left + layers.LG.ColWidths[1];
    rect.Top := layers.LG.top;
    rect.Bottom := rect.top;
    for i := 0 to (layers.LG.RowCount - layer)-1 do              // mov y down to the right cell
    begin
      y := y + layers.LG.RowHeights[i];
      celltop := celltop + layers.lg.rowheights[i];
      if (i<>0) then y := y + 10
      else y := y + 5;
      rect.Top := rect.Bottom;
      rect.Bottom := rect.Bottom + layers.LG.RowHeights[i];
    end;
    celltop := celltop - imageheight;
    if (layer< layers.LG.RowCount) then
      cellbottom := celltop + layers.LG.RowHeights[layer+1]
    else
      cellbottom := Height;
    x := x + layers.LG.ColWidths[0];    // move x across to right cell
    CellImage := IsoMap.FImageList.Items[ImageIndex];
    if (y< (cellbottom - IsoMap.CellHeight)) and (y>(celltop + IsoMap.CellHeight)) then
    begin
      if (rect.Top <> LastClearTo.Top) or
         (rect.Bottom <> LastClearTo.Bottom) then
      begin
        layers.DXDraw1.Surface.FillRect(LastClearTo,clblack);
        LastClearTo := rect;
      end;
      CellImage.Draw(layers.DXDraw1.Surface,x,y,PatternIndex);  // draw the image which will be copied onto the LG canvas
    end;
  finally
    if (not ok) then ImageIndex := -1;  // layer not visible
  end;
end;

function TMDIChild.GetIsoName: string;
begin
  result := IsoMap.MapName;
end;

procedure TMDIChild.SetIsoName(const Value: string);
begin
  IsoMap.MapName := Value;
  MapName1.Text := Value;
end;

procedure TMDIChild.ModifyCellProperties1Click(Sender: TObject);
begin
  ShowIsoHint(9);// Tell tell about cell properties fill option
  CellProp.X := CellCoord.X;
  CellProp.y := CellCoord.y;
  CellProp.ShowModal;
end;

procedure TMDIChild.SetUnDoHead(const Value: integer);
begin
  FUndoHead := Value;
  FCurrentUnDo := Value;
  UnDo1.Enabled :=  FUndoHEad <> FUndoTail;
  ReDo1.Enabled :=  FUndoHEad <> FUndoTail;
end;

procedure TMDIChild.SetUnDoTail(const Value: integer);
begin
  FUndoTail := Value;
  UnDo1.Enabled :=  FUndoHEad <> FUndoTail;
  ReDo1.Enabled :=  FUndoHEad <> FUndoTail;
end;

procedure TMDIChild.AddAction(x, y, l, i: integer; Action: TEditAction);
var oi : integer;
  oa : TEditAction;
begin
  oa := Action;
  oi := -1;
  case Action of
    SetImage:
    begin
      oi := IsoMap.FIsoMap.IsoMap[x,Y].ImageIndexes[l].ImageIndex;
      if oi = i then Exit; // setting same image to same cell don't bother remembering this!
    end;
    SelectCell:
    begin
      oa := UnSelectCell;
      if IsoMap.FIsoMap.IsState(X,Y,[tsselected]) then Exit; // Already Selected don't remember Selecting it!
    end;
    UnSelectCell:
    begin
      oa := SelectCell;
      if not IsoMap.FIsoMap.IsState(X,Y,[tsselected]) then Exit; // Already UnSelected don't remember Selecting it!
    end;
  end;
  if (FUnDoHead<>FCurrentUnDo) then
    fUnDoHead := FCurrentUnDo;
  IncUnDoHead;
  UnDoList[UnDoHead].X := x;
  UnDoList[UnDoHead].Y := y;
  UnDoList[UnDoHead].l := l;
  UnDoList[UnDoHead].img := oi;     // opposite image
  UnDoList[UnDoHead].Action := oa;  // opposite action

  DoAction(x,y,l,i,Action);
end;

procedure TMDIChild.IncUnDoHead;
begin
  inc(FUndoHead);
  if (FUndoHead>MaxUnDo) then SetUnDoHEad(0)
  else SetUnDoHEad(fUndoHead);
  if (FUndoHEad = FUndoTail) then IncUndoTail;
end;

procedure TMDIChild.IncUnDoTail;
begin
  inc(FUndoTail);
  if (FUndoTail > MaxUndo) then SetUnDoTail(0)
  else setUndoTail(FUnDoTail);
end;

procedure TMDIChild.UnDoAction;
var FirstAction,oa : TEditAction;
begin
  FirstAction := UnDoList[FCurrentUnDo].Action;
  // block undo
  while(FirstAction = UnDoList[FCurrentUnDo].Action) and (FCurrentUnDo<>FUnDoTail) do
  begin
    UnDoList[FCurrentUnDo].Img := // setup for redo
                                    DoAction(
                                        UnDoList[FCurrentUndo].x,
                                        UnDoList[FCurrentUndo].y,
                                        UnDoList[FCurrentUnDo].l,
                                        UnDoList[FCurrentUnDo].Img,
                                        UnDoList[FCurrentUnDo].Action);
    oa := UnDoList[FCurrentUnDo].Action;
    if (oa = SelectCell) then oa := UnSelectCell
    else if oa = UnSelectCell then oa := SelectCell;
    UnDoList[FCurrentUnDo].Action := oa;  // set up for redo
    if (FCurrentUnDo <> fUnDoTail) then
    begin
      Dec(FCurrentUnDo);
      if (FCurrentUnDo<0) then
        FCurrentUnDo := MaxUndo;
    end;
    if (FirstAction = FillImage) then
        FirstAction := UnDoList[FCurrentUnDo].Action  // ignored on first action, used to break fills
    else
      if (not MainForm.BlockUndoRedo1.Checked) then Break;
    if (FirstACtion = fillImage) then break; // shouldn't ever get here
  end;
end;

function TMDIChild.DoAction(x, y, l, i: integer; Action: TEditAction) : integer;
begin
  result := IsoMap.FIsoMap.IsoMap[x,y].ImageIndexes[l].ImageIndex;
  case Action of
  SetImage : IsoMap.FIsoMap.IsoMap[x,y].ImageIndexes[l].ImageIndex := i;
//            IsoMap.FIsoMap.IsoMap[CellCoord.X,CellCoord.Y].ImageIndexes[l].ImageIndex := Images.IG.Row-1
  SelectCell: IsoMap.FIsoMap.AddState(x,y,[tsSelected]);
  UnSelectCell : IsoMap.FIsoMap.SubState(x,y,[tsSelected]);
  end;
end;

procedure TMDIChild.Undo1Click(Sender: TObject);
begin
  UnDoAction;
end;

procedure TMDIChild.Redo1Click(Sender: TObject);
var oa,FirstAction : TEditAction;
begin
  FirstAction :=  UnDoLIst[FCurrentUnDo].Action;
  while (FirstAction =  UnDoLIst[FCurrentUnDo].Action) and (FCurrentUndo<> fUnDoHEad) do
  begin
    if (FCurrentUnDo <> fUnDoHead) then
    begin
      Inc(FCurrentUnDo);
      if (FCurrentUnDo>MaxUnDo) then
        FCurrentUnDo := 0;
    end;
    UnDoList[FCurrentUnDo].Img := // setup for UnDo
                                    DoAction(
                                        UnDoList[FCurrentUndo].x,
                                        UnDoList[FCurrentUndo].y,
                                        UnDoList[FCurrentUnDo].l,
                                        UnDoList[FCurrentUnDo].Img,
                                        UnDoList[FCurrentUnDo].Action);
    oa := Undolist[FCurrentUndo].Action;
    if oa = SelectCell then oa := UnSelectCell
    else if oa = UnSelectCell then oa := SelectCell;
    UnDoList[FCurrentUnDo].Action := oa;
    if (FirstAction = FillImage) then
        FirstAction :=  UnDoLIst[FCurrentUnDo].Action // this is ignored, only used to end undo/redo blocks
    else
      if (not MainForm.BlockUndoRedo1.Checked) then Break;
    if (FirstAction = FillIMage) then break; // this shouldn't happen
  end;
end;

procedure TMDIChild.SelectAll;
var Cellx,celly : integer;
begin
      // shorthand
//      IsoMap.FIsoMap.SubAllState([tsSelected]); // clear currently selected tiles
      //long hand (so we can undo)
      for cellx := 0 to IsoMap.MapWidth-1 do
        for celly := 0 to IsoMap.MapHeight -1 do
          AddAction(cellx,celly,0,-1,SelectCell);
end;

procedure TMDIChild.UnSelectAll;
var Cellx,celly : integer;
begin
      // shorthand
//      IsoMap.FIsoMap.SubAllState([tsSelected]); // clear currently selected tiles
      //long hand (so we can undo)
      for cellx := 0 to IsoMap.MapWidth-1 do
        for celly := 0 to IsoMap.MapHeight -1 do
          AddAction(cellx,celly,0,-1,UnSelectCell);
end;

procedure TMDIChild.Cls;
begin
  layers.DXDraw1.Surface.Fill(clBlack);
//  diagnostics.AddDiagnostic('XOffset = '+inttostr(IsoMap.XOffset) + ' YOffset = ' + inttostr(IsoMap.yoffset));

end;

procedure TMDIChild.BeforeFlip(Sender: TObject);
begin
  layers.DXDraw1.Flip;
  layers.DXDraw1.Surface.Canvas.Release;
  layers.LG.Invalidate;
end;

procedure TMDIChild.BitBtn2Click(Sender: TObject);
var IniFile : TIniFile;
procedure LoadTiles(FileName : string);
var f : TFileStream;
begin
   f := TFileStream.Create(FileName,fmOpenRead);
   try
        IsoMap.LoadImageListFromStream(f);
        Images.IG.RowCount := IsoMap.FImageList.Items.Count + 1;
        Mainform.TilesLoaded := True;
        if (not Images.Visible) then
        Images.Visible := True;
   finally
        f.free;
   end
end;
begin
  begin
    IniFile := GetIniFile;
    try
      openImageList.filename := IniFile.ReadString('Defaults','ImagePath',openImageList.filename);
    if (OpenImageList.Execute) then
    begin
      IniFile.WriteString('Defaults','ImagePath',openImageLIst.filename);
      Loadtiles(OpenImageList.FileName);
      formactivate(self);
      Images.Edit1.Text :=  MainForm.Activechild.IsoMap.FImageList.Items[Images.IG.RowCount-2].DisplayName;

    end;
    finally
      inifile.free;
    end;
  end;
end;



procedure TMDIChild.AddMetaInfo;
var below,nw,ne,sw,se,layer,image,Cellx,celly : integer;
  cell : TCellsCoord;

  s : string;
  IM : tmeta;
procedure SetSurroundingTiles;
function GetImage(c : TCellsCoord) : integer;
begin
  if (c.x>=0) and (c.x<IsoMap.Mapwidth) and (c.y>=0) and (c.y<IsoMap.MapHeight) then
    result := IsoMap.cell[c.x,c.y].imageIndexes[layer].imageindex
  else
    result := -1;
end;
begin
   below := -1;
   if (layer>0) then
    below := IsoMap.Cell[cell.X,cell.Y].ImageIndexes[layer-1].ImageIndex;
   image := IsoMap.Cell[cell.x,cell.Y].ImageIndexes[layer].ImageIndex;
   nw := GetImage(GetNW(cell));
   ne := GetImage(GetNE(cell));
   sw := GetImage(GetSW(cell));
   se := GetImage(GetSE(cell));
end;

begin
  IM := TMeta.Create;
  try
  // First Clear out any old meta data
  for image := 0 to IsoMap.ImageCount-1 do
  begin
    s := IsoMap.FIsoMap.ImageStrings[Image];
    ne := Pos(s,'<Meta>');
    nw := Pos(s,'</Meta>');
    if (ne<>0) and (nw>ne) then
      Delete(s,ne,nw+Length('</Meta>'));
    IsoMap.FIsoMap.ImageStrings[Image] := s;// +im.Meta;
  end;
  for layer := 0 to IsoMap.FIsoMap.LayerCount-1 do
  begin
      for cellX := 0 to IsoMap.MapWidth-1 do
        for celly := 0 to IsoMap.MapHeight -1 do
        begin
          cell.X := Cellx; cell.Y := celly;
          SetSurroundingTiles;  // sets up image and nw,ne,sw,se with image indexes
          if (image = -1) then Continue;
          if (nw>=0) or (layer=0) then
            IM.AddNWNeighbor(layer,image,nw);
          if (ne>=0) or (layer=0) then
            IM.AddNENeighbor(layer,image,ne);
          if (sw>=0) or (layer=0) then
            IM.AddSWNeighbor(layer,image,sw);
          if (se>=0) or (layer=0) then
            IM.AddSENeighbor(layer,image,se);
          IM.AddBelowNeighbor(layer,image,below);
        end;
  end;
  IM.CalculateHeights;
  for image := 0 to IsoMap.ImageCount-1 do
  begin
    IsoMap.FIsoMap.ImageStrings[Image] := im.getimagestr(image);// +im.Meta;
  end;
     finally
      im.Free;
     end;
end;


procedure TMDIChild.LoadUserDataFromStream(s: TStream; Version: String);
begin
   UserData := IsoMap.ReadStr(s); // store the users data until we are done
end;

procedure TMDIChild.SaveUserDataToStream(s: TStream; Version: String);
begin
  IsoMap.WriteStr(s,Userdata);
end;

end.