GLScene/Demos/materials/mirror/fMirror.pas

unit fMirror;

interface

uses
  System.SysUtils,
  System.Classes, 
  Vcl.Graphics, 
  Vcl.Controls, 
  Vcl.Forms,
  Vcl.ExtCtrls, 
  Vcl.StdCtrls,
  
  
  GLS.BaseClasses, 
  GLS.Scene, 
  GLS.Objects, 
  GLS.Extrusion, 
  GLS.Mirror,
  GLS.Cadencer, 
  GLS.SceneViewer, 
  GLS.GeomObjects,
  GLS.Coordinates, 
 
  GLS.MultiPolygon;

type
  TFormMirror = class(TForm)
    GLSceneViewer1: TGLSceneViewer;
    GLScene1: TGLScene;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    Sphere: TGLSphere;
    ReflectingObjects: TGLDummyCube;
    Cylinder: TGLTorus;
    Teapot1: TGLTeapot;
    Cylinder1: TGLCylinder;
    GLMirror: TGLMirror;
    Cadre: TGLExtrusionSolid;
    Timer1: TTimer;
    GLCadencer1: TGLCadencer;
    Panel1: TPanel;
    LabelFPS: TLabel;
    CBOpaque: TCheckBox;
    CBStencil: TCheckBox;
    Cylinder2: TGLCylinder;
    CBClearZ: TCheckBox;
    CylinderThroughMirror: TGLCylinder;
    CBPlaneClip: TCheckBox;
    DCNonReflectingStuff: TGLDummyCube;
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure GLCadencer1Progress(Sender: TObject;
      const deltaTime, newTime: Double);
    procedure CBOpaqueClick(Sender: TObject);
    procedure CBStencilClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure CBClearZClick(Sender: TObject);
    procedure CBPlaneClipClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
     
  public
     
    mx, my: Integer;
  end;

var
  FormMirror: TFormMirror;

implementation

{$R *.DFM}

procedure TFormMirror.FormCreate(Sender: TObject);
begin
  CBClearZClick(Self);
  CBOpaqueClick(Self);
end;

//
// Those events simply add/remove one of the mirror options
// when the related checkbox is clicked
//

procedure TFormMirror.CBOpaqueClick(Sender: TObject);
begin
  if CBOpaque.Checked then
    GLMirror.MirrorOptions := GLMirror.MirrorOptions + [moOpaque]
  else
    GLMirror.MirrorOptions := GLMirror.MirrorOptions - [moOpaque];
end;

procedure TFormMirror.CBStencilClick(Sender: TObject);
begin
  if CBStencil.Checked then
    GLMirror.MirrorOptions := GLMirror.MirrorOptions + [moUseStencil]
  else
    GLMirror.MirrorOptions := GLMirror.MirrorOptions - [moUseStencil];
end;

procedure TFormMirror.CBClearZClick(Sender: TObject);
begin
  if CBClearZ.Checked then
    GLMirror.MirrorOptions := GLMirror.MirrorOptions + [moClearZBuffer]
  else
    GLMirror.MirrorOptions := GLMirror.MirrorOptions - [moClearZBuffer];
end;

procedure TFormMirror.CBPlaneClipClick(Sender: TObject);
begin
  if CBPlaneClip.Checked then
    GLMirror.MirrorOptions := GLMirror.MirrorOptions + [moMirrorPlaneClip]
  else
    GLMirror.MirrorOptions := GLMirror.MirrorOptions - [moMirrorPlaneClip];
end;

//
// Standard-issue move around target code
//

procedure TFormMirror.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mx := X;
  my := Y;
end;

procedure TFormMirror.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if Shift <> [] then
  begin
    GLCamera1.MoveAroundTarget(my - Y, mx - X);
    mx := X;
    my := Y;
  end;
end;

//
// Standard issue resize/zoom, timer and viewr invalidation (to force redraws)
//
procedure TFormMirror.FormResize(Sender: TObject);
begin
  GLCamera1.SceneScale := GLSceneViewer1.Width / 380;
end;

procedure TFormMirror.Timer1Timer(Sender: TObject);
begin
  LabelFPS.Caption := Format('%.1f FPS', [GLSceneViewer1.FramesPerSecond]);
  GLSceneViewer1.ResetPerformanceMonitor;
end;

procedure TFormMirror.GLCadencer1Progress(Sender: TObject;
  const deltaTime, newTime: Double);
begin
  GLSceneViewer1.Invalidate;
end;

end.