layerunit.pas

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

unit layerunit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, Menus, ImgList, DXDraws, ExtCtrls, StdCtrls,isoengine,util,inifiles;

type
  Tlayers = class(TForm)
    LG: TStringGrid;
    PopupMenu1: TPopupMenu;
    AddNewLayer1: TMenuItem;
    MoveLayerdown1: TMenuItem;
    MoveLayerUp1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    DXDraw1: TDXDraw;
    Panel1: TPanel;
    procedure FormShow(Sender: TObject);
    procedure LGDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
      State: TGridDrawState);
    procedure LGMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure AddNewLayer1Click(Sender: TObject);
    procedure MoveLayerdown1Click(Sender: TObject);
    procedure MoveLayerUp1Click(Sender: TObject);
    procedure LGMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormHide(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
  private
    { Private declarations }
    ACol,ARow : Integer;
  public
    { Public declarations }
  end;

var
  layers: Tlayers;

implementation

uses Main;

{$R *.DFM}

procedure Tlayers.FormShow(Sender: TObject);
var i : Integer;
begin
     LG.ColWidths[0] := LG.Canvas.TextWidth(' Visible ');
     LG.ColWidths[1] := LG.Width - (LG.ColWidths[0] + 2);
     LG.RowHeights[0] := LG.Canvas.TextHeight('Yy');
    for i := 1 to LG.RowCount do
    begin
      LG.Cells[0,i] := 'Y';
    end;
    mainform.Layers1.Checked := True;
end;

procedure Tlayers.LGDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var r : trect;
  s : string;
  df,dt,af,at,asp,x,y : Integer;
  init : Boolean;
function CentreH(s : string) : integer;
begin
  result := (rect.right + rect.left - LG.Canvas.TextWidth(s)) div 2;
end;
function CentreV(s : string) : integer;
begin
  result := (rect.Top + rect.Bottom - LG.Canvas.TextHeight(s)) div 2;
end;
procedure OutText(s : string);
begin
  LG.Canvas.TextRect(rect,CentreH(s),CentreV(s),s);
end;
procedure OutTextV(s : string; v : integer);
begin
  LG.Canvas.TextRect(rect,CentreH(s),v,s);
end;

begin
  if (MainForm.ActiveChild=nil) or (MainForm.ActiveChild.IsoMap = nil)  then Exit;
  init := False;
  df := 0; dt :=0; af:=0; at :=0;asp := 0;//avoid warnings
  for x := 0 to MainForm.Activechild.IsoMap.MapWidth-1 do
    for y := 0 to MainForm.Activechild.IsoMap.MapHeight-1 do
    begin
      if (MainForm.Activechild.IsoMap.FIsoMap.IsState(x,y,[tsSelected])) then
      begin
        if not init then
        begin
          df := MainForm.Activechild.IsoMap.FIsoMap.Cell[x,y].AlwaysDisplayFrom;
          dt := MainForm.Activechild.IsoMap.FIsoMap.Cell[x,y].AlwaysDisplayTo;
          af := MainForm.Activechild.IsoMap.FIsoMap.Cell[x,y].AnimateFrom;
          at := MainForm.Activechild.IsoMap.FIsoMap.Cell[x,y].AnimateTo;
          asp := MainForm.Activechild.IsoMap.FIsoMap.Cell[x,y].AnimateSpeed;
          init := True;
        end
        else
        begin
          if (df<>MainForm.Activechild.IsoMap.FIsoMap.Cell[x,y].AlwaysDisplayFrom) then df := -2;
          if (dt <> MainForm.Activechild.IsoMap.FIsoMap.Cell[x,y].AlwaysDisplayTo) then dt := -2;
          if (af <> MainForm.Activechild.IsoMap.FIsoMap.Cell[x,y].AnimateFrom) then af := -2;
          if (at <> MainForm.Activechild.IsoMap.FIsoMap.Cell[x,y].AnimateTo) then at := -2;
          if (asp <> MainForm.Activechild.IsoMap.FIsoMap.Cell[x,y].AnimateSpeed) then asp := -2;
        end;
      end;
    end;
  if (ARow=0) or (ACol=0) then
    LG.Canvas.Brush.Color := clBtnFace
  else
  begin
    if (LG.Row = ARow) then
      LG.Canvas.Brush.Color := clNavy
    else
      LG.Canvas.Brush.Color := clWhite;
  end;

  if ARow=0 then
  begin
    LG.Canvas.FillRect(Rect);
    LG.Canvas.Pen.Color := clBlack;
    if (ACol=0) then  outtext('Visible')
    else Outtext('Layer');
  end
  else
  begin
    if (ACol=0) then
    begin
      s := IntToStr(LG.RowCount - arow);
      LG.Canvas.FillRect(Rect);
      OutTextv(s,((REct.Top + rect.bottom) div 2) - LG.canvas.textheight(s) - 20);
      if (LG.Cells[ACol,ARow] = 'Y') then
        MainForm.ImageList1.Draw(LG.Canvas,(Rect.Left + Rect.Right) div 2 -  5,
            (Rect.Top + Rect.Bottom) div 2 - 5,38,True)
      else
        MainForm.ImageList1.Draw(LG.Canvas,(Rect.Left + Rect.Right) div 2 -  5,
            (Rect.Top + Rect.Bottom) div 2 - 5,40,True);
    end
    else
    begin
      r := rect;
      r.Bottom := r.Top + 5;
      LG.Canvas.FillRect(r);
      r := Rect;
      r.Top := r.Bottom -5;
      LG.Canvas.FillRect(r);
      r := Rect;
      r.Right := r.Left + 5;
      LG.Canvas.FillRect(r);
      r := Rect;
      r.left := r.right - 5;
      LG.Canvas.FillRect(r);

      Rect.Left := Rect.Left + 5;
      Rect.Top := Rect.Top + 5;
      Rect.Right := Rect.Right -5;
      Rect.Bottom := Rect.Bottom -5;
      LG.Canvas.CopyRect(Rect,DXDraw1.Surface.Canvas ,Rect);
      DXDraw1.Surface.Canvas.Release;
    end;
  end;
end;

procedure Tlayers.LGMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  LG.MouseToCell(X,Y,acol,arow);
  if (ACol = 0) then
  begin
    if (LG.Cells[ACol,ARow]='Y') then LG.Cells[ACol,ARow] := 'N'
    else LG.Cells[ACol,ARow] := 'Y';
    MainForm.ActiveChild.IsoMap.FIsoMap.Cls;
    MainForm.ActiveChild.IsoMap.FIsoMap.AddAllState([tsDirty]); // force whole screen to refresh

  end;
end;

procedure Tlayers.AddNewLayer1Click(Sender: TObject);
begin
  Mainform.Activechild.IsoMap.FIsoMap.AppendLayer;
  LG.RowCount := LG.RowCount+1;
  LG.cells[0,LG.RowCount] := 'Y';
  LG.Row := 1;
end;

procedure Tlayers.MoveLayerdown1Click(Sender: TObject);
begin
  if (Arow < (LG.RowCount-2)) then
    MainForm.Activechild.IsoMap.FisoMap.SwapLayers(ARow,ARow+1);
end;

procedure Tlayers.MoveLayerUp1Click(Sender: TObject);
begin
  if (Arow>2) then
    MainForm.Activechild.IsoMap.FisoMap.SwapLayers(ARow-1,ARow-2);
end;

procedure Tlayers.LGMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if focused then
    if (ShowIsoHint(4)) then
      ShowIsoHint(5);
end;

procedure Tlayers.FormCreate(Sender: TObject);
var Inifile : TInifile;
begin
  IniFile := GetInifile;
  Top := 80;
  Left := 741;
  Width := 430;
  Height := 413;
  LoadFormPosition(Self,inifile);
  IniFile.Free; // we will be probably storing other stuff eventually but this will start us off
//  DXDraw1.Initialize;
end;

procedure Tlayers.FormDestroy(Sender: TObject);
var Inifile : TInifile;
begin
  IniFile := GetInifile;
  SaveFormPosition(Self,Inifile);
  IniFile.Free;
end;

procedure Tlayers.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caMinimize;
end;

procedure Tlayers.FormHide(Sender: TObject);
begin
    mainform.Layers1.Checked := false;
end;

procedure Tlayers.FormResize(Sender: TObject);
var h,i : integer;
begin
  h := lg.Height;
  h := h - LG.RowHeights[0];
  h := h div (LG.RowCount-1);
  for i := 1 to LG.RowCount-1 do
    LG.RowHeights[i] := h;
end;

procedure Tlayers.Panel1Click(Sender: TObject);
begin
  lg.visible := not lg.visible;
  if lg.visible then
    Panel1.caption := 'The image should be copied to the string grid, but for some reason isn''t. Look in LayerUnit, Search for copyrect';
end;

end.