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

📄 unit_main.pas

📁 类似打蜜蜂的游戏
💻 PAS
字号:
unit Unit_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  StdCtrls, ExtCtrls, ImgList, Menus, ComCtrls, Dialogs, unit_classes;

type
  TfrmMain = class(TForm)
    pbGame: TPaintBox;
    mainMenu: TMainMenu;
    system1: TMenuItem;
    new1: TMenuItem;
    exit1: TMenuItem;
    exit2: TMenuItem;
    Pause1: TMenuItem;
    N1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    ImageList_Obj: TImageList;
    ImageList_Str: TImageList;
    image_Title: TImage;
    Setting1: TMenuItem;
    Options1: TMenuItem;
    Mode1: TMenuItem;
    Shooting1: TMenuItem;
    Marching1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure new1Click(Sender: TObject);
    procedure exit1Click(Sender: TObject);
    procedure exit2Click(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Pause1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Options1Click(Sender: TObject);
    procedure Shooting1Click(Sender: TObject);
    procedure Marching1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  game: TGameWidget;

implementation

{$R *.dfm}

uses  Unit_About, Unit_Options;

var

  last_mouse_x: word;
  last_gkKey: TGameKey;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  game := TGameWidget.Create( pbGame );
  //pbGame.Cursor := 0;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  game.Free;
end;

procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  //showmessage( IntToStr(Key) );
  if Key = 37	then
    game.keyPressed( gkKey_Left )
  else if key = 39 then
    game.keyPressed( gkKey_Right )
  else if Key = 38 then
    game.keyPressed( gkKey_Up )
  else if Key = 40 then
    game.keyPressed( gkKey_Down )
  else if Key = 32 then
    game.keyPressed( gkKey_Fire );
end;

procedure TfrmMain.new1Click(Sender: TObject);
begin
  game.start;
end;

procedure TfrmMain.exit1Click(Sender: TObject);
begin
  game.stop;
end;

procedure TfrmMain.exit2Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = 37	then
    game.keyReleased( gkKey_Left )
  else if key = 39 then
    game.keyReleased( gkKey_Right )
  else if Key = 38 then
    game.keyReleased( gkKey_Up )
  else if Key = 40 then
    game.keyReleased( gkKey_Down )
  else if Key = 32 then
    game.keyReleased( gkKey_Fire );
end;

procedure TfrmMain.Pause1Click(Sender: TObject);
begin
  Pause1.Checked := not Pause1.Checked ;
  if Pause1.Checked then
    game.pause
  else
    game.unpause;
end;

procedure TfrmMain.About1Click(Sender: TObject);
begin
  try
    frmAbout := TfrmAbout.Create( Self );
    frmAbout.ShowModal;
  finally
    frmAbout.Free;
  end;
end;

procedure TfrmMain.FormActivate(Sender: TObject);
begin
  game.unpause;
end;

procedure TfrmMain.FormDeactivate(Sender: TObject);
begin
  game.pause;
end;

procedure TfrmMain.FormKeyPress(Sender: TObject; var Key: Char);
begin
  //showmessage( key );
 // FormKeyDown( Sender, Key, ssShift);
end;

procedure TfrmMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  game.mouseMove( X, Y );
end;

procedure TfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  game.keyPressed( gkKey_Fire );
end;

procedure TfrmMain.Options1Click(Sender: TObject);
begin
  try
    frmSetting := TfrmSetting.Create( Self );
    frmSetting.ShowModal;
  finally
    frmSetting.Free;
  end;
end;

procedure TfrmMain.Shooting1Click(Sender: TObject);
begin
  Shooting1.Checked := True;
  game.updateMode( gmShooting );
end;

procedure TfrmMain.Marching1Click(Sender: TObject);
begin
  Marching1.Checked := True;
  game.updateMode( gmMarching );
end;

end.

⌨️ 快捷键说明

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