Unit1.pas from Sector-37 at Krugle

Show Unit1.pas syntax highlighted

unit Unit1;

interface

{$I GLScene.inc}

uses
  //VCL
  Windows, Forms, StdCtrls, Classes, Controls, GLMisc, ExtCtrls, Graphics,
  SysUtils, Dialogs, ComCtrls,
  //GLScene
  GLScene, GLObjects, GLCadencer, GLLensFlare, GLWin32Viewer, GLBehaviours,
  GLTexture, GLTexCombineShader, GLSkydome, OpenGL1x, VectorGeometry, GLContext,
  GLAtmosphere,
  //File formats
  Jpeg,
  //Strange components
  StrangeDragDropDestination, StrangeTrackBar, StrangeTypesAndConstants
  {$IFDEF STRANGE_INIFILE_SUPPORT}, StrangeIniFiles, StrangeIniObjects{$ENDIF};

type
  TForm1 = class(TForm)
    GLSceneViewer1: TGLSceneViewer;
    GLScene1:   TGLScene;
    GLCamera1:  TGLCamera;
    GLLensFlare1: TGLLensFlare;
    GLCadencer1: TGLCadencer;
    GLLightSource1: TGLLightSource;
    GLSphere1:  TGLSphere;
    GLDummyCube1: TGLDummyCube;
    Button1:    TButton;
    Button2:    TButton;
    Button3:    TButton;
    Button4:    TButton;
    Button5:    TButton;
    Timer1:     TTimer;
    Button6:    TButton;
    Not_a_planet: TGLSphere;
    ChangeAtmButton: TButton;
    Button8:    TButton;
    CameraTarget: TGLDummyCube;
    Button9:    TButton;
    Button10:   TButton;
    CheckBox1:  TCheckBox;
    GLSkyDome1: TGLSkyDome;
    Button11: TButton;
    Button12: TButton;
    ExplorerDrop1: TStrangeDragDropDestination;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    StrangeTrackBar1: TStrangeTrackBar;
    StrangeTrackBar2: TStrangeTrackBar;
    StrangeTrackBar3: TStrangeTrackBar;
    TabSheet3: TTabSheet;
    Memo2: TMemo;
    StrangeTrackBar5: TStrangeTrackBar;
    StrangeTrackBar6: TStrangeTrackBar;
    StrangeTrackBar7: TStrangeTrackBar;
    StrangeTrackBar9: TStrangeTrackBar;
    StrangeTrackBar10: TStrangeTrackBar;
    StrangeTrackBar11: TStrangeTrackBar;
    StrangeTrackBar12: TStrangeTrackBar;
    Button7: TButton;
    ExplorerDrop2: TStrangeDragDropDestination;
    ExplorerDrop3: TStrangeDragDropDestination;
    Button13: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: integer);
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: integer; MousePos: TPoint; var Handled: Boolean);
    procedure ChangeAtmButtonClick(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure ExplorerDrop1Dropped(Sender: TObject; Files: TStrings;
      FileCount, x, y: Integer);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure StrangeTrackBar11Change(Sender: TObject);
    procedure StrangeTrackBar12Change(Sender: TObject);
    procedure StrangeTrackBar5Change(Sender: TObject);
    procedure StrangeTrackBar6Change(Sender: TObject);
    procedure StrangeTrackBar7Change(Sender: TObject);
    procedure StrangeTrackBar9Change(Sender: TObject);
    procedure StrangeTrackBar10Change(Sender: TObject);
    procedure StrangeTrackBar1Change(Sender: TObject);
    procedure StrangeTrackBar2Change(Sender: TObject);
    procedure StrangeTrackBar3Change(Sender: TObject);

    procedure SyncronizeSliders;
    procedure Button13Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1:  TForm1;
  Atmosphere:  TGLAtmosphere;
  mx, my: integer;


implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Atmosphere := TGLAtmosphere.CreateAsChild(GLDummyCube1);
  Atmosphere.Sun := glLensFlare1;
{$IFDEF STRANGE_INIFILE_SUPPORT}
  Atmosphere.LoadFromIniFile('atm2.dsc', STR_GENERAL_SECTION, '', '', False);
{$ENDIF}
  Atmosphere.SetOptimalAtmosphere2(GLSphere1.Radius);

  Memo2.Lines.LoadFromFile('atm2.dsc');

  GLSkyDome1.Bands.Clear;
  GLSkyDome1.Stars.AddRandomStars(5000, clWhite);

  SyncronizeSliders;
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Atmosphere.Free;
end;


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


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


procedure TForm1.Button1Click(Sender: TObject);
begin
  GLSphere1.Roll(10);
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
  glLensFlare1.Slide(0.8);
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
  glLensFlare1.Slide(-0.8);
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
  GLDummyCube1.Slide(-0.5);
end;


procedure TForm1.Button5Click(Sender: TObject);
begin
  GLDummyCube1.Slide(0.5);
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Caption := 'GLAtmosphere Demo  by Da Stranger  -  ' + GLSceneviewer1.FramesPerSecondText;
  GLSceneviewer1.ResetPerformanceMonitor;
end;


procedure TForm1.Button6Click(Sender: TObject);
begin
  Atmosphere.Visible := not Atmosphere.Visible;
end;


procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: integer; MousePos: TPoint; var Handled: Boolean);
begin
  if WheelDelta > 0 then
    GLCamera1.AdjustDistanceToTarget(1.1)
  else
    GLCamera1.AdjustDistanceToTarget(1 / 1.1);
end;


procedure TForm1.ChangeAtmButtonClick(Sender: TObject);
begin
{$IFDEF STRANGE_INIFILE_SUPPORT}
  if ChangeAtmButton.Tag = 0 then
  begin
    Atmosphere.LoadFromIniFile('atm1.dsc', STR_GENERAL_SECTION, '', '', False);
    Memo2.Lines.LoadFromFile('atm1.dsc');
    ChangeAtmButton.Tag := 1;
  end
  else
  begin
    Atmosphere.LoadFromIniFile('atm2.dsc', STR_GENERAL_SECTION, '', '', False);
    Memo2.Lines.LoadFromFile('atm2.dsc');
    ChangeAtmButton.Tag := 0;
  end;

  SyncronizeSliders;
  if CheckBox1.Checked then
    Atmosphere.SetOptimalAtmosphere2(GLSphere1.Radius);
{$ELSE}
  Assert(False, SIF_ERROR);
{$ENDIF}
end;


procedure TForm1.Button8Click(Sender: TObject);
begin
  Atmosphere.TogleBlendingMode;
end;


procedure TForm1.Button10Click(Sender: TObject);
begin
  GLCamera1.AdjustDistanceToTarget(1.1);
end;


procedure TForm1.Button9Click(Sender: TObject);
begin
  GLCamera1.AdjustDistanceToTarget(1 / 1.1);
end;


procedure TForm1.Button7Click(Sender: TObject);
begin
{$IFDEF STRANGE_INIFILE_SUPPORT}
  Atmosphere.LoadFromIniStrings(Memo2.Lines, STR_GENERAL_SECTION, '', '', False);
  if CheckBox1.Checked then
    Atmosphere.SetOptimalAtmosphere2(GLSphere1.Radius);

  SyncronizeSliders;
{$ELSE}
  Assert(False, SIF_ERROR);
{$ENDIF}  
end;

procedure TForm1.ExplorerDrop1Dropped(Sender: TObject; Files: TStrings;
  FileCount, x, y: Integer);
begin
  if UpperCase(ExtractFileExt(Files[0])) <> '.DSC' then
    ShowMessage('Only *.dsc files allowed!')
  else
    Memo2.Lines.LoadFromFile(Files[0]);

  Button7Click(Self);
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
  if not OpenDialog1.Execute then exit;

  Memo2.Lines.LoadFromFile(OpenDialog1.FileName);
  Button7Click(Self);
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    Memo2.Lines.SaveToFile(SaveDialog1.FileName);
end;

procedure TForm1.StrangeTrackBar11Change(Sender: TObject);
begin
if Atmosphere <> nil then
  Atmosphere.AtmosphereRadius := StrangeTrackBar11.RealPosition;

if StrangeTrackBar12 <> nil then
  StrangeTrackBar12.RealMax := StrangeTrackBar11.RealPosition - 0.01;
end;

procedure TForm1.StrangeTrackBar12Change(Sender: TObject);
begin
if Atmosphere <> nil then
  Atmosphere.PlanetRadius := StrangeTrackBar12.RealPosition;

if StrangeTrackBar11 <> nil then
  StrangeTrackBar11.RealMin := StrangeTrackBar12.RealPosition + 0.01;
end;

procedure TForm1.StrangeTrackBar5Change(Sender: TObject);
begin
if Atmosphere <> nil then
  Atmosphere.HighAtmColor.Red := StrangeTrackBar5.RealPosition;
end;

procedure TForm1.StrangeTrackBar6Change(Sender: TObject);
begin
if Atmosphere <> nil then
  Atmosphere.HighAtmColor.Green := StrangeTrackBar6.RealPosition;
end;

procedure TForm1.StrangeTrackBar7Change(Sender: TObject);
begin
if Atmosphere <> nil then
  Atmosphere.HighAtmColor.Blue := StrangeTrackBar7.RealPosition;
end;

procedure TForm1.StrangeTrackBar9Change(Sender: TObject);
begin
if Atmosphere <> nil then
  Atmosphere.Slices := Round(StrangeTrackBar9.RealPosition);
end;

procedure TForm1.StrangeTrackBar10Change(Sender: TObject);
begin
if Atmosphere <> nil then
  Atmosphere.Opacity := StrangeTrackBar10.RealPosition;
end;

procedure TForm1.StrangeTrackBar1Change(Sender: TObject);
begin
if Atmosphere <> nil then
  Atmosphere.LowAtmColor.Red := StrangeTrackBar1.RealPosition;
end;

procedure TForm1.StrangeTrackBar2Change(Sender: TObject);
begin
if Atmosphere <> nil then
  Atmosphere.LowAtmColor.Green := StrangeTrackBar2.RealPosition;
end;

procedure TForm1.StrangeTrackBar3Change(Sender: TObject);
begin
if Atmosphere <> nil then
  Atmosphere.LowAtmColor.Blue := StrangeTrackBar3.RealPosition;
end;

procedure TForm1.SyncronizeSliders;
begin
  StrangeTrackBar11.OnChange := nil;
  StrangeTrackBar12.OnChange := nil;
  StrangeTrackBar11.RealPosition := Atmosphere.AtmosphereRadius;
  StrangeTrackBar12.RealPosition := Atmosphere.PlanetRadius;
  StrangeTrackBar11.OnChange := StrangeTrackBar11Change;
  StrangeTrackBar12.OnChange := StrangeTrackBar12Change;

  StrangeTrackBar5.RealPosition := Atmosphere.HighAtmColor.Color[0];
  StrangeTrackBar6.RealPosition := Atmosphere.HighAtmColor.Color[1];
  StrangeTrackBar7.RealPosition := Atmosphere.HighAtmColor.Color[2];

  StrangeTrackBar9.RealPosition := Atmosphere.Slices;
  StrangeTrackBar10.RealPosition := Atmosphere.Opacity;
  StrangeTrackBar1.RealPosition := Atmosphere.LowAtmColor.Color[0];
  StrangeTrackBar2.RealPosition := Atmosphere.LowAtmColor.Color[1];
  StrangeTrackBar3.RealPosition := Atmosphere.LowAtmColor.Color[2];
end;

procedure TForm1.Button13Click(Sender: TObject);
begin
{$IFDEF STRANGE_INIFILE_SUPPORT}
  Atmosphere.SaveToIniStrings(Memo2.Lines, STR_GENERAL_SECTION, '', '', False);
{$ELSE}
  Assert(False, SIF_ERROR);
{$ENDIF}
end;

end.
See more files for this project here