childwin.pas

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

unit Childwin;
{****************************************************************************
     The contents of this file are subject to the Mozilla Public License
     Version 1.1 (the "License"); you may not use this file except in
     compliance with the License. You may obtain a copy of the License at
     http://www.mozilla.org/MPL/

     Software distributed under the License is distributed on an "AS IS"
     basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
     License for the specific language governing rights and limitations
     under the License.

     The Original Code is IsoEditMdi.

     The Initial Developer of the Original Code is Crystal Software (Canada) Inc.
     and Chris Bruner. Portions created by Chris Bruner are Copyright
     (C) Crystal Software (Canada) Inc.  All Rights Reserved.

     Contributor(s): Chris Bruner of Crystal Software (Canada) Inc.
     (sign your name here)
******************************************************************************}

interface

uses Windows, Classes, Graphics, Forms, Controls, StdCtrls,Dialogs, Menus,
     comctrls,Buttons, DXIsoengine, TextQuery,sysutils, IsoEngine,Layerunit,
     dxdraws,util,inifiles,meta,Isomath;

const MaxUndo = 10000;
type

 TEditAction = (SetImage,SelectCell,UnSelectCell,FillImage );

 CellsAction = record
    X,Y,l,Img : integer;
    Action : TEditAction;
  end;

  TMDIChild = class(TForm)
    PopupMenu1: TPopupMenu;
    SetGridWidth1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Label3: TLabel;
    Label4: TLabel;
    Label2: TLabel;
    Label1: TLabel;
    Label5: TLabel;
    MapName1: TEdit;
    MapWidth: TEdit;
    MapHeight: TEdit;
    CellWidth: TEdit;
    CellHeight: TEdit;
    OK: TBitBtn;
    ModifyCellProperties1: TMenuItem;
    N2: TMenuItem;
    MainMenu1: TMainMenu;
    Edit2: TMenuItem;
    PasteSpecial1: TMenuItem;
    Paste1: TMenuItem;
    Copy1: TMenuItem;
    Cut1: TMenuItem;
    N5: TMenuItem;
    Redo1: TMenuItem;
    Undo1: TMenuItem;
    OpenImageList: TOpenDialog;
    BitBtn2: TBitBtn;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure OKClick(Sender: TObject);
    procedure ModIso(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    Procedure ColorProgress(PercentDone : integer);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LayerVisible(_Layer : Integer; var Result : Boolean);
    procedure DrawImage(var IsoCell : TIsoCell; var ImageIndex : integer;
                cellx,celly : TGridInt;x, y, layer,PatternIndex: Integer);
    procedure ModifyCellProperties1Click(Sender: TObject);
    procedure Undo1Click(Sender: TObject);
    procedure Redo1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    fUnDoHead,fUnDoTail,FCurrentUnDo : integer;
    function GetIsoName: string;
    procedure SetIsoName(const Value: string);
    procedure SetUnDoHead(const Value: integer);
    procedure SetUnDoTail(const Value: integer);
    procedure IncUnDoHead;
    procedure IncUnDoTail;
    procedure Cls;
    procedure BeforeFlip(Sender : TObject);
    { Private declarations }
  public
    UserData : string;
    UnDoList : array [0..MaxUnDo] of CellsAction;
    LastOperation : TToolButton;
    LastClearTo : TRect;
    SelStartX,SelStarty,
    MouseX,MouseY : Integer;
    IsoMap : TDXIsoMap;
    Modified, Named : Boolean;
    CellCoord : TCellsCoord; // last cell coordiates
    procedure AddAction(x,y,l,i : integer; Action : TEditAction);
    function DoAction(x,y,l,i : integer; Action : TEditAction) : integer; // returns old image at location
    procedure UnDoAction;
    procedure SelectAll;
    procedure UnSelectAll;
    procedure AddMetaInfo;
  property UnDoHead : integer read FUndoHead write SetUnDoHead;
  property UnDoTail : integer read FUndoTail write SetUnDoTail;
  property MapName : string read GetIsoName Write SetIsoName;
  procedure LoadUserDataFromStream(s: TStream; Version: String);
  procedure SaveUserDataToStream(s: TStream; Version: String);

    { Public declarations }
  end;

implementation

uses Main, imageinfo, diag, overview, cellProperties;

{$R *.DFM}

procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
var w : Word;
begin
  Action := caFree;
  if Modified then
  begin
    w := MessageDlg('Save Changes?',
      mtConfirmation, [mbYes, mbNo,mbCancel], 0);
    if (w = mrCancel) then
    begin
      Action := caNone;
      Exit;
    end;
    if w = mrYes then
    begin
      if (Named) then
        MainForm.FileSaveItemClick(Sender)
      else
        MainForm.filesaveasItemClick(Sender);

    end;
  end;
  MainForm.Modified := false;
  MainForm.ActiveChild := nil;  // avoid being called whilst we are losing ourselves
  if (MainForm.MDIChildCount=1) then
  begin
    Images.Hide;
    layers.Hide;
    _OverView.Hide;
  end;
end;

procedure TMDIChild.FormCreate(Sender: TObject);
begin
    Named := false;
    Modified := false;
    Isomap := TDXIsoMap.Create(self);
    IsoMap.SetParent(self);
    IsoMap.Options := MainForm.GetDXOptions;
    IsoMap.Align := alClient;
    IsoMap.OnMouseDown := FormMouseDown;
    IsoMap.OnMouseMove := FormMouseMove;
    IsoMap.OnMouseUp := FormMouseUp;
    IsoMap.OnProgress :=colorProgress;
    // because we always want to Show layers in the layers window
    // we will handle turning off layers at the DrawImage level
//    IsoMap.OnLayerVisible  := layervisible;
    IsoMap.OnBeforeFlip := BeforeFlip;
    Isomap.OnCls := Cls;
    IsoMap.OnDrawImage := DrawImage;
    IsoMap.Initialize;
    IsoMap.Visible := False;
    UserData := '';
    IsoMap.OnLoadUserDataFromStream  := LoadUserDataFromStream;
    IsoMap.OnSaveUserDataToStream := SaveUserDataToStream;
    UnDoHead := 0;
    UnDoTail := 0;
    LastOperation := MainForm.Draw;    
end;

procedure TMDIChild.FormActivate(Sender: TObject);
begin
    MainForm.ActiveChild := Self;
    MainForm.FileSaveItem.Enabled := Named;
    MainForm.Modified := Modified;
//    layers.DXDraw1.Display := IsoMap.Display;
    layers.Caption := Caption;
    layers.Invalidate;
    Images.Caption := Caption;
    Images.IG.Invalidate;
    Images.Invalidate;
    _OverView.Caption := Caption;
    _OverView.Invalidate;
end;

procedure TMDIChild.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var l,i,cellx,celly : Integer;
  point : TPoint;
begin
  if (not IsoMap.Visible) then Exit;
    point.x := X;
    point.y := Y;
    CellCoord := IsoMap.CellAt(point);

  l := layers.LG.RowCount - layers.LG.Row -1; { DONE 2 : Add Layer support (currently only 1 layer) }
  if (Button = mbRight) then
  begin
    {TMDIChild(MainForm.ActiveChild).}
    PopupMenu1.Popup(MainForm.Left + Left + X,        { DONE : Fixup pop location }
    MainForm.Top + MainForm.ToolBar2.Height * 3 +  Top + Y);
  end
  else  // we are going to do some action selected by buttons on the main form
  begin
    if (MainForm.Draw.down) then LastOperation := MainForm.Draw;
    if (MainForm.Erase.Down) then LastOperation := MainForm.Erase;
    if (IsoMap.ImageCount=0) then
    begin
      ShowIsoHint(1);// no image list present
      IsoMap.Visible := False;
//      ShowMessage('This file has no Image list. Load Image First');
      Exit;
    end;

    if (MainForm.Select.Down) then
    begin
        if (CellCoord.X = -1) or (CellCoord.Y = -1) then Exit;
        SelStartX := cellcoord.X;
        SelStarty := CellCoord.Y;
    end;
    if (MainForm.EyeDropper.Down) then
    begin
      i := IsoMap.FIsoMap[CellCoord.X,CellCoord.Y].ImageINdexes[l].ImageIndex;
      Images.IG.Row := i + 1;

    end;
    if (MainForm.SelSame.Down) then
    begin
      if not (ssShift in Shift) then
        UnSelectAll;

      i := IsoMap.FIsoMap[CellCoord.X,CellCoord.Y].ImageIndexes[l].ImageIndex;
      for cellx := 0 to IsoMap.MapWidth-1 do
        for celly := 0 to IsoMap.MapHeight-1 do
        begin
          if (IsoMap.FIsoMap[CellX,CellY].
            ImageIndexes[l].ImageIndex = i) then
              AddAction(cellx,celly,0,-1,SelectCell);
//              isomap.fisomap.AddState(cellx,celly,[tsSelected]);
        end;
    end;
    if (MainForm.Fill.Down) then
    begin
    AddAction(0,0,l,0,FillImage); // marker to break block undo/redo
  // short hand
  // IsoMap.FIsoMap.FillAllStateImage([tsSelected],Images.IG.Row-1,l);
  // long hand so we can undo
    for cellx := 0 to IsoMap.MapWidth-1 do
      for celly := 0 to IsoMap.MapHeight - 1 do
      begin
        if IsoMap.FIsoMap.IsState(cellx,celly,[tsSelected]) then
          AddAction(cellx,celly,l,Images.IG.Row-1,SetImage);
      end;
    end;
    AddAction(0,0,l,0,FillImage); // marker to break block undo/redo
    FormMouseMove(sender,shift,x,y);
    Modified := true;
    MainForm.Modified := true;
  end;
end;

procedure TMDIChild.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var l,cellx,celly : Integer;
  point : TPoint;
  ThisCell : TIsoCell;
begin
  if Active then
  begin
      if (IsoMap.Visible) then
      begin
        if (ShowIsoHint(2)) then
          ShowIsoHint(8);
      end
      else
        ShowIsoHint(3);
  end;
  l := layers.LG.RowCount - layers.LG.Row -1;
  x := x + HorzScrollBar.ScrollPos;
  y := y + VertScrollBar.ScrollPos;
  point.x := X;
  point.y := Y;
  CellCoord := IsoMap.CellAt(point);

  MouseX := X;
  MouseY := Y;
  CellCoord := IsoMap.CellAt(point);
  if (cellcoord.x < 0) or
     (cellcoord.Y < 0) or
     (CellCoord.X > IsoMap.MapWidth) or
     (CellCoord.Y > IsoMap.MapHeight) then Exit;
  if (IsoMap.Visible) then
  begin
    ThisCell := IsoMap.Cell[CellCoord.x, CellCoord.y];
    MainForm.StatusCoord := '(' + IntToStr(CellCoord.X) + ',' + IntToStr(CellCoord.Y) +
                   ') Layers(' + IntToStr(l+1) +
                    '), Display From Layer ' + IntToStr(ThisCell.AlwaysDisplayFrom) +
                    ' to ' + inttostr(ThisCell.AlwaysDisplayto) +
                    '), Animate From Layer ' + IntToStr(ThisCell.AnimateFrom) +
                    ' to ' + inttostr(ThisCell.AnimateTo) +
                    ' Animate Speed ' + IntToStr(ThisCell.AnimateSpeed) +
                    '  (' + IntToStr(ThisCell.AnimateNext) + ') ' + IsoMap.FIsoMap.CellComment[CellCoord.x,CellCoord.y];
  end;
  IsoMap.FIsoMap.AddState(CellCoord.X,CellCoord.Y,[tsDirty]);
  IsoMap.FIsoMap.AddAllState([tsDirty]);
  if (ssleft in Shift) then
  begin
    if (MainForm.Select.Down) then
    begin
      X := CellCoord.X;
      y := CellCoord.y;
      if not (ssShift in Shift) then
        UnSelectAll;
      if x< SelStartX then
      begin
        if (y < SelStartY) then
        begin
          for CellX := x to selstartx do
            for celly := y to selstarty do
              AddAction(CellX,CellY,0,-1,SelectCell);
        end
        else
        begin
          for cellx := X to SelStartX do
            for celly := SelStarty to Y do
              AddAction(CellX,CellY,0,-1,SelectCell);
        end
      end
      else
      begin
        if (y < SelStartY) then
        begin
          for CellX := selstartx to x do
            for celly := y to selstarty do
              AddAction(CellX,CellY,0,-1,SelectCell);
        end
        else
        begin
          for cellx := SelStartX to x do
            for celly := SelStarty to Y do
              AddAction(cellx,celly,0,-1,SelectCell);
        end
      end;
    end;
    if (MainForm.Draw.Down) or (MainForm.Erase.Down) then
    begin
      if (CellCoord.x<0) or (CellCoord.y<0) then Exit;
      if not IsoMap.FIsoMap.IsState(CellCoord.X,CellCoord.Y,[tsselected]) then Exit;
      if MainForm.Erase.Down then
          AddAction(cellcoord.X,CellCoord.Y,l,-1,SetImage)
      else
          AddAction(cellcoord.X,CellCoord.Y,l,Images.IG.Row-1,SetImage);
      isomap.DrawIsoMap;
    end;
  end;
end;

procedure TMDIChild.OKClick(Sender: TObject);
var s : string;
begin
  if (IsoMap.ImageCount=0) then
  begin
      ShowMessage('This file has no Image list. Load Image First');
      Exit;
  end;
  IsoMap.MapName := MapName1.Text;
  s := ExtractFilePath(Caption);
  s := s + MapName1.Text;
  Caption := s;
  IsoMap.SetMapSize(strtoint(MapWidth.Text),StrToInt(MapHeight.Text));
  IsoMap.SetCellSize(StrToInt(CellWidth.Text),StrToInt(CellHeight.Text));

  Isomap.visible := true;
  IsoMap.Left := 0;
  IsoMap.Top := 0;
  VertScrollBar.Range := IsoMap.MapWidth * IsoMap.CellWidth;
  HorzScrollBar.Range := IsoMap.MapHeight * IsoMap.CellHeight;
  IsoMap.SetBackgroundColor(clRed);
  IsoMap.Cls;
//  FormActivate(Sender);
end;

procedure TMDIChild.ModIso(Sender: TObject);
begin
      IsoMap.Visible := False;
end;

procedure TMDIChild.FormResize(Sender: TObject);
begin
  IsoMap.FIsoMap.AddAllState([tsDirty]);
  isomap.DrawIsoMap;
end;

procedure TMDIChild.FormDestroy(Sender: TObject);
begin
  MainForm.ActiveChild := nil;
end;

procedure TMDIChild.ColorProgress(PercentDone: integer);
begin
  MainForm.StatusCoord := inttostr(PercentDone)+'%';
  Application.ProcessMessages;
end;

procedure TMDIChild.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
//  diagnostics.Visible :=true;
  isomap.XOffset := HorzScrollBar.Position; //set the internal engine world offset
  isomap.yoffset := VertScrollBar.Position;
  IsoMap.ScrollXOffset := HorzScrollBar.Position; // set the screen offset