mainfm.pas

一个用delphi写的火焰效果的绘图程序

{ *************************************************************************** }
{             Particle    Sample                                              }
{             Written by  Huasoft(www.huosoft.com)                            }
{             Dec, 2005                                                       }
{ *************************************************************************** }


unit MainFm;

interface              //   TDateTime

//---------------------------------------------------------------------------
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  AsphyreFonts, AsphyreDef, AsphyreTimers, AsphyreDevices, AsphyreImages,
  AsphyreCanvas, AsphyreParticles, Asphyre2D, AsphyreSubsc, AsphyreDb,
  AsphyreLoader, AsphyreScreener, ImageFx;

//---------------------------------------------------------------------------
type
  TMainForm = class(TForm)
    Timer: TAsphyreTimer;
    Images: TAsphyreImages;
    Fonts: TAsphyreFonts;
    Device: TAsphyreDevice;
    MyCanvas: TAsphyreCanvas;
    Particles: TAsphyreParticles;
    ASDB: TASDb;
    procedure DeviceRender(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure DeviceInitialize(Sender: TObject; var Success: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TimerProcess(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    Ticks  : Integer;
    FX,FY:       Integer;
    ParticleCount: Integer;

  public
    { Public declarations }
  end;

//---------------------------------------------------------------------------
var
  MainForm: TMainForm;
  flag:Boolean;

//---------------------------------------------------------------------------
implementation
{$R *.DFM}

//---------------------------------------------------------------------------
procedure TMainForm.FormCreate(Sender: TObject);
begin
 // initialize Asphyre  Device
 if (not Device.Initialize()) then
  begin
   MessageDlg('Failed initializing Asphyre device!', mtError, [mbOk], 0);
   Close();
   Exit;
  end;

 Ticks:= 0;
 ParticleCount:= 0;
 flag:=false;
end;

//---------------------------------------------------------------------------
procedure TMainForm.FormDestroy(Sender: TObject);
begin
 // finalize Asphyre device before application closes
 Device.Finalize();
end;

//---------------------------------------------------------------------------
procedure TMainForm.DeviceInitialize(Sender: TObject; var Success: Boolean);
begin
     // load all images from ASDb
     Success := Images.LoadFromASDb(ASDb);


     // if succeeded with images, load all fonts too
     if (Success) then
          Success := Fonts.LoadFromASDb(ASDb);


     // start rendering only if succeeded loading stuff
     Timer.Enabled := Success;
end;

//---------------------------------------------------------------------------
procedure TMainForm.TimerTimer(Sender: TObject);
var
 Background: Cardinal;
begin
 // render the scene
 Device.Render(RGB(0, 0, 0), True);

 // while Direct3D is still rendering, do calculations
 Timer.Process();

 // flip Direct3D buffers
 Device.Flip();
end;

//---------------------------------------------------------------------------
procedure TMainForm.DeviceRender(Sender: TObject);
begin
 // draw particles on the screen
 Particles.Render();
 Fonts[0].TextOut(' l i  j i a n ', 160,40, $FF004FA3, $FF2DB1FF, fxBlend);
 //Fonts[0].TextOut('adviser :  ', 20,20, $FF0001BA, $FF2054EC, fxBlend);
 {********************************************************************
 Fonts[0].TextOut('Frame Rate: ' + IntToStr(Timer.FrameRate) + ' fps', 20,
  20, $FF004FA3, $FF2DB1FF, fxBlend);
 Fonts[0].TextOut('Particle Count: ' + IntToStr(Particles.Count), 20, 40,
  $FFCF0039, $FFDA638B, fxBlend);
 Fonts[0].TextOut('Cache : ' + IntToStr(MyCanvas.CacheStall), 20, 60,
  $FF0001BA, $FF2054EC, fxBlend);
  ********************************************************************}
end;

//---------------------------------------------------------------------------
procedure TMainForm.TimerProcess(Sender: TObject);
var
 p: TAsphyreParticle;
begin
 // only calculate particle count every 30 ticks
 Inc(Ticks);
 if(ticks mod 30)=0 then ParticleCount:= Particles.Count;

 // drop some particles
  if (Random(1) = 0) then
   begin
    p:= Particles.CreateImage(1, Point2(FX, FY), 64, fxBlend);
    // modify particle's default parameters
    if (p <> nil) then
     begin
      // set random speed
      p.Velocity:= Point2((Random(10) - 5) / 20, - (Random(20) / 5));
      // set particle acceleration
      p.Accel:= Point2(0.0, -(0.002 + (Random(10) / 200)));
     end;
   end;

 // move the particles
 Particles.Update();

end;

//---------------------------------------------------------------------------
procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 // ESC: Exit!
 if (Key = VK_ESCAPE) then Close();

 // ALT + ENTER: Switch Windowed / Fullscreen
 if (Key = VK_RETURN)and(ssAlt in Shift) then
  Device.Windowed:= not Device.Windowed;

end;

//---------------------------------------------------------------------------
procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if(flag=true)then
  begin
    FX:=X;
    FY:=Y;
  end
end;

procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  flag:=true;
end;

procedure TMainForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  flag:=false;
end;

end.