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, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,

  // GLScene
  GLScene, GLObjects, GLWin32Viewer, GLTexture, GLCadencer,
  GLVectorFileObjects, GLFile3DS, GLGraph, ExtCtrls, GLMisc, GLCgBombShader,

  // FileFormats
  JPEG, GLFileMD3,

  // Strange Components
  StrangeTrackBar
  {$IFDEF STRANGE_INIFILE_SUPPORT}, StrangeIniObjects{$ENDIF};

type
  TForm1 = class(TForm)
    GLScene1: TGLScene;
    GLCamera1: TGLCamera;
    GLLightSource1: TGLLightSource;
    GLMaterialLibrary1: TGLMaterialLibrary;
    GLCadencer1: TGLCadencer;
    Panel1: TPanel;
    Splitter1: TSplitter;
    GLFreeForm1: TGLFreeForm;
    Panel9: TPanel;
    Panel10: TPanel;
    GLSceneViewer1: TGLSceneViewer;
    Timer1: TTimer;
    GLXYZGrid1: TGLXYZGrid;
    GLDummyCube1: TGLDummyCube;
    GLFreeForm2: TGLFreeForm;
    GLFreeForm3: TGLFreeForm;
    ComboBox1: TComboBox;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    StrangeTrackBar1: TStrangeTrackBar;
    StrangeTrackBar2: TStrangeTrackBar;
    StrangeTrackBar3: TStrangeTrackBar;
    StrangeTrackBar4: TStrangeTrackBar;
    StrangeTrackBar5: TStrangeTrackBar;
    StrangeTrackBar7: TStrangeTrackBar;
    StrangeTrackBar6: TStrangeTrackBar;
    GLFreeForm4: TGLFreeForm;
    CheckBox4: TCheckBox;
    JustATestCube: TGLCube;
    StrangeTrackBar8: TStrangeTrackBar;
    StrangeTrackBar9: TStrangeTrackBar;
    ShaderEnabledCheckBox: TCheckBox;
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure StrangeTrackBar1Change(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure GLCadencer1Progress(Sender: TObject; const DeltaTime, newTime: Double);
    procedure CheckBox1Click(Sender: TObject);
    procedure ShaderEnabledCheckBoxClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    mx, my: Integer;
    procedure ResetPositions;
  end;

var
  Form1:    TForm1;
  MyShader: TGLCgBombShader;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  GLFreeForm1.LoadFromFile('Models\mesh_near.md3');
  GLFreeForm2.LoadFromFile('Models\Teapot.3ds');
  GLFreeForm3.LoadFromFile('Models\xleg.3DS');
  GLFreeForm4.LoadFromFile('Models\xleg_big.3DS');
  GLFreeForm1.Scale.Scale(0.2);
  GLFreeForm4.Scale.Scale(20);
  GLMaterialLibrary1.LibMaterialByName('marbles1').Material.Texture.Image.LoadFromFile('Textures\marbles1.jpg');
  GLMaterialLibrary1.LibMaterialByName('marbles2').Material.Texture.Image.LoadFromFile('Textures\marbles2.jpg');
  GLMaterialLibrary1.LibMaterialByName('snow').Material.Texture.Image.LoadFromFile('Textures\snow.jpg');
  GLMaterialLibrary1.LibMaterialByName('Fire').Material.Texture.Image.LoadFromFile('Textures\FireGrade.bmp');
  GLMaterialLibrary1.LibMaterialByName('FighterTexture').Material.Texture.Image.LoadFromFile('Textures\FighterTexture.jpg');

  Myshader := TGLCgBombShader.Create(Self);
  Myshader.MainTexture := GLMaterialLibrary1.LibMaterialByName('FighterTexture').Material.Texture;
  MyShader.Cadencer := GLCadencer1;

  //all models are linked with this material
  GLMaterialLibrary1.LibMaterialByName('LibMaterial').Shader := Myshader;

  ResetPositions;
  ComboBox1Change(Self);
end;


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

procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if (ssLeft in Shift) and (ssRight in Shift) then
    GLCamera1.AdjustDistanceToTarget(1 - 0.01 * (my - Y))
  else if (ssLeft in Shift) or (ssRight in Shift) then
    GLCamera1.MoveAroundTarget(my - Y, mx - X);

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

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  with GLSceneViewer1 do
    if PtInRect(ClientRect, ScreenToClient(MousePos)) then
    begin
      GLCamera1.SceneScale := GLCamera1.SceneScale * (1000 - WheelDelta) / 1000;
      Handled := True;
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  with GLSceneViewer1 do
  begin
    Caption := Format('Cg Shader Demo - %.1f fps', [FramesPerSecond]);
    ResetPerformanceMonitor;
  end;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #27 then
    Close;
end;


procedure TForm1.StrangeTrackBar1Change(Sender: TObject);
begin
  if Myshader = nil then
    Exit;

  Myshader.Displacement := StrangeTrackBar1.RealPosition;
  Myshader.Sharpness := StrangeTrackBar2.RealPosition;
  Myshader.ColorSharpness := StrangeTrackBar3.RealPosition;
  Myshader.Speed := StrangeTrackBar4.RealPosition;
  Myshader.TurbDensity := StrangeTrackBar5.RealPosition;
  Myshader.ColorRange := StrangeTrackBar6.RealPosition;
  Myshader.Alpha := StrangeTrackBar7.RealPosition;
  Myshader.MainTextureShare := StrangeTrackBar8.RealPosition;
  Myshader.GradientTextureShare := StrangeTrackBar9.RealPosition;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  Myshader.GradientTexture := GLMaterialLibrary1.LibMaterialByName(ComboBox1.Text).Material.Texture;
end;

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

procedure TForm1.ResetPositions;
begin
  StrangeTrackBar1.RealPosition := Myshader.Displacement;
  StrangeTrackBar2.RealPosition := Myshader.Sharpness;
  StrangeTrackBar3.RealPosition := Myshader.ColorSharpness;
  StrangeTrackBar4.RealPosition := Myshader.Speed;
  StrangeTrackBar5.RealPosition := Myshader.TurbDensity;
  StrangeTrackBar6.RealPosition := Myshader.ColorRange;
  StrangeTrackBar7.RealPosition := Myshader.Alpha;
  StrangeTrackBar8.RealPosition := Myshader.MainTextureShare;
  StrangeTrackBar9.RealPosition := Myshader.GradientTextureShare;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  GLFreeForm1.Visible := CheckBox1.Checked;
  GLFreeForm2.Visible := CheckBox2.Checked;
  GLFreeForm3.Visible := CheckBox3.Checked;
  GLFreeForm4.Visible := CheckBox4.Checked;
end;

procedure TForm1.ShaderEnabledCheckBoxClick(Sender: TObject);
begin
  MyShader.Enabled := ShaderEnabledCheckBox.Checked;
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/
    TEAPOT.3DS
    mesh_near.md3
    xleg.3DS
    xleg_big.3DS
  Textures/
    FighterTexture.jpg
    FireGrade.bmp
    marbles1.jpg
    marbles2.jpg
    snow.jpg
  StrangeCGBombShaderDemo.dpr
  StrangeCGBombShaderDemo.res
  Unit1.dfm
  Unit1.pas
  _Cleanup.bat