unit1.pas

N年前有个法国小组用Delphi写了一个2D网游（AD&D类型）

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ADKMainFrame, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    MainFrame1: TMainFrame;
    ListBox1: TListBox;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Button6: TButton;
    Timer1: TTimer;
    ColorBox1: TColorBox;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    Label2: TLabel;
    ProgressBar2: TProgressBar;
    SoundBar: TProgressBar;
    Races: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure MainFrame1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Button6Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ProgressBar1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ProgressBar1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ProgressBar1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ProgressBar2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    Homme,Femme,Elf,Elfe,Nain,Naine,Hobbit,Hobbite:integer;
    Go:Tpoint;
    procedure OnPlayerStart(Sender:TObject; PlayerID:integer; const Target:TPoint; How:TAction; var Cancel:boolean);
    procedure OnPlayerMove(Sender:TObject; PlayerID:integer; const Leave,Enter:TPoint);
    procedure OnPlayerStop(Sender:TObject; PlayerID:integer; How:TAction; Direction:TDirection; const Target:TPoint);
    procedure OnRotatePlayer(Sender:TObject; PlayerID:integer; Direction:TDirection);
    procedure OnObjectClick(Sender:TObject; ObjectID:integer);
    procedure OnObjectHint(Sender:TObject; ObjectID:integer; var Hint:string);
    procedure OnCelltype(Sender:TObject; x,y:integer; var Obstacle:TObstacle);
    procedure OnIdle(Sender:TObject; var Done:boolean);
    procedure OnTextRequest(Sender:TObject; Text:string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
//var
// id:Cardinal;
begin
 OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName);

 MainFrame1.OnPlayerStart:=OnPlayerStart;
 MainFrame1.OnPlayerMove:=OnPlayerMove;
 MainFrame1.OnPlayerStop:=OnPlayerStop;
 MainFrame1.OnObjectClick:=OnObjectClick;
 MainFrame1.OnObjectHint:=OnObjectHint;
 MainFrame1.OnCellType:=OnCellType;
 MainFrame1.OnRotate:=OnRotatePlayer;
 MainFrame1.OnTextRequest:=OnTextRequest;

 MainFrame1.AddChat('Walker demo 1.0',clWhite);
 MainFrame1.AddChat('Un homme, une femme',clAqua);

// Charge les sprites de la section [Homme] du .ini
 Homme:=MainFrame1.LoadSprites('Homme');
// Charge les sprites de la section [Femme] du .ini
 Femme:=MainFrame1.LoadSprites('Femme');

 Elf:=MainFrame1.LoadSprites('Elf');
 Elfe:=MainFrame1.LoadSprites('Elfe');
 Nain:=MainFrame1.LoadSprites('Nain');
 Naine:=MainFrame1.LoadSprites('Naine');
 Hobbit:=MainFrame1.LoadSprites('Hobbit');
 Hobbite:=MainFrame1.LoadSprites('Hobbite');

// chargement la carte (et la lib d'images) d閏lar閑s dans le .ini
 MainFrame1.LoadDefaults;

// Cr閑 un joueur (Homme) en position (20,10) sur la carte
 ListBox1.Items.AddObject('Homme',MainFrame1.AddPlayer(20,10,Homme,0));
// Cr閑 un joueur (Femme) en position (19,12) sur la carte
 ListBox1.Items.AddObject('Femme',MainFrame1.AddPlayer(19,12,Femme,1));
// Allumer le feu !
 MainFrame1.AddFire(19,10,20,100,15);
 MainFrame1.AddSphere(19,10,25,100);

 ListBox1.Items.AddObject('Elf',MainFrame1.AddPlayer(20,12,Elf,2));
 ListBox1.Items.AddObject('Elfe',MainFrame1.AddPlayer(21,12,Elfe,3));
 ListBox1.Items.AddObject('Nain',MainFrame1.AddPlayer(20,13,Nain,4));
 ListBox1.Items.AddObject('Naine',MainFrame1.AddPlayer(20,14,Naine,5));
 ListBox1.Items.AddObject('Hobbit',MainFrame1.AddPlayer(20,15,Hobbit,6));
 ListBox1.Items.AddObject('Hobbite',MainFrame1.AddPlayer(20,16,Hobbite,7));

 ListBox1.ItemIndex:=0;
 ListBox1Click(nil);

 Application.OnIdle:=OnIdle;
end;

procedure TForm1.OnIdle(Sender:TObject; var Done:boolean);
begin
 SoundBar.Max:=MainFrame1.SoundMax;
 SoundBar.Position:=MainFrame1.SoundPos;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
 i:integer;
begin
 i:=ListBox1.ItemIndex;
 if i<0 then exit;
 // s閘ection du joueur actif
 MainFrame1.Select(ListBox1.Items.Objects[i]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then begin
  ListBox1.Clear;
  MainFrame1.LoadMap(OpenDialog1.FileName);
  ListBox1.Items.AddObject('Homme',MainFrame1.AddPlayer(0,0,Homme,0));
  ListBox1.ItemIndex:=0;
  ListBox1Click(nil);
 end;
end;

procedure TForm1.OnPlayerStart(Sender:TObject; PlayerID:integer; const Target:TPoint; How:TAction; var Cancel:boolean);
begin
 MainFrame1.AddChat(
  Format('%s> va en (%d,%d) OK',[Listbox1.Items[PlayerID],Target.x,Target.y])
 );
 go:=Target;
end;

procedure TForm1.OnPlayerMove(Sender:TObject; PlayerID:integer; const Leave,Enter:TPoint);
begin
 MainFrame1.AddChat(
  Format('%s> quitte (%d,%d) pour (%d,%d)',[Listbox1.Items[PlayerID],Leave.x,Leave.y,Enter.x,Enter.y])
 );
 if (Enter.x<>go.x)or(Enter.y<>go.y) then MainFrame1.AddChat('!!! erreur de mouvement !!!',clRed);
end;

procedure TForm1.OnPlayerStop(Sender:TObject; PlayerID:integer; How:TAction; Direction:TDirection; const Target:TPoint);
begin
 MainFrame1.AddChat(
  Format('%s> est arriv