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, StdCtrls, ComCtrls, ExtCtrls,

  //GLScene
  GLBehaviours, GLCadencer, GLScene, GLObjects, GLMisc, VectorGeometry,
  GLWin32Viewer, AsyncTimer, GLGeomObjects, GLGraph, GLTexture, VectorLists,
  GLMovement, GLVectorFileObjects, GLVfsPAK,

  //File Types
  JPEG, GLFileMD3,

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

type
  TForm1 = class(TForm)
    GLSceneViewer1: TGLSceneViewer;
    GLScene1:     TGLScene;
    CameraTarget: TGLDummyCube;
    GLCadencer1:  TGLCadencer;
    GLLightSource1: TGLLightSource;
    AsyncTimer1:  TAsyncTimer;
    GLPlane1:     TGLPlane;
    GLXYZGrid1:   TGLXYZGrid;
    GroupBox1:    TGroupBox;
    GLCamera1: TGLCamera;
    Button2: TButton;
    Button3: TButton;
    CannonDummy: TGLDummyCube;
    Cannon_Up: TGLFreeForm;
    Cannon_Middle: TGLFreeForm;
    Cannon_Down: TGLFreeForm;
    CannonTarget: TGLDummyCube;
    GLMaterialLibrary1: TGLMaterialLibrary;
    Button1: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    GLCube1: TGLCube;
    Ship: TGLFreeForm;
    end_tip: TGLSphere;
    start_tip: TGLSphere;
    ShipDummy: TGLDummyCube;
    Button7: TButton;
    GLArrowLine1: TGLArrowLine;
    Button8: TButton;
    Button9: TButton;
    StrangeTrackBar1: TStrangeTrackBar;
    GLVfsPAK1: TGLVfsPAK;
    GroupBox2: TGroupBox;
    CheckBox1: TCheckBox;
    DetectorsCheckBox: TCheckBox;
    procedure AsyncTimer1Timer(Sender: TObject);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: integer);
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure FormCreate(Sender: TObject);
    procedure GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: double);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure StrangeTrackBar1Change(Sender: TObject);
    procedure DetectorsCheckBoxClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1:  TForm1;

  xx, yy: integer;
  NewXX, NewYY: integer;
  ShiftState: TShiftState;

  Cannon: TStrangeCannon;
  TargetSpeed: Single;

implementation

{$R *.dfm}

procedure TForm1.AsyncTimer1Timer(Sender: TObject);
begin
  Caption := 'StrangeCannon Demo  by Da Stranger  -  ' + GLSceneViewer1.FramesPerSecondText;
  GLSceneViewer1.ResetPerformanceMonitor;

  if ShipDummy.DistanceTo(CannonTarget) > Cannon.EffectiveRadius * 1.3 then
    Button7Click(Self);
end;


procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: integer);
begin
  ShiftState :=  Shift;
  NewXX := X;
  NewYY := Y;

  if (ssRight in ShiftState) and (ssLeft in ShiftState) then
    GLCamera1.AdjustDistanceToTarget(1 - (yy - NewYY)* 0.01)
  else if (ssRight in ShiftState) or (ssLeft in ShiftState) then
    GLCamera1.MoveAroundTarget(yy - NewYY, xx - NewXX);

  xx := NewXX;
  yy := NewYY;
end;


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


procedure TForm1.FormCreate(Sender: TObject);
begin
  //standard texture and model stuff
  GLVfsPAK1.LoadFromFile('Media\Media.pak', 0);
  with GLMaterialLibrary1.Materials[0].Material.Texture do
  begin
    Image.LoadFromFile('Media\tex006.jpg');
    Disabled := False;
  end;

  with GLMaterialLibrary1.Materials[1].Material.Texture do
  begin
    Image.LoadFromFile('Media\MSS_terra1.jpg');
    Disabled := False;
  end;

  CannonDummy.Scale.Scale(0.0031);
  Cannon_Up.LoadFromFile('Media\top_gun.MD3');
  Cannon_Middle.LoadFromFile('Media\middle_gun.MD3');
  Cannon_Down.LoadFromFile('Media\niz_gun.MD3');

  Ship.LoadFromFile('Media\MSS_terra1.MD3');
  Ship.Scale.Scale(0.01);

  start_tip.Scale.Scale(1 / 0.0031);
  end_tip.Scale.Scale(1 / 0.0031);

  //my class stuff
  Cannon := TStrangeCannon.Create(Self);
  with Cannon do
  begin
    TipStart := start_tip;
    TipEnd := end_tip;
    CannonUp := Cannon_Up;
    CannonMiddle := Cannon_Middle;
    EffectiveRadius := 40;
    TurnSpeed := 20;
    PitchSpeed := 20;
    Target := CannonTarget;
  end;

  TargetSpeed := 5;
end;


procedure TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: double);
begin
  CannonTarget.Move(DeltaTime * TargetSpeed);

  if Cannon <> nil then
  if not CheckBox1.Checked then
    Cannon.Proceed(DeltaTime);
end;


procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  GLCamera1.AdjustDistanceToTarget(1 + (WheelDelta / abs(WheelDelta))* 0.1);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  GLCadencer1.Enabled := False;
  Cannon.Destroy;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
{$IFDEF STRANGE_INIFILE_SUPPORT}
  Cannon.SaveToIniFile('saved_cannon.ini');
  ShowMessage('Saved Successfully');
{$ELSE}
  Assert(False, SIF_ERROR);
{$ENDIF}
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
{$IFDEF STRANGE_INIFILE_SUPPORT}
  Cannon.LoadFromIniFile('saved_cannon.ini');
  ShowMessage('Loaded Successfully');
{$ELSE}
  Assert(False, SIF_ERROR);
{$ENDIF}
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  Cannon_Up.Pitch(10);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  Cannon_Up.Pitch(-10);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Cannon_Middle.Roll(10);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  Cannon_Middle.Roll(-10);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  CannonTarget.Position.SetPoint(-10, -10, -5);
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  CannonTarget.Behaviours[0].Destroy;
  TargetSpeed := 0;
  Button8.Enabled := False;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
  GLCadencer1.Enabled := not GLCadencer1.Enabled;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  GroupBox1.Visible := CheckBox1.Checked;
end;

procedure TForm1.StrangeTrackBar1Change(Sender: TObject);
begin
  TargetSpeed := StrangeTrackBar1.RealPosition;
end;

procedure TForm1.DetectorsCheckBoxClick(Sender: TObject);
begin
  start_tip.Visible := DetectorsCheckBox.Checked;
    end_tip.Visible := DetectorsCheckBox.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

  Media/
    Media.pak
    middle_gun.MD3
    niz_gun.MD3
    tex006.jpg
    top_gun.MD3
  StrangeCannonDemo.dpr
  StrangeCannonDemo.res
  Unit1.dfm
  Unit1.pas
  _Cleanup.bat
  saved_cannon.ini