GLScene/Examples/Demos/specialsFX/ParticleMasking/fParticleMaskingD.pas

unit fParticleMaskingD;

interface

uses
  Winapi.OpenGL,
  System.SysUtils,
  System.Classes,
  System.Types,
  System.Math,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.ExtCtrls,
  Vcl.ComCtrls,
  Vcl.StdCtrls,

  GLS.Scene,
  GLS.Objects,
  GLS.BitmapFont,
  GLS.WindowsFont,
  GLS.Texture,
  GLS.Cadencer,
  GLS.SceneViewer,
  GLS.ParticleFX,
  Stage.VectorGeometry,
  Stage.VectorTypes,
  GLS.EParticleMasksManager,
  GLS.GeomObjects,
  GLS.AsyncTimer,
 
  GLS.Material,
  GLS.Coordinates,
  GLS.BaseClasses;

const

  PlaneHeights = 5;
  PlaneWidths  = 5;
  PlaneDepths  = 5;
  PlaneOffsets = 3;

type
  TFormParticleMasking = class(TForm)
    MaskBox: TGroupBox;
    GLScene: TGLScene;
    SceneViewer: TGLSceneViewer;
    GLCadencer: TGLCadencer;
    MatLib: TGLMaterialLibrary;
    WinFont: TGLWindowsBitmapFont;
    XImage: TImage;
    Splitter1: TSplitter;
    XLabel: TLabel;
    YLabel: TLabel;
    ZLabel: TLabel;
    YImage: TImage;
    ZImage: TImage;
    Camera: TGLCamera;
    Target: TGLDummyCube;
    XPlane: TGLPlane;
    YPlane: TGLPlane;
    ZPlane: TGLPlane;
    Light: TGLLightSource;
    PLManager: TGLPointLightPFXManager;
    PFXRenderer: TGLParticleFXRenderer;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    GLEParticleMasksManager1: TGLEParticleMasksManager;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Button4: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Sphere: TGLSphere;
    CheckBox1: TCheckBox;
    GLArrowLine1: TGLArrowLine;
    AsyncTimer1: TGLAsyncTimer;
    procedure GLCadencerProgress(Sender: TObject; const DeltaTime, newTime: Double);
    procedure FormCreate(Sender: TObject);
    procedure SceneViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint; var Handled: Boolean);
    procedure PLManagerCreateParticle(Sender: TObject; aParticle: TGLParticle);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    procedure Edit5Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure AsyncTimer1Timer(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
  private
     
  public
     
    mx, my: Integer;
    procedure RefreshMask;
  end;

var
  FormParticleMasking: TFormParticleMasking;

implementation

{$R *.dfm}

procedure TFormParticleMasking.RefreshMask;
var
  Rect:   TRect;
  Mat:    TGLLibMaterial;
  Letter: Char;
  Depth:  Integer;

begin
  Letter := Edit2.Text[1];
  Depth := StrToIntDef(Edit1.Text, 50);

  XPlane.Position.X := -PlaneOffSets;
  XPlane.Height := PlaneHeights;
  XPlane.Width := PlaneWidths;

  YPlane.Position.Y := -PlaneOffSets;
  YPlane.Height := PlaneHeights;
  YPlane.Width := PlaneWidths;

  ZPlane.Position.Z := -PlaneOffSets;
  ZPlane.Height := PlaneHeights;
  ZPlane.Width := PlaneWidths;

  Rect.Left := 0;
  Rect.Top := 0;
  Rect.Bottom := XImage.Height;
  Rect.Right := XImage.Width;

  XImage.Canvas.Font.Name := 'Arial';
  XImage.Canvas.Font.Size := 180;
  XImage.Canvas.Font.Color := clWhite;
  XImage.Canvas.Pen.Color := clBlack;
  XImage.Canvas.Pen.Style := psSolid;
  XImage.Canvas.Brush.Color := clBlack;
  XImage.Canvas.Brush.Style := bsSolid;

  XImage.Canvas.FillRect(Rect);

  XImage.Canvas.TextOut(round((XImage.Width - XImage.Canvas.TextWidth(Letter)) / 2),
    round((XImage.Height - XImage.Canvas.TextHeight(Letter)) / 2), Letter);

  Mat := MatLib.LibMaterialByName('XMask');
  with Mat.Material.Texture.Image as TGLPersistentImage do
  begin
    Picture.Bitmap.Height := XImage.Height;
    Picture.Bitmap.Width := XImage.Width;
    Picture.Bitmap.Canvas.Draw(0, 0, XImage.Picture.Graphic);
  end;

  // this is a very recent implementation, the ability to generate other masks from 1 mask, so it satisfies
  // the requirements for the particle mask manager. useful for text and making basic shapes (cylinders etc)

  GLEParticleMasksManager1.ParticleMaskByName('mask').GenerateMaskFromProjection(pptXMask, pptYMask, Depth);
  GLEParticleMasksManager1.ParticleMaskByName('mask').GenerateMaskFromProjection(pptXMask, pptZMask, Depth);

  Mat := MatLib.LibMaterialByName('YMask');
  with Mat.Material.Texture.Image as TGLPersistentImage do
    YImage.Canvas.Draw(0, 0, Picture.Graphic);

  Mat := MatLib.LibMaterialByName('ZMask');
  with Mat.Material.Texture.Image as TGLPersistentImage do
    ZImage.Canvas.Draw(0, 0, Picture.Graphic);
end;

// with formcreate, we are just drawing some pre-rendered masks

procedure TFormParticleMasking.FormCreate(Sender: TObject);
begin
  RefreshMask;
  Sphere.Visible := CheckBox1.Checked;
end;

procedure TFormParticleMasking.GLCadencerProgress(Sender: TObject; const DeltaTime, newTime: Double);
begin
  Sphere.TurnAngle := -newTime * 20;
  Sphere.Position.X := Cos(DegToRad(newTime * 20)) * 1.5;
  Sphere.Position.Z := Sin(DegToRad(newTime * 20)) * 1.5;
  SceneViewer.Invalidate;
end;

procedure TFormParticleMasking.SceneViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then
    Camera.MoveAroundTarget(my - Y, mx - X);

  mx := X;
  my := Y;
end;

procedure TFormParticleMasking.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  Camera.FocalLength := Camera.FocalLength + (WheelDelta / 150);
  Handled := True;
end;

procedure TFormParticleMasking.PLManagerCreateParticle(Sender: TObject; aParticle: TGLParticle);
var
  I: Integer;
  Particle: TGLParticle;

begin
  // using point lights just coz it is easier to see the effect
  if PLManager.Particles.ItemCount > 0 then
    for I := 0 to PLManager.Particles.ItemCount - 1 do
    begin
      Particle := PLManager.Particles.Items[I];
      // first we find the particles that are tagged (since before particle creation, the position is overridden)
      if Particle.Tag = 1 then
      begin
        if CheckBox1.Checked then
          GLEParticleMasksManager1.SetParticlePositionFromMaskTarget(Particle, 'mask', Sphere)
        else
          GLEParticleMasksManager1.SetParticlePositionFromMask(Particle, 'mask');
        Particle.Tag := 0;
      end;
    end;
  // we tag the new particle for when another particle is made so we know this one needs updating aswell
  aParticle.Tag := 1;
end;

procedure TFormParticleMasking.Button1Click(Sender: TObject);
begin
  Camera.Position.Z := 0;
  Camera.Position.Y := 0;
  Camera.Position.X := 4;
end;

procedure TFormParticleMasking.Button2Click(Sender: TObject);
begin
  Camera.Position.X := 0;
  Camera.Position.Z := 0.01;
  Camera.Position.Y := 4;
end;

procedure TFormParticleMasking.Button3Click(Sender: TObject);
begin
  Camera.Position.X := 0;
  Camera.Position.Y := 0;
  Camera.Position.Z := 4;
end;

procedure TFormParticleMasking.Button4Click(Sender: TObject);
begin
  FormCreate(Sender);
end;

procedure TFormParticleMasking.Edit2Change(Sender: TObject);
begin
  RefreshMask;
end;

procedure TFormParticleMasking.Edit3Change(Sender: TObject);
begin
  GLEParticleMasksManager1.ParticleMaskByName('mask').PitchAngle := StrToFloatDef(Edit3.Text, 0);
end;

procedure TFormParticleMasking.Edit4Change(Sender: TObject);
begin
  GLEParticleMasksManager1.ParticleMaskByName('mask').RollAngle := StrToFloatDef(Edit4.Text, 0);
end;

procedure TFormParticleMasking.Edit5Change(Sender: TObject);
begin
  GLEParticleMasksManager1.ParticleMaskByName('mask').TurnAngle := StrToFloatDef(Edit5.Text, 0);
end;

procedure TFormParticleMasking.CheckBox1Click(Sender: TObject);
begin
  Sphere.Visible := CheckBox1.Checked;
end;

procedure TFormParticleMasking.AsyncTimer1Timer(Sender: TObject);
begin
  Caption := FormatFloat('Particle Masking - ' +'FPS: 0.0', SceneViewer.FramesPerSecond) +
    ' Particle Count: ' + IntToStr(PLManager.ParticleCount);
  SceneViewer.ResetPerformanceMonitor;
end;

end.