Examples/Demos/rendering/RenderToTexture/fRenderToTexD.pas - master - stud_22-365/GLXEngine

Examples/Demos/rendering/RenderToTexture/fRenderToTexD.pas
157 строк3 KB
glscene
Updated
26 мар 2025, 23:30
26 мар 2025, 23:304922420
unit fRenderToTexD;

interface

uses
  Winapi.OpenGL,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls,
  Vcl.ExtCtrls,

  
  GLS.Scene,
  GLS.SceneViewer,
  GLS.FBORenderer,
  GLS.Objects,
  GLS.Coordinates,
  GLS.SimpleNavigation,
  GLS.Material,
  GLS.Cadencer,
  GLS.BaseClasses,
  GLS.RenderContextInfo,
  GLS.Context,
  GLS.AsyncTimer;

type
  TForm1 = class(TForm)
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    GLCadencer1: TGLCadencer;
    GLMaterialLibrary1: TGLMaterialLibrary;
    GLCamera1: TGLCamera;
    GLCube1: TGLCube;
    GLFBORenderer1: TGLFBORenderer;
    GLLightSource1: TGLLightSource;
    GLFBORenderer2: TGLFBORenderer;
    GLDirectOpenGL1: TGLDirectOpenGL;
    Panel1: TPanel;
    Label1: TLabel;
    CheckBox1: TCheckBox;
    Timer1: TTimer;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    GLSimpleNavigation1: TGLSimpleNavigation;
    procedure FormCreate(Sender: TObject);
    procedure GLDirectOpenGL1Render(Sender: TObject;
      var rci: TGLRenderContextInfo);
    procedure GLFBORenderer2AfterRender(Sender: TObject;
      var rci: TGLRenderContextInfo);
    procedure GLFBORenderer1AfterRender(Sender: TObject;
      var rci: TGLRenderContextInfo);
    procedure GLCadencer1Progress(Sender: TObject; const deltaTime,
      newTime: Double);
    procedure CheckBox1Click(Sender: TObject);
    procedure RBClick(Sender: TObject);
    procedure AsyncTimer1Timer(Sender: TObject);
    procedure SBClick(Sender: TObject);
  private
     
    Triger: Boolean;
    FramerateRatio, N: Integer;
  public
     
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Triger := False;
  FramerateRatio := 1;
  N := 0;
  GLCube1.Material.LibMaterialName := GLFBORenderer2.ColorTextureName;
end;

procedure TForm1.AsyncTimer1Timer(Sender: TObject);
begin
  GLSceneViewer1.ResetPerformanceMonitor;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
    GLSceneViewer1.VSync := vsmSync
  else
    GLSceneViewer1.VSync := vsmNoSync;
end;

procedure TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime,
  newTime: Double);
begin
  GLSceneViewer1.Invalidate;
  GLCube1.Turn(60*deltaTime);
end;

procedure TForm1.GLDirectOpenGL1Render(Sender: TObject;
  var rci: TGLRenderContextInfo);
begin
  Inc(N);
  if N >= FramerateRatio then
  begin
    GLFBORenderer2.Active := Triger;
    Triger := not Triger;
    GLFBORenderer1.Active := Triger;
    N := 0;
  end;
end;

procedure TForm1.GLFBORenderer1AfterRender(Sender: TObject;
  var rci: TGLRenderContextInfo);
begin
  GLCube1.Material.LibMaterialName := GLFBORenderer1.ColorTextureName;
  GLFBORenderer1.Active := False;
end;

procedure TForm1.GLFBORenderer2AfterRender(Sender: TObject;
  var rci: TGLRenderContextInfo);
begin
  GLCube1.Material.LibMaterialName := GLFBORenderer2.ColorTextureName;
  GLFBORenderer2.Active := False;
end;

procedure TForm1.SBClick(Sender: TObject);
var
  Size: Integer;
begin
  case RadioGroup1.ItemIndex of
    0: Size := 256;
    1: Size := 512;
    2: Size := 2048;
  end;
  GLFBORenderer1.Width := Size;
  GLFBORenderer1.Height := Size;
  GLFBORenderer2.Width := Size;
  GLFBORenderer2.Height := Size;
end;

procedure TForm1.RBClick(Sender: TObject);
begin
  case RadioGroup2.ItemIndex of
    0: FramerateRatio := 1;
    1: FramerateRatio := 2;
    2: FramerateRatio := 10;
  end;
end;

end.