dxisoengine.pas

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

unit DXIsoEngine;
{****************************************************************************
     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
  Classes, Graphics, Controls, IsoEngine, DXClass, DXDraws, Dib, windows,
  comctrls, sysutils, IsoMath, menus, dialogs,clipbrd,extctrls;

const ANTCOUNT = 4;
type
  // the only reason for making this little class is to expose setparent
  // which in the base class is protected
  T_DXDraw = class(TDXDraw)
  public
    procedure SetParent(AParent: TWinControl); override;
  end;


  TDXIsoMap = class(T_DXDraw)
    FIsoMap: TIsoMap;
    FImageList: TDXImageList; // a DXImageList of Cells
//    FGridImage: TDirectDrawSurface;
  private
    FFlip : TNotifyEvent;
    FBeforeFlip : TNotifyEvent;
    FCls : TIsoCallEvent;
    FSaveUserImageData : TIsoImageStreamEvent;
    FLoadUserImageData : TIsoImageStreamEvent;
//    FGridAnts : array [0..ANTCOUNT] of TDirectDrawSurface;
    FGridAnts : TDXImageList;
    function GetLoadUserData: TIsoStreamEvent;
    function GetSaveUserData: TIsoStreamEvent;
    procedure SetLoadUserData(const Value: TIsoStreamEvent);
    procedure SetSaveUserData(const Value: TIsoStreamEvent);
    function GetFlip: TNotifyEvent;
    procedure SetFlip(const Value: TNotifyEvent);
    function GetBeforeFlip: TNotifyEvent;
    procedure SetBeforeFlip(const Value: TNotifyEvent);
    function GetCls: TIsoCallEvent;
    procedure SetCls(const Value: TIsoCallEvent);
    function GetScrollXOffset: Integer;
    function GetScrollYOffset: Integer;
    procedure SetScrollXOffset(const Value: Integer);
    procedure SetScrollYOffset(const Value: Integer);
    function GetImageName(ImageIndex: integer): string;
    function GetImageTransparentColor(ImageIndex: integer): TColor;
    procedure _GetImageName(ImageIndex: integer; var Name : string);
    procedure _GetImageTransparentColor(ImageIndex: integer; var Color: TColor);
  private
    FDrawImage : TIsoDrawImageEvent;
    function GetCellHeight: Integer;
    function GetCellWidth: Integer;
    function GetMapHeight: Integer;
    function GetMapWidth: Integer;
    function GetRenderOptions: TIsoRenderOptions;
    function GetXOffset: Integer;
    function GetYOffset: Integer;
    procedure SetRenderOptions(const Value: TIsoRenderOptions);
    procedure SetXOffset(const Value: Integer);
    procedure SetYOffset(const Value: Integer);
    function GetImageCount: integer;
    procedure _CanDraw(var ResultBoolean: Boolean);
    procedure GetSurfaceHeight(var ResultInt: Integer);
    procedure GetSurfaceWidth(var ResultInt: Integer);
    function GetCanDraw: boolean;
    function GetOnProgress: TIsoProgress;
    procedure SetOnProgress(const Value: TIsoProgress);
    function GetIsoExt: string;
    function GetMapName: string;
    procedure SetMapName(const Value: string);
    function GetOnLayerVisible: TIsoGetImgBooleanEvent;
    procedure SetOnLayerVisible(const Value: TIsoGetImgBooleanEvent);
    function GetImage(x, y, l: TGridInt): TCollectionItem;
    procedure _DrawImage(var IsoCell : TIsoCell; var ImageIndex : integer; cellx,celly : TGridInt;x, y, layer,PatternIndex: Integer);
    procedure DrawGrid(x,y,Animation : integer);
    procedure Flip;
    procedure BeforeFlip;
    function GetPixel(ImageIndex, x, y: integer): TColor;
    function GetImageWidth(ImageIndex: integer): integer;
    function GetImageHeight(ImageIndex: integer): integer;
    function _GetCell(x, y: TGridInt): TIsoCell;
    function _GetImageColor(ImageIndex: Integer): TColor;
    procedure ResetImageColors();
    procedure SetImageTransparentColor(Index : Integer; Color : TColor);
    procedure SetImageName(Index : Integer; Name : string);
    procedure _GetImageCount(var ResultInt: Integer);
    procedure _GetImageHeight(ImageIndex: Integer; var ResultInt: Integer);
    procedure _GetImageWidth(ImageIndex: Integer; var ResultInt: Integer);
    procedure _GetPixel(ImageIndex, x, y: Integer; var color: TColor);
    procedure _LoadImageListFromStream(Stream: TStream; Version: string);
    procedure _SaveImageListToStream(Stream: TStream; Version: string);
    procedure _LoadBMPFromStream(Index : Integer; Stream : TStream; Version : string);
    procedure _SaveBMPToStream(Index : Integer; Stream : TStream; Version: string);
    {
    procedure _DrawImage(var IsoCell : TIsoCell; ImageIndex, cellx,celly : TGridInt;x, y, PatternIndex: Integer);
    procedure _GetSurfaceHeight(var ResultInt: Integer);
    procedure _GetSurfaceWidth(var ResultInt: Integer);
}

  public
    BackGroundColor: integer;
    constructor Create(AOwner: TComponent); override;
    function CellAt(Point: TPoint): TCellsCoord; // 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 SetMapSize(MaxX, MaxY: TGridInt);
    procedure SetCellSize(const Width, Height: Integer);

    procedure SetBackgroundColor(c: TColor);
    procedure DrawImage(var IsoCell : TIsoCell; var ImageIndex : integer; cellx,celly : TGridInt;x, y, layer,PatternIndex: Integer);
    function ReadStr(Stream: TStream): string;
    procedure WriteStr(Stream: TStream; s: string);

procedure RestoreGridAnts;
    procedure LoadImageListFromStream(s: TStream);
    procedure SaveImageListToStream(s: TStream);

    procedure SaveToFile(filename: string);
    procedure SaveToStream(S: TStream);
    procedure LoadMapFromStream(s: TStream);
    procedure LoadFromStream(S: TStream);
    procedure LoadFromFile(filename: string);
    procedure ClearIsoMap(Image: integer = -1); // clear entire map (default to -1)
    procedure Cls; // clear the screen to background colour
    procedure DrawIsoMap(); // draw map clipped to the width/height
                          // of the surface with the current XOffset/YOffset
                         // as the upperleft corner
    property Image[X, Y, L: TGridInt]: TCollectionItem read GetImage;
    property Cell[X, Y: TGridInt]: TIsoCell read _GetCell;
    property CanDraw: boolean read GetCanDraw;
    property ImageColor[ImageIndex: Integer]: TColor read _GetImageColor;
    property ImageHeight[ImageIndex: integer]: integer read GetImageHeight;
    property ImageWidth[ImageIndex: integer]: integer read GetImageWidth;
    property ImageName[ImageIndex: integer] : string read GetImageName Write SetImageName;
    property ImageTransparentColor[ImageIndex: integer] : TColor read GetImageTransparentColor Write SetImageTransparentColor;
  published
//     property IsoMap : TIsoMap read FIsoMap;
    property MapName : string read GetMapName Write SetMapName;
    property OnLayerVisible : TIsoGetImgBooleanEvent read GetOnLayerVisible write SetOnLayerVisible;
    property OnDrawImage : TIsoDrawImageEvent read FDrawimage write FDrawImage;
    property OnProgress: TIsoProgress read GetOnProgress write SetOnProgress;
    property OnFlip : TNotifyEvent read GetFlip Write SetFlip;
    property OnCls : TIsoCallEvent read GetCls write SetCls;
    property OnBeforeFlip : TNotifyEvent read GetBeforeFlip Write SetBeforeFlip;
    property ImageCount: integer read GetImageCount;
    property CellWidth: Integer read GetCellWidth;
    property CellHeight: Integer read GetCellHeight;
    property MapWidth: Integer read GetMapWidth;
    property MapHeight: Integer read GetMapHeight;
    property XOffset: Integer read GetXOffset write SetXOffset;
    property YOffset: Integer read GetYOffset write SetYOffset;
    property ScrollXOffset : Integer read GetScrollXOffset Write SetScrollXOffset;
    property ScrollYOffset : Integer read GetScrollYOffset Write SetScrollYOffset;
    property RenderOptions: TIsoRenderOptions read GetRenderOptions write SetRenderOptions;
    property Ext : string read GetIsoExt;
    property OnSaveUserDataToStream: TIsoStreamEvent read GetSaveUserData write SetSaveUserData;
    property OnLoadUserDataFromStream : TIsoStreamEvent read GetLoadUserData write SetLoadUserData;
    property OnSaveUserImageData : TIsoImageStreamEvent read FSaveUserImageData write FSaveUserImageData;
    property OnLoadUserImageData : TIsoImageStreamEvent read FLoadUserImageData write FLoadUserImageData;
  end;




procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('DelphiX', [TDXIsoMap]);
end;

{ T_DXDraw }

procedure T_DXDraw.SetParent(AParent: TWinControl);
begin
  inherited;
end;

{ TDXIsoMap }

function TDXIsoMap.CellAt(Point: TPoint): TCellsCoord;
begin
  Result := FIsoMap.CellAt(Point);
end;

function TDXIsoMap.CellAtSurface(Point: TPoint): TCellsCoord;
begin
  result := FIsoMap.CellAtSurface(Point);
end;

function TDXIsoMap.CellStyleAt(Point: TPoint): TCellStyle;
begin
  result := FIsoMap.CellStyleAt(Point);
end;

function TDXIsoMap.CellStyleAtSurface(Point: TPoint): TCellStyle;
begin
  result := FIsoMap.CellStyleAtSurface(Point);
end;

procedure TDXIsoMap.ClearIsoMap(Image: integer);
begin
  FIsoMap.ClearIsoMap(Image);
end;

constructor TDXIsoMap.Create(AOwner: TComponent);
begin
  inherited;
  FImageList := TDXImageList.Create(Self);
  FGridAnts := TDXImageList.Create(Self);
  FImageList.DXDraw := Self;
  FGridAnts.DXDraw := Self;
  FIsoMap := TIsoMap.Create(self);
  FIsoMap.OnCanDraw := _CanDraw;
  FIsoMap.OnDrawImage := _DrawImage;
  FIsoMap.OnDrawGrid := DrawGrid;
  FIsoMap.OnFlip := BeforeFlip;
  FIsoMap.OnCls := cls;
  FIsoMap.OnGetImageCount := _GetImageCount;
  FIsoMap.OnGetImageHeight := _GetImageHeight;
  FIsoMap.OnGetImageWidth := _GetImageWidth;
  FIsoMap.OnGetPixel := _GetPixel;
  FIsoMap.OnGetSurfaceHeight := GetSurfaceHeight;
  FIsoMap.OnGetSurfaceWidth := GetSurfaceWidth;
  FIsoMap.OnLoadImageListFromStream := _LoadImageListFromStream;
  FIsoMap.OnSaveImageListToStream := _SaveImageListToStream;
  FIsoMap.OnLoadBmpFromStream := _LoadBMPFromStream;
  FIsoMap.OnSaveBmpToStream := _SaveBMPToStream;
  FIsoMap.OnGetImageTransparentColor := _GetImageTransparentColor;
  FIsoMap.OnSetImageTransparentColor := SetImageTransparentColor;
  FIsoMap.OnGetImageName := _GetImageName;
  FIsoMap.OnSetImageName := SetImageName;
  BackGroundColor := self.Surface.ColorMatch(clRed);
end;

procedure TDXIsoMap.cls;
begin
  if (assigned(FCls)) then
    FCls;
  self.Surface.Fill(BackGroundColor); // clear screen ready for next drawing
  flip;
  self.Surface.Fill(BackGroundColor); // clear screen ready for next drawing
end;

procedure TDXIsoMap.Flip;
begin
  if assigned(FFlip) then
    FFlip(self);

  begin
    TDXDraw(Self).Flip;
    Self.Surface.Canvas.Release;
  end;
end;

procedure TDXIsoMap.DrawImage(var IsoCell : TIsoCell; var ImageIndex : integer; cellx,celly : TGridInt;x, y, layer,PatternIndex: Integer);
begin
  if (ImageIndex<0) then exit;
  // the following line is probably safer, but we are looking for any bit of speed we can get
//  if not (FImageList.Items[ImageIndex] is TPictureCollectionItem) then Exit;
  FImageList.Items[ImageIndex].Draw(Surface,x,y,PatternIndex);
end;


// if OnDrawImage is assigned then the user get's first crack at drawing the image
// if on return ImageIndex is -1 then the Image is not drawn by the IsoEngine.
procedure TDXIsoMap._DrawImage(var IsoCell : TIsoCell; var ImageIndex : integer; cellx,celly : TGridInt;x, y, layer,PatternIndex: Integer);
begin
  if (Assigned(FDrawImage)) then
    FDrawImage(IsoCell,ImageIndex,cellx,celly,x,y,layer,PatternIndex);
  if (ImageIndex<0) then exit;
  DrawImage(IsoCell,ImageIndex,cellx,celly,x,y,layer,patternindex);
end;

procedure TDXIsoMap.DrawIsoMap;
begin
  FIsoMap.DrawIsoMap;
end;

function TDXIsoMap.GetCanDraw: boolean;
begin
  Result := TDXDraw(Self).CanDraw;
end;

function TDXIsoMap.GetCell(GridPoint: TCellsCoord): TIsoCell;
begin
  Result := FIsoMap.GetCell(GridPoint);
end;

function TDXIsoMap.GetCell(x, y: TGridInt): TIsoCell;
begin
  Result := FIsoMap.GetCell(x, y);
end;

function TDXIsoMap.GetCellHeight: Integer;
begin
  result := FIsoMap.CellHeight;
end;

function TDXIsoMap.GetCellWidth: Integer;
begin
  result := FIsoMap.CellWidth;
end;

function TDXIsoMap.GetImage(x, y, l: TGridInt): TCollectionItem;
begin
  result := FImageList.Items[FIsoMap[x, y].ImageIndexes[l].ImageIndex];
end;

function TDXIsoMap.GetImageHeight(ImageIndex: integer): integer;
begin
    result := FImageList.Items[ImageIndex].Height
end;

function TDXIsoMap.GetImageWidth(ImageIndex: integer): integer;
begin
  result := FImageList.Items[ImageIndex].Width;
end;

function TDXIsoMap.GetMapHeight: Integer;
begin
  result := FIsoMap.MapHeight;
end;

function TDXIsoMap.GetMapWidth: Integer;
begin
  result := FIsoMap.MapWidth;
end;

function TDXIsoMap.GetPixel(ImageIndex, x, y: integer): TColor;
begin
  result := FImageList.Items[ImageIndex].PatternSurfaces[0].Canvas.Pixels[x, y];
  FImageList.Items[ImageIndex].PatternSurfaces[0].Canvas.Release; // Is this needed?
end;

function TDXIsoMap.GetRenderOptions: TIsoRenderOptions;
begin
  result := FIsoMap.RenderOptions;
end;

function TDXIsoMap.GetXOffset: Integer;
begin
  result := FIsoMap.XOffset;
end;

function TDXIsoMap.GetYOffset: Integer;
begin
  result := FIsoMap.YOffset;
end;

procedure TDXIsoMap.LoadFromFile(filename: string);
begin
  FIsoMap.LoadFromFile(FileName);
end;

procedure TDXIsoMap.LoadFromStream(S: TStream);
begin
  FIsoMap.Loadfromstream(S);
end;

procedure TDXIsoMap.LoadImageListFromStream(s: TStream);
begin
  fImagelist.Items.LoadFromStream(S);
  ResetImageColors;
  fImageList.Items.MakeColorTable;
  ColorTable := fimageList.Items.ColorTable;
  DefColorTable := fImageList.Items.ColorTable;
end;

procedure TDXIsoMap.LoadMapFromStream(s: TStream);
begin
  FIsoMap.LoadMapFromStream(s);
end;

function TDXIsoMap.ReadStr(Stream: TStream): string;
begin
  Result := FIsoMap.ReadStr(Stream);
end;

procedure TDXIsoMap.ResetImageColors;
begin
  FIsoMap.ResetImageColors;
end;

procedure TDXIsoMap.SaveImageListToStream(s: TStream);
begin