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

📄 editorunit1.pas

📁 一个用delphi编写的过关游戏
💻 PAS
📖 第 1 页 / 共 2 页
字号:
Unit EditorUnit1;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DXDraws, DXClass, DXInput, StdCtrls, ExtCtrls, ToolWin, ComCtrls, Menus,
  CheckLst, Buttons, ActnList;

Type
  TEditorForm = Class(TForm)
    DXTimer1: TDXTimer;
    PBMP: TDXImageList;
    DXInput1: TDXInput;
    Panel1: TPanel;
    Preview: TDXDraw;
    Scrolly: TScrollBar;
    Scrollx: TScrollBar;
    Splitter1: TSplitter;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Panel2: TPanel;
    Klosser: TDXDraw;
    KlosserScroll: TScrollBar;
    KBMP: TDXImageList;
    Panel3: TPanel;
    Layers: TCheckListBox;
    PopupMenu2: TPopupMenu;
    Frombitmap: TMenuItem;
    Fromlevel: TMenuItem;
    Panel4: TPanel;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Loadlevel1: TMenuItem;
    SaveLevel1: TMenuItem;
    N4: TMenuItem;
    ActionList1: TActionList;
    ActionLoadLevel: TAction;
    ActionSaveLevel: TAction;
    ActionOption: TAction;
    Option1: TMenuItem;
    N5: TMenuItem;
    ActionExit: TAction;
    Exit1: TMenuItem;
    Tools1: TMenuItem;
    ActionResetLevel: TAction;
    CleanLevel1: TMenuItem;
    ActionRunLevel: TAction;
    Testlevel1: TMenuItem;
    ActionShowHints: TAction;
    Hints1: TMenuItem;
    Procedure PreviewInitialize(Sender: TObject);
    Procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
    Procedure FormCreate(Sender: TObject);
    Procedure PreviewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Procedure PreviewMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Procedure load(f: String);
    Procedure ObjDraw;
    Procedure BackgroundDraw;
    Procedure InitBmp;
    Procedure RefreshKlosser;
    Procedure Splitter1Moved(Sender: TObject);
    Procedure KlosserMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Procedure KlosserMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Procedure PreviewMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    Procedure KlosserMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    Procedure KlosserScrollChange(Sender: TObject);
    Procedure FormShow(Sender: TObject);
    Procedure LayersClick(Sender: TObject);
    Procedure FromlevelClick(Sender: TObject);
    Procedure ScrollyChange(Sender: TObject);
    Procedure ScrollxChange(Sender: TObject);
    Procedure ActionLoadLevelExecute(Sender: TObject);
    Procedure ActionSaveLevelExecute(Sender: TObject);
    Procedure ActionOptionExecute(Sender: TObject);
    procedure ActionExitExecute(Sender: TObject);
    procedure ActionResetLevelExecute(Sender: TObject);
    procedure ActionShowHintsExecute(Sender: TObject);
    procedure ActionRunLevelExecute(Sender: TObject);
  Private
    { Private declarations }
  Public
    { Public declarations }
    selstarttemp, selstart, cursor, selend: tpoint;
    sellayer: integer;
  End;

Const DefaultWidth  = 1024;
  DefaultHeight     = 512;
  DefaultLayers     = 3;
  maxplayers        = 10;
  maxobjs           = 1024;
  UndoCount         = 10;
  RedoCount         = 10;

Type levelextrainfotype = Record
    startx, starty: integer;
    layers: integer;
    width, height: integer;
    name: String[32];
    megaobjs, bypass, background, backobjs, sprites: String[32];
    scrollbackground: byte;
  End;

Type leveltype = Record
    info: levelextrainfotype;
    l: Array Of Array Of Array Of smallint;
  End;

Type playertype = Array[0..maxplayers] Of Record
    objnr: integer;
    score: integer;
    name: String;
  End;

Type objtype = Array[0..maxobjs] Of Record
    x, y: integer;
    typo: integer;
    ax, ay: integer;
    tag: String;
    pic: integer;
  End;


Type gametype = Record
    level: leveltype;
    objs: objtype;
    scrollx, scrolly: integer;
  End;

Var
  EditorForm        : TEditorForm;
  Game              : gametype;
  CurrentLayer      : Byte = 1;
  Undo              : Array[0..UndoCount - 1] Of leveltype;
  Redo              : Array[0..UndoCount - 1] Of leveltype;
  FirstUndoNo       : integer = 0;
  LastUndoNo        : integer = 0;
  CurrentUndoNo     : integer = 0;

Procedure Resetlevel;

Implementation

Uses editorUnit3;

{$R *.DFM}


Procedure storeundo;
Var l               : integer;
Begin
//flytte alle undoene ned

//stappe inn ny undo

//t鴐me redo
End;

Procedure DoUndo;
Begin
//flytte alle redoene ned

//stappe 鴙erste undo i redo

//flytte alle undoene opp

End;

Procedure DoRedo;
Begin
//flytte alle undoene ned

//stappe 鴙erste redo i undo

//flytte alle redoene opp
End;

Procedure swap(Var a, b: integer);
Var c               : integer;
Begin
  c := a;
  a := b;
  b := c;
End;

Procedure EnemyMove;
Begin
End;

Var draw            : byte;

Procedure TEditorForm.ObjDraw;
Var xx, yy          : integer;
Begin
  For xx := 0 To 9 Do
    For yy := 0 To 8 Do
      PBMP.items[1].draw(Preview.surface, xx * 32, yy * 32, 10);
End;

Procedure Resetlevel;
Var l, xx, yy       : integer;
Begin
  For l := 0 To game.level.info.layers - 1 Do
    For xx := 0 To game.level.info.Width - 1 Do
      For yy := 0 To game.level.info.height - 1 Do
        game.level.l[l][xx, yy] := -1;
End;

Procedure TEditorForm.BackgroundDraw;
Var dx, dy, sx, sy, xx, yy: integer;
  aa                : smallint;
  l                 : byte;
Begin
{if game.scrollx div 32+preview.width div 32>game.level.info.width then
 game.scrollx:=game.level.info.width-preview.Width div 32;{}

{if game.scrolly div 32+preview.height div 32>game.level.info.height then
 game.scrolly:=game.level.info.height-preview.height div 32;{}

  If game.scrollx < 0 Then game.scrollx := 0;
  If game.scrolly < 0 Then game.scrolly := 0;

//rm1.dximagelist1.items[0].draw(form1.dxdraw1.surface,0,0,0);
  preview.surface.fill(rgb(255, 255, 255));
  sx := game.scrollx Shr 5;
  sy := game.scrolly Shr 5;

  dx := -game.scrollx + sx Shl 5;
  dy := -game.scrolly + sy Shl 5;

  For l := 0 To game.level.info.layers - 1 Do
    If layers.Checked[l] Then
      For xx := 0 To preview.width Shr 5 + 1 Do
        For yy := 0 To preview.height Shr 5 + 1 Do
          If (xx + sx < game.level.info.width) And (yy + sy < game.level.info.height) Then
          Begin
            aa := game.level.l[l][xx + sx, yy + sy];
            If aa <> -1 Then Pbmp.items[1].draw(preview.surface, xx Shl 5 + dx, yy Shl 5 + dy, aa);
            If fromlevel.checked Then
              If (selstart.x <= xx + sx) And (selend.x >= xx + sx) And
                (selstart.y <= yy + sy) And (selend.y >= yy + sy) Then
                Pbmp.items[3].draw(Preview.Surface, xx Shl 5 + dx, yy Shl 5 + dy, 0);
          End;
End;


Procedure TEditorForm.PreviewInitialize(Sender: TObject);
Begin
  resetlevel;
End;


Var curx, cury      : integer;

Procedure TEditorForm.DXTimer1Timer(Sender: TObject; LagCount: Integer);
Var xx, yy          : integer;
Begin
  dxinput1.Update;
  If isright In dxinput1.States Then
    If scrollx.position < scrollx.Max - 1 Then
      scrollx.position := scrollx.position + 1;

//  scrollx.SetParams(scrollx.position+1,0,game.level.info.width-preview.width div 32);

  If isleft In dxinput1.States Then
    If scrollx.position > 0 Then
      scrollx.position := scrollx.position - 1;

//  scrollx.SetParams(scrollx.position-1,0,game.level.info.width-preview.width div 32);


  If isup In dxinput1.States Then
    If scrolly.position > 0 Then
      scrolly.position := scrolly.position - 1;

 //  scrolly.SetParams(scrolly.position-1,0,game.level.info.height-preview.height div 32);

  If isdown In dxinput1.States Then
    If scrolly.position < scrolly.Max Then
      scrolly.position := scrolly.position + 1;
//  scrolly.SetParams(scrolly.position+1,0,game.level.info.height-preview.height div 32);


  game.scrolly := scrolly.Position Shl 5;
  game.scrollx := scrollx.Position Shl 5;

  dxinput1.Update;
  If isleft In dxinput1.States Then dec(curx);
  If isright In dxinput1.States Then inc(curx);
  If isup In dxinput1.States Then dec(cury);
  If isdown In dxinput1.States Then inc(cury);
  preview.surface.fill(clwhite);
  backgrounddraw;

  If draw <> 3 Then
    For xx := 0 To selend.x - selstart.x Do
      For yy := 0 To selend.y - selstart.y Do
        Pbmp.items[2].draw(preview.surface, cursor.x * 32 + xx * 32, cursor.y * 32 + yy * 32, 0);

  preview.flip;

End;

Function topf(a: String): pchar;
Begin
  result := pchar(a);
End;

Procedure TEditorForm.InitBmp;
Begin
  chdir(extractfilepath(application.exename));
  If fileexists('gfx\' + game.level.info.backobjs) Then
  Begin
    Pbmp.items[1].Picture.loadfromfile('gfx\' + game.level.info.backobjs);
    Kbmp.items[1].Picture.loadfromfile('gfx\' + game.level.info.backobjs);
  End
  Else If fileexists(game.level.info.backobjs) Then
  Begin
    Pbmp.items[1].Picture.loadfromfile(game.level.info.backobjs);
    Kbmp.items[1].Picture.loadfromfile(game.level.info.backobjs);
  End Else messagebox(application.handle, topf('Can''t find: ' + game.level.info.backobjs), '', 0);
  Kbmp.Items.Restore;
  Pbmp.Items.Restore;
End;

Procedure TEditorForm.FormCreate(Sender: TObject);
Var i               : integer;
Begin
  game.level.info.layers := defaultlayers;
  game.level.info.width := defaultwidth;
  game.level.info.height := defaultheight;
  layers.Items.Clear;
  For i := 0 To game.level.info.layers - 1 Do layers.Items.add(inttostr(i));
  For i := 0 To game.level.info.layers - 1 Do layers.checked[i] := true;
  layers.ItemIndex := 1;
  With game.level Do
    setlength(l, info.layers, info.width, info.height);

  selstart := point(0, 0);
  selend := point(0, 0);

⌨️ 快捷键说明

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