Unit1.pas from Sector-37 at Krugle

Show Unit1.pas syntax highlighted

unit Unit1;

interface

{$I GLScene.inc}

uses
  // VCL
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   ExtCtrls, StdCtrls,

  // GLScene
  GLTexture, GLCadencer, GLWin32Viewer, GLMisc, GLScene, GLObjects, XOpenGL,
  Opengl1x, GLGraph, VectorLists, VectorTypes, GLUtils, GLContext,
  GLVectorFileObjects, VectorGeometry, GLGeomObjects, GLUserShader,
  StrangeGLSLFurShader, StrangeGLSLErosionShader, GLShaderCombiner,

  // FileFormats
  TGA, GLFile3DS, JPEG;

type
  TGLSLTestForm = class(TForm)
    Scene: TGLScene;
    Viewer: TGLSceneViewer;
    Cadencer: TGLCadencer;
    Camera: TGLCamera;
    Timer1: TTimer;
    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;
    ShaderType: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure CadencerProgress(Sender: TObject; const deltaTime, newTime: double);
    procedure ViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: integer);
    procedure ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: integer);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: integer; MousePos: TPoint; var Handled: Boolean);
    procedure LightCubeProgress(Sender: TObject; const deltaTime,
      newTime: Double);
    procedure ShadeEnabledCheckBoxClick(Sender: TObject);
    procedure ShaderTypeClick(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  GLSLTestForm:  TGLSLTestForm;
  mx, my:   integer;
  FirstPassShader: TGLSLFurShader;
  SecondPassShader: TGLSLSimpleErosionShader;
  ShaderCombiner: TGLShaderCombiner;
  DaPassCount: Integer;
  ShaderErosionFactor: Single;
  FurColorScale: Single;

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('FurColor').Material.Texture.Image.LoadFromFile('Textures/rainbowfilm_smooth.jpg');
  MaterialLibrary.LibMaterialByName('Erosion').Material.Texture.Image.LoadFromFile('Textures/Erosion.tga');


  //My Shaders
  FirstPassShader := TGLSLFurShader.Create(self);
  FirstPassShader.MainTexture := MaterialLibrary.LibMaterialByName('FurColor').Material.Texture;
  FirstPassShader.NoiseTexture := MaterialLibrary.LibMaterialByName('Erosion').Material.Texture;

  SecondPassShader := TGLSLSimpleErosionShader.Create(Self);
  SecondPassShader.NoiseTexture := MaterialLibrary.LibMaterialByName('Erosion').Material.Texture;

  ShaderCombiner := TGLShaderCombiner.Create(Self);
  ShaderCombiner.CombinerType := sctOneMPTwoSP;
  ShaderCombiner.ShaderOne := FirstPassShader;
  ShaderCombiner.ShaderTwo := SecondPassShader;
  MaterialLibrary.LibMaterialByName('ShaderMaterial').Shader := ShaderCombiner;
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);
    Fighter.Roll(10 * deltaTime);
  end;

  //Add some nice stuff :)
  FirstPassShader.ColorScale.Blue := 0.3 + 0.5 * Cos(NewTime);
  SecondPassShader.ErosionFactor := 0.35 + 0.05 * Sin(NewTime);
end;


procedure TGLSLTestForm.ViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
  mx := X;
  my := Y;
end;


procedure TGLSLTestForm.ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: integer);
begin
  if (ssRight in Shift) and (ssLeft in Shift) then
    Camera.AdjustDistanceToTarget(Power(1.01, y-my))
  else
  if (ssRight in Shift) or (ssLeft in Shift) then
    Camera.MoveAroundTarget(my - Y, mx - X);
  mx := X;
  my := Y;
end;


procedure TGLSLTestForm.Timer1Timer(Sender: TObject);
begin
  Caption := 'Shader Combiner Fur Erosion Demo made by Da Stranger in November ''2006  -  ' + Viewer.FramesPerSecondText;
  Viewer.ResetPerformanceMonitor;
end;


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


procedure TGLSLTestForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: integer; MousePos: TPoint; var Handled: Boolean);
begin
  Camera.AdjustDistanceToTarget(Power(1.1, WheelDelta / 120));
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;


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

procedure TGLSLTestForm.ShaderTypeClick(Sender: TObject);
begin
  if  ShaderType.Checked then
    ShaderCombiner.CombinerType := sctTwoSPOneAP
  else
    ShaderCombiner.CombinerType := sctOneMPTwoSP;
end;

end.
See more files for this project here