Code Search for Developers
 
 
  

Unit1.pas from Sector-37 at Krugle


Show Unit1.pas syntax highlighted

unit Unit1;

interface

{$I GLScene.inc}

uses
  // VCL
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,

  // GLScene
  GLTexture, GLCadencer, GLWin32Viewer, GLMisc, GLScene, GLObjects, XOpenGL,
  Opengl1x, GLGraph, VectorLists, VectorTypes, GLUserShader, GLUtils, GLContext,
  GLVectorFileObjects,  ExtCtrls, StdCtrls, VectorGeometry, GLGeomObjects,
  GLShadowVolume, GLSLShader, GLCustomShader, GLSimpleNavigation,

  // FileFormats
  TGA, GLFileMD2, GLFileMS3D, GLFile3DS, JPEG, DDS;

type
  TGLSLTestForm = class(TForm)
    Scene: TGLScene;
    Viewer: TGLSceneViewer;
    Cadencer: TGLCadencer;
    Camera: TGLCamera;
    Light:  TGLLightSource;
    LightCube: TGLDummyCube;
    GLSphere1: TGLSphere;
    GLXYZGrid1: TGLXYZGrid;
    GLArrowLine1: TGLArrowLine;
    Panel1: TPanel;
    LightMovingCheckBox: TCheckBox;
    GUICube: TGLDummyCube;
    WorldCube: TGLDummyCube;
    Fighter: TGLActor;
    Teapot: TGLActor;
    Sphere_big: TGLActor;
    Sphere_little: TGLActor;
    MaterialLibrary: TGLMaterialLibrary;
    ShadeEnabledCheckBox: TCheckBox;
    TurnPitchrollCheckBox: TCheckBox;
    GLSLShader: TGLSLShader;
    GLSimpleNavigation1: TGLSimpleNavigation;
    procedure FormCreate(Sender: TObject);
    procedure CadencerProgress(Sender: TObject; const deltaTime, newTime: double);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure LightCubeProgress(Sender: TObject; const deltaTime,
      newTime: Double);
    procedure ShadeEnabledCheckBoxClick(Sender: TObject);
    procedure GLSLShaderApply(Shader: TGLCustomGLSLShader);
    procedure GLSLShaderInitialize(Shader: TGLCustomGLSLShader);
    procedure GLSLShaderUnApply(Shader: TGLCustomGLSLShader;
      var ThereAreMorePasses: Boolean);
  private
    { Private declarations }

  public
    { Public declarations }

  end;

var
  GLSLTestForm:  TGLSLTestForm;
  GLSLShader: TGLSLShader;

implementation

{$R *.dfm}

procedure TGLSLTestForm.FormCreate(Sender: TObject);
begin
  //First load models

  Fighter.LoadFromFile('Models/Fighter.3ds'); //Fighter
  Fighter.Scale.Scale(0.3);

  Teapot.LoadFromFile('Models/Teapot.3ds'); //Teapot
  Teapot.Scale.Scale(0.8);

  Sphere_big.LoadFromFile('Models/Sphere_big.3DS'); //Sphere_big
  Sphere_big.Scale.Scale(70);

  Sphere_little.LoadFromFile('Models/Sphere_little.3ds'); //Sphere_little
  Sphere_little.Scale.Scale(4);

  //Then load textures
  MaterialLibrary.LibMaterialByName('Earth').Material.Texture.Image.LoadFromFile('Textures/Earth.jpg');

  //Shader
  GLSLShader.LoadShaderPrograms('Shaders/Shader.Vert', 'Shaders/Shader.Frag');
  GLSLShader.Enabled := True;
end;

procedure TGLSLTestForm.ShadeEnabledCheckBoxClick(Sender: TObject);
begin
  GLSLShader.Enabled := ShadeEnabledCheckBox.Checked;
end;

procedure TGLSLTestForm.GLSLShaderApply(Shader: TGLCustomGLSLShader);
begin
  // Var parameters.
  with Shader do
  begin
    Param['DiffuseColor'].AsVector4f := VectorMake(1, 1, 1, 1);
    Param['AmbientColor'].AsVector4f := VectorMake(0.1, 0.1, 0.1, 1);
    Param['LightIntensity'].AsVector1f := 1;
    Param['MainTexture'].AsTexture2D[0] := MaterialLibrary.LibMaterialByName('Earth').Material.Texture;
  end;
end;

procedure TGLSLTestForm.GLSLShaderInitialize(Shader: TGLCustomGLSLShader);
begin
  //static parameters
  with Shader do
  begin
    // Nothing.
  end;
end;

procedure TGLSLTestForm.GLSLShaderUnApply(Shader: TGLCustomGLSLShader;
  var ThereAreMorePasses: Boolean);
begin
  with Shader do
  begin
    // Nothing.
  end;
end;

procedure TGLSLTestForm.CadencerProgress(Sender: TObject; const deltaTime, newTime: double);
begin
  Viewer.Invalidate;

  if TurnPitchrollCheckBox.Checked then
  begin
    Sphere_big.Pitch(40 * deltaTime);
    Sphere_big.Turn(40 * deltaTime);
    Sphere_little.Roll(40 * deltaTime);
  end;
end;


procedure TGLSLTestForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Cadencer.Enabled := False;
end;


procedure TGLSLTestForm.LightCubeProgress(Sender: TObject; const deltaTime,
  newTime: Double);
begin
  if LightMovingCheckBox.Checked then
    LightCube.MoveObjectAround(Camera.TargetObject, sin(NewTime) * deltaTime * 10, deltaTime * 20);
end;

end.






See more files for this project here

Sector-37

Sector-37 (real time 3D cosmic strategy)

Project homepage: http://sourceforge.net/projects/sector37
Programming language(s): Pascal
License: lgpl21

  Models/
    Fighter.3ds
    Sphere_big.3DS
    Sphere_little.3DS
    Teapot.3ds
  Shaders/
    Shader.Frag
    Shader.Vert
  Textures/
    Earth.jpg
  StrangeGLSLDiffuseSpecularShaderDemo.dpr
  StrangeGLSLDiffuseSpecularShaderDemo.res
  Unit1.dfm
  Unit1.pas
  _Cleanup.bat