⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 一款RPG游戏的引擎可以自己制作一款RPG游戏的引擎可以自己制作
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, { Dialogs,}
  DXClass, ExtCtrls, StdCtrls, DIB,
{$Ifdef GLWorking}
  OpenGLIsoEngine,
{$else}
  Dialogs,
{$endif}
  DXIsoEngine,IsoEngine, DXDraws,IsoMath;

const
  frameskip = 1;
  BASEIMAGE = 3; 

type
  TMainForm = class(TDXForm)
    DXTimer: TDXTimer;
    DXImageList: TDXImageList;
    Label1: TLabel;
    res: TComboBox;
    bevel: TBevel;
    nfo: TMemo;
    go: TButton;
    url: TLabel;
    flip: TCheckBox;
    Vmem: TCheckBox;
    DisplayMethod: TRadioGroup;
    procedure DXDrawInitialize(Sender: TObject);
    procedure goClick(Sender: TObject);
    procedure DXDrawFinalize(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
    procedure BeforeFlipSprites(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
{$Ifdef GLWorking}   { TODO : Get OpenGL working in example program. }
    GLDraw: TOpenGLIsoMap;
{$endif}
    DxDraw: TDXIsoMap; { TODO : Make a common interface class so that either directx or opengl can be used }
    h,v,mx, my: integer; // mouse co-ords
    kup, kdown, kleft, kright: boolean; // basic keyboard input
    sgx,sgy,sgv,jx, jy, jv : single;
    sgCell,JeepCell : TCellsCoord;
    sga,ja: byte;
    procedure DrawImage(var IsoCell : TIsoCell; var ImageIndex: integer; cellx,celly : TGridInt;x, y, layer,PatternIndex: Integer);
    function CellsAjacent(c1x,c1y,c2x,c2y : integer) : boolean;
    procedure DXIsoCreate;
    procedure GLIsoCreate;

  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.GLIsoCreate;
var i : integer;
begin
{$ifdef GLWorking}
  // *** Manual setup of OpenGLIsoEngine until "VCLed"
  GLDraw := TOpenGLIsoMap.Create(self);
  GLDraw.SetParent(self);
  GLDraw.Align := alClient;
  GLDraw.Initialize;
  GLDraw.Visible := False;
  GLDraw.OnInitialize := GLDrawInitialize;
  GLDraw.OnFinalize := GLDrawFinalize;
  GLDraw.OnBeforeFlip := BeforeFlipSprites;
  GLDraw.OnDrawImage := DrawImage;
  Self.Cursor := crNone;
  GLDraw.Cursor := crNone; // this doesn't work

  // *** Load Map from Disk ***

  GLDraw.LoadFromFile('campground.dxm');

  // *** push tiles to video memory ***

  if vmem.Checked then
    for i := 0 to GLDraw.FImageList.Items.Count - 1 do
    begin
      GLDraw.FImageList.Items[i].SystemMemory := false;
      GLDraw.FImageList.Items[i].Restore;
    end;

  // *** last of setup **
  GLDraw.FIsoMap.SubAllState([tsSelected]);
  GLImageList.Items.MakeColorTable; // if you use 256 color images for everything
  GLImageList.GLDraw := GLDraw;
  res.ItemIndex := 3; // set default resolution
  randomize;
{$endif}
end;
procedure TMainForm.DXIsoCreate;
var i: integer;
begin

  // *** Manual setup of DXIsoEngine until "VCLed"

  DXDraw := TDXIsoMap.Create(self);
  DXDraw.SetParent(self);
  DXDraw.Align := alClient;
  DXDraw.Initialize;
  DXDraw.Visible := False;
  DXDraw.OnInitialize := DXDrawInitialize;
  DXDraw.OnFinalize := DXDrawFinalize;
  DxDraw.OnBeforeFlip := BeforeFlipSprites;
  DxDraw.OnMouseMove :=FormMouseMove;
  DxDraw.OnMouseDown := FormMouseDown;
  DxDraw.OnDrawImage := DrawImage;
  Self.Cursor := crNone;
  DXDraw.Cursor := crNone; // this doesn't work

  // *** Load Map from Disk ***

  DxDraw.LoadFromFile('campground.dxm');

  // *** push tiles to video memory ***

  if vmem.Checked then
    for i := 0 to DXDraw.FImageList.Items.Count - 1 do
    begin
      DXDraw.FImageList.Items[i].SystemMemory := false;
      DXDraw.FImageList.Items[i].Restore;
    end;
  DxDraw.FIsoMap.SubAllState([tsSelected]);
  // *** last of setup **
  DXImageList.Items.MakeColorTable; // if you use 256 color images for everything
  DxDraw.BackGroundColor := clred;
  DXImageList.DXDraw := DxDraw;
  dxDraw.Cls;
  res.ItemIndex := 3; // set default resolution
  randomize;

end;

procedure TMainForm.DXDrawInitialize(Sender: TObject);
begin
  DxDraw.Cls;
  DXTimer.Enabled := True; // start game thread
end;

procedure TMainForm.goClick(Sender: TObject);
var
  s: string;
  i, AWidth, AHeight, ABitCount: Integer;
begin
  case DisplayMethod.ItemIndex of
  0 : DXIsoCreate;
{$ifdef GLWorking}
  1 : GLIsoCreate;
{$else}
  1 :
    begin
      showmessage('Nope, Not yet!');
      exit;
    end;
{$endif}
  end;



  nfo.Hide;
  DisplayMethod.Hide;
  label1.hide;
  res.hide;
  go.hide;
  url.hide;
  bevel.hide;
  flip.Hide;
  vmem.Hide;
  mainform.BorderStyle := bsNone; // use this to go from launch form
  Dxdraw.Align := alClient; // to full screen
  Dxdraw.Options := Dxdraw.Options + [doFlip]; // flip page
  if flip.checked then
    Dxdraw.Options := Dxdraw.Options + [doWaitVBlank]; // wait retrace

  s := res.Items.Strings[res.Itemindex];
  i := Pos('x', s);
  AWidth := StrToInt(Copy(s, 1, i - 1)); // get width
  s := Copy(s, i + 1, Length(s));
  i := Pos('x', s);
  AHeight := StrToInt(Copy(s, 1, i - 1)); // get height
  s := Copy(s, i + 1, Length(s));
  ABitCount := StrToInt(s); // and bit count
  DXDraw.Display.Width := AWidth;
  DXDraw.Display.Height := AHeight;
  DXDraw.Display.BitCount := ABitCount;
  DxDraw.BackGroundColor := clBlack;
Dxdraw.Options := Dxdraw.Options + [doFullScreen];

  sgx := 200.0;
  sgy := 200.0;
  sga := 32;
  sgv := 0.0;
  jx := 100.0;
  jy := 100.0;
  jv := 0.0;
  ja := 32;

  Dxdraw.Initialize; //  set all that up yourself then INIT
end;

procedure TMainForm.DXDrawFinalize(Sender: TObject);
begin
  DXTimer.Enabled := False;
end;

procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then // or you could go back to the launch pad
    Close;

  if (ssAlt in Shift) and (Key = VK_RETURN) then //  Screen mode change
  begin
    DXDraw.Finalize; // basic ALT-ENTER stuff
    if doFullScreen in DXDraw.Options then
    begin
      RestoreWindow;
      DXDraw.Cursor := crDefault;
      BorderStyle := bsSizeable;
      DXDraw.Options := DXDraw.Options - [doFullScreen];
    end
    else
    begin
      StoreWindow;
      DXDraw.Cursor := crNone;
      BorderStyle := bsNone;
      DXDraw.Options := DXDraw.Options + [doFullScreen];
    end;
    DxDraw.FIsoMap.AddAllState([tsDirty]);
    DXDraw.Initialize;
  end;
  if Key = VK_up then kup := true; // *** scroll up ***
  if Key = VK_down then kdown := true; // *** scroll down ***
  if Key = VK_right then kright := true; // *** scroll right ***
  if Key = VK_left then kleft := true; // *** scroll left ***
end;

procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_up then kup := false; // *** scroll up ***
  if Key = VK_down then kdown := false; // *** scroll down ***
  if Key = VK_right then kright := false; // *** scroll right ***
  if Key = VK_left then kleft := false; // *** scroll left ***
  if Key = ord('A') then h := h - 1;
  if Key = ord('S') then h := h + 1;
  if Key = ord('W') then v := v -1;
  if Key = ord('Z') then v := v + 1;
  if Key = ord('a') then h := h - 1;
  if Key = ord('s') then h := h + 1;
  if Key = ord('w') then v := v -1;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -