isoengine.pas

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

unit IsoEngine;
{****************************************************************************
     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.
                     Michael Wilson of No. 2 Games Inc.
     (sign your name here)
******************************************************************************}

interface

uses
  Classes, Graphics, Controls, windows,comctrls,sysutils,
{$ifdef debug}
  diag,
{$endif}
    IsoMath,menus;

{$define V1_1 }
{$define V1_2 }// V1_1 must also be defined if this is defined

const NoVersion = '';
      Version1 = 'IsoEngine Version 1.0';
      Version1_1 = 'IsoEngine Version 1.1';
      Version1_2 = 'IsoEngine Version 1.2';
      Version2 = 'IsoEngine Version 2.0';
type

  TCellStyle = byte; // [0..255] kinds of Cells



  // a cell has an overall state, we've defined a few, but left the bulk for you
  TCellState = set of ( // Cell states
    tsGround,           // always displayed under sprites
    tsFog,              // fogged cell
    tsPassable,        // can be traversed
    tsRough,           // rough terrain
    tsSelected,         // selected for editor
    tsEnabled,          // enabled/disable for toggles
    tsVisible,          // you may want to hide a Cell
    ts3d,               // if a 3d grid, some cells may work better as not 3d
    tsDirty,          // mark a dirty cell that needs to be redrawn
    tsReserved2,        // reserved for developer's own use
    tsReserved3,        // reserved for developer's own use
    tsReserved4,        // reserved for developer's own use
    tsReserved5,        // reserved for developer's own use
    tsReserved6,        // reserved for developer's own use
    tsReserved7,        // reserved for developer's own use
    tsReserved8,        // reserved for developer's own use
    tsReserved9,        // reserved for developer's own use
    tsReserved10,        // reserved for developer's own use
    tsReserved11,        // reserved for developer's own use
    tsReserved12,        // reserved for developer's own use
    tsReserved13,        // reserved for developer's own use
    tsReserved14,        // reserved for developer's own use
    tsReserved15,        // reserved for developer's own use
    tsReserved16,        // reserved for developer's own use
    tsReserved17,        // reserved for developer's own use
    tsReserved18,        // reserved for developer's own use
    tsReserved19,        // reserved for developer's own use
    tsReserved20,        // reserved for developer's own use
    tsReserved21,        // reserved for developer's own use
    tsReserved22,        // reserved for developer's own use
    tsReserved23,        // reserved for developer's own use
    tsReserved24,        // reserved for developer's own use
    tsReserved25,        // reserved for developer's own use
    tsReserved26,        // reserved for developer's own use
    tsReserved27,        // reserved for developer's own use
    tsReserved28        // reserved for developer's own use
    );

type
  // a typical cell has a number of images making it up
  // the images are stored in one central location and index by the following record.
  // This was made a record to keep things easier to add in the future.
  TIsoLayer = record
    ImageIndex : integer; // simple image # to represent the Cell
  end;


  TIsoCell = record
    ImageIndexes : array of TIsoLayer;  // array of indexes of images
    AlwaysDisplayFrom, AlwaysDisplayTo, // these layers are always displayed in order
    AnimateFrom, AnimateTo, //  These layers are animated (eg tree swaying)
    AnimateNext,            //  is the next animated layer to be shown
    AnimateSpeed,           //  Number of times per heartbeat an animation changes
    AnimateCount            //  counter of the animation when 0 next layer is animated and
                            //  AnimateNext is updated
               : Integer;
    Style      : TCellStyle; // what kind of Cell (land, water, door, etc.)
    State      : TCellState; // what state of Cell (selected, disabled, off, etc.)
    CommentID : Integer;  //index into comment strings
  end;


type
  TIsoRenderOptions = set of (// render options
    ro3D,
    roIsoMap, // render with map visible
    roLayer1, // possibly add
    roLayer2, // multi layer maps
    roLayer3, // later on
    roSprites); // render with sprites visible

type
  TIsoMapData = array of array of TIsoCell; // 2d dynamic array for map sizing

  // we define several event types here

  // used in mapping an image to a color
  TIsoGetPixelEvent = procedure(ImageIndex,x,y : integer;
                     var color : TColor) of object;

  // When a cell is to be drawn with a grid around it, this event is triggered.
  // if the animation < 0 a solid grid is expected, otherewise a cyle of 0..3 animations
  TIsoDrawGrid = procedure(x,y : TGridInt; animation : integer) of object;

  // if the engine is requesting information from on of it's decendants
  // these events are triggered. The result is returned by use of the var parameter
  TIsoGetIntEvent = procedure(var  ResultInt : integer) of Object;
  TIsoGetBooleanEvent = procedure(var ResultBoolean : Boolean) of Object;
  TIsoGetImageTransparentColor = procedure(Index : Integer; var Color : TColor)of object;
  TIsoSetImageTransparentColor = procedure(Index : Integer; Color : TColor) of object;
  TIsoGetImageName = procedure(Index : Integer; var Name : string) of object;
  TIsoSetImageName = procedure(Index : Integer; Name : string) of object;
  TIsoGetImgIntEvent = procedure(ImageIndex : integer; var ResultInt : integer)
                    of Object;
  TIsoGetImgBooleanEvent = procedure(ImageIndex : integer; var ResultBoolean : Boolean)
                    of Object;

  // this event is used to call a decended for stream handling. The version is passed in
  // order for newer versions to support older versions
  TIsoStreamEvent = procedure(Stream : TStream; Version : string) of object;
  TIsoImageStreamEvent = procedure(Index : integer; Stream : TStream; Version : string) of object;

  // When an cell is to be updated by an image this event is triggered.
  // ImageIndex references the image, Cellx,Celly the cell, Layer is which layer is being displayed, and PatternIndex is for future use
  // x,y is the location the image should be drawn at
  TIsoDrawImageEvent = procedure(var IsoCell : TIsoCell; var ImageIndex : Integer; Cellx,Celly : TGridInt; x,y,Layer, PatternIndex : Integer) of object;

  // this event is called periodically during operations which are time consuming
  TIsoProgress = procedure(PercentDone : integer) of object;

  // this event is called when an action is to be preformed by one of the decendants. (flip or clear etc)
  TIsoCallEvent = procedure of object;


  TIsoMap = class(TCustomControl)
  private
    FShowGrid : Boolean;      // if true a grid is shown across all cells after the cells are drawn
    FCellWidth: Integer;      // the width of each cell
    FCellHeight: Integer;     // the height of each cell
    FCellWidthDiv2 : Integer;   // speed up calculations by having this precaluclated
    FCellHeightDiv2 : Integer;
    FMapWidth: Integer;       // the number of cells wide and high
    FMapHeight: Integer;
    FXOffset: Integer;        // Current left, top location that map is being viewed.
    FYOffset: Integer;
    FActiveLayer : Integer;   // current layer being acted upon,
    FImageColors : array of TColor; // the colors used to draw the overview of the map
    FComments : array of string;   // comments
    FOptions: TIsoRenderOptions;
    FGetPixel : TIsoGetPixelEvent;
    FGetImageWidth : TIsoGetImgIntEvent;
    FGetImageHeight : TIsoGetImgIntEvent;
    FGetSurfaceWidth : TIsoGetIntEvent;
    FGetSurfaceHeight : TIsoGetIntEvent;
    FSaveImageListToStream : TIsoStreamEvent;
    FLoadImageListFromStream : TIsoStreamEvent;
    FLoadBmpFromStream : TIsoImageStreamEvent;
    FSaveBmpToStream : TIsoImageStreamEvent;
//    FLoadUserData : TIsoStreamEvent;
//    FSaveUserData : TIsoStreamEvent;
    FGetImageCount : TIsoGetIntEvent;
    FCanDraw : TIsoGetBooleanEvent;
    FLayerVisible : TIsoGetImgBooleanEvent;
    FDrawImage : TIsoDrawImageEvent;
    FDrawGrid : TIsoDrawGrid;
    FFlip : TIsoCallEvent;
    FCls : TIsoCallEvent;
    FProgress : TIsoProgress;
    FInitialize : TNotifyEvent;
    FMapName : String;
    FSaveUserDataToStream: TIsoStreamEvent;
    FLoadUserDataFromStream: TIsoStreamEvent;
    FGetImageTransparentColor : TIsoGetImageTransparentColor;
    FSetImageTransparentColor : TIsoSetImageTransparentColor;
    FGetImageName : TIsoGetImageName;
    FSetImageName : TIsoSetImageName;
    FBruteForce : boolean;
    procedure SetCellHeight(const Value: Integer);
    procedure SetCellWidth(const Value: Integer);
    procedure SetImageString(ImageIndex: integer; const Value: string);
    function GetImageString(ImageIndex: integer) : string;
    function _GetCoordCell(c: TCellsCoord): TIsoCell;
    function AddComment(s : string) : Integer;  // return the index into FComments
    function GetComment(i : Integer) : string;
    function GetCellComment(x, y: TGridInt): string; // return the fcomment[i]
    procedure SetCellComment(x,y : TGridInt; s : string);
//  Draw Map Private Procedures
    procedure CheckForDirtyCells;
    procedure MarkDirty(x,y: integer);  // mark any cells that are overlapped from this image
    function CheckForDirtyOverlap(x,y,l : integer) : boolean; // check to see if we are overlapping any dirty cells
    procedure CountDirtyCells;
    procedure SetXOffset(const Value: Integer);
    procedure SetYOffset(const Value: Integer);  // this isn't neeed but is nice to have for stats sake

  public
    IsoMap: TIsoMapData; // the map
    FImageStrings : array of String;
    ScrollXOffset,      // these two show the physical pixel displacment between the isoworld and the screen
    ScrollYOffset : Integer;
    DirtyCount,DrawCount : Integer;
    procedure UpdateArea(p1,p2 : TPoint); overload;
    procedure UpdateArea(x1,y1,x2,y2 : integer); overload;
    procedure SaveImageListToStream(s : TStream; Version : string); virtual;
    procedure LoadImageListFromStream(s : TStream; Version : String); virtual;
    procedure SaveBmpToStream(Index : integer; s : TStream; Version : string); virtual;
    procedure LoadBmpFromStream(Index : integer; s : TStream; Version : String); virtual;
    procedure SaveUserDataToStream(s : TStream; Version : string); virtual;
    procedure LoadUserDataFromStream(s : TStream; Version : String); virtual;
    function GetCanDraw: boolean; virtual;
    function GetLayerVisible(Layer : Integer) : Boolean; virtual;
    procedure DrawImage(var IsoCell : TIsoCell; var ImageIndex : Integer;cellx,celly : TGridInt; x,y,Layer, PatternIndex : Integer); virtual;
    procedure DrawGrid(x,y: TGridInt; Animation : integer); virtual;
    procedure Flip; virtual;
    procedure Cls; virtual;
    function GetPixel(ImageIndex,x,y : integer) : TColor; virtual;
    function GetImageWidth(ImageIndex : integer) : integer; virtual;
    function GetImageHeight(ImageIndex : integer) : integer; virtual;
    function GetSurfaceWidth : integer; virtual;
    function GetSurfaceHeight : integer; virtual;
    function GetImageCount : integer; virtual;
    function LayerCount : Integer; virtual;
    procedure AppendLayer;
    procedure SwapLayers(L1,l2 : Integer);
    procedure SwapImages(i1,i2 : Integer);
//    procedure SetParent(AParent: TWinControl); virtual;

    function _GetCell(x,y : TGridInt) : TIsoCell;
    function _GetImageColor(ImageIndex : Integer) : TColor;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ClearIsoMap(Image: integer = -1); // clear entire map (default to -1)
    procedure DrawIsoMap; // draw map clipped to the width/height
                                                 // of the surface with the current XOffset/YOffset
                                                 // as the upperleft corner
    function ReadStr(Stream : TStream) : string;
    procedure WriteStr(Stream : TStream; s : string);
    procedure ResetImageColors;
    procedure GetVisibleCorners(var MinX,MinY,MaxX,MaxY : Integer);
    procedure LoadMapFromStream(s : TStream); // old style map
    procedure LoadFromStream(S: TStream);
    procedure SaveToStream(S: TStream);
    procedure LoadFromFile(filename: string);
    procedure SaveToFile(filename: string);
    function PointAt(x,y : TGridInt) : TPoint;
    function CellAt(Point: TPoint): TCellsCoord; overload;// what Cell is at a point in the "world"
    function CellAt(x,y : integer): TCellsCoord; overload;// what Cell is at a point in the "world"
    function CellAtSurface(Point: TPoint): TCellsCoord; // what Cell is at a point on the surface
    function CellStyleAt(Point: TPoint): TCellStyle; // what Cell is at a point in the "world"
    function CellStyleAtSurface(Point: TPoint): TCellStyle; // what Cell is at a point on the surface
    function GetCell(x,y : TGridInt) : TIsoCell; overload;
    function GetCell(GridPoint : TCellsCoord) : TIsoCell; overload;
    procedure SetAllState(state : TCellState);
    procedure AddAllState(state : TCellState);
    procedure SubAllState(state : TCellState);
    procedure FillAllStateImage(state : TCellState; ImageIndex,Layer : Integer);
    procedure FillAllImageState(state : TCellState; ImageIndex,Layer : Integer);
    procedure AddAllStateState(TestState,SetState: TCellState);
    function IsState(x,y : TGridInt; state : TCellState) : boolean;
    function AddState(x,y : TGridInt; state : TCellState) : TCellState;
    function SubState(x,y : TGridInt; state : TCellState) : Tcellstate;
    function NotState(x,y : TGridInt; state : TCellState) : TCellState;
    procedure SetMapSize(MaxX,MaxY :TGridInt);
    property Cell[X,Y : TGridInt] :TIsoCell  read _GetCell;  default;
    property CellComment[x,y : TGridInt] : string read GetCellComment Write SetCellComment;
    property CellsCoord[c : TCellsCoord] : TIsoCell read _GetCoordCell;
    property ImageColor[ImageIndex : Integer] : TColor read _GetImageColor;
    property CanDraw : boolean read GetCanDraw;
    property LayerVisible[Layer : integer] : Boolean read GetLayerVisible;
    property ImageStrings[ImageIndex : integer] : string read GetImageString write SetImageString;
  published
    property MapName : string read FMapname Write fmapname;
    property ActiveLayer : Integer read FActiveLayer Write FActiveLayer;
    property OnInitialize : TNotifyEvent read FInitialize Write FInitialize;
    property OnCanDraw : TIsoGetBooleanEvent read FCanDraw write FCanDraw;
    property OnLayerVisible : TIsoGetImgBooleanEvent read FLayerVisible Write FLayerVisible;
    property OnSaveImageListToStream : TIsoStreamEvent  read FSaveImageListToStream write FSaveImageListToStream;
    property OnLoadImageListFromStream : TIsoStreamEvent  read FLoadImageListFromStream write FLoadImageListFromStream;
    property OnLoadBmpFromStream : TIsoImageStreamEvent read FLoadBmpFromStream Write FLoadBmpFromStream;
    property OnSaveBmpToStream : TIsoImageStreamEvent read FSAvebmptostream Write fsavebmpToStream;
    property OnSaveUserDataToStream: TIsoStreamEvent read FSaveUserDataToStream write FSaveUserDataToStream;
    property OnLoadUserDataFromStream : TIsoStreamEvent read FLoadUserDataFromStream write FLoadUserDataFromStream;
    property OnDrawImage : TIsoDrawImageEvent read FDrawImage write FDrawImage;
    property OnDrawGrid : TIsoDrawGrid read FDrawGrid write FDrawGrid;
    property OnFlip : TIsoCallEvent read FFlip Write FFlip;
    property OnCls: TIsoCallEvent read Fcls Write FCls;
    property OnProgress : TIsoProgress read FProgress write FProgress;
    property OnGetPixel: TIsoGetPixelEvent read FGetPixel write FGetPixel;
    property OnGetImageWidth : TIsoGetImgIntEvent read FGetImageWidth write FGetImageWidth;
    property OnGetImageHeight : TIsoGetImgIntEvent read FGetImageHeight write FGetImageHeight;
    property OnGetSurfaceWidth : TIsoGetIntEvent read FGetSurfaceWidth write FGetSurfaceWidth;
    property OnGetSurfaceHeight : TIsoGetIntEvent read FGetSurfaceHeight write FGetSurfaceHeight;
    property OnGetImageCount : TIsoGetIntEvent read FGetImageCount write FGetImageCount;
    property CellWidth: Integer read FCellWidth write SetCellWidth;
    property CellHeight: Integer read FCellHeight write SetCellHeight;
    property ShowGrid : Boolean read FShowGrid Write fshowgrid;
    property MapWidth: Integer read FMapWidth;
    property MapHeight: Integer read FMapHeight;
    property XOffset: Integer read FXOffset write SetXOffset;
    property YOffset: Integer read FYOffset write SetYOffset;
    property RenderOptions: TIsoRenderOptions read FOptions write FOptions;
    property OnGetImageName :  TIsoGetImageName read FGetImageName write FGetImageName;
    property OnSetImageName :  TIsoSetImageName read FSetImageName write FSetImageName;
    property OnGetImageTransparentColor : TIsoGetImageTransparentColor read FGetImageTransparentColor write FGetImageTransparentColor;
    property OnSetImageTransparentColor : TIsoSetImageTransparentColor read FSetImageTransparentColor write FSetImageTransparentColor;
    property BruteForce : boolean read FBruteForce write FBruteForce;
  end;
    function MaxInt(a,b : integer) : integer;
    function MinInt(a,b : integer) : integer;

var gx,gy,gl : Integer;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('freeware', [TIsoMap]);
end;


function MaxInt(a,b : integer) : integer;
begin
    result := a;
    if (a<b) then result := b;
end;
function MinInt(a,b : integer) : integer;
begin
    result := a;
    if (a>b) then result := b;
end;


{ aTDXIsoMap }

procedure TIsoMap.ClearIsoMap(Image: integer);
var x,y : Integer;
begin
    for x := 0 to Length(IsoMap)-1 do
        for y := 0 to Length(IsoMap[0]) -1 do
            if (tsSelected in IsoMap[x,y].State) then
            begin
              if (Length(IsoMap[x,y].ImageIndexes) < ActiveLayer) then
                SetLength(IsoMap[x,y].ImageIndexes, ActiveLayer);
                IsoMap[x,y].ImageIndexes[ActiveLayer].ImageIndex := Image;
            end;
end;

constructor TIsoMap.Create(AOwner: TComponent);
begin
    inherited;
    SetLength(fImageColors,0);
end;


procedure TIsoMap.LoadFromFile(filename: string);
var f : TFileStream;
begin
  f := TFileStream.Create(FileName,fmOpenRead);
  try
    LoadFromStream(f);
  finally
    f.Free;
  end;
end;

procedure TIsoMap.LoadFromStream(S: TStream);
var MaxX,MaxY : TGridInt;
   v : string;
   expansion : array[0..1024] of Byte;