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

  // GLScene
  GLBehaviours, GLCadencer, GLScene, GLObjects, GLMisc, VectorGeometry, GLColor,
  GLWin32Viewer, AsyncTimer, GLGeomObjects, GLGraph, GLTexture, VectorLists,

  // Strange components
  StrangeLines, 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;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    GroupBox2: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    GroupBox3: TGroupBox;
    RadioButton6: TRadioButton;
    RadioButton7: TRadioButton;
    GLCamera1: TGLCamera;
    GLCube1: TGLCube;
    GroupBox4: TGroupBox;
    LabeledEdit1: TLabeledEdit;
    UpDown1: TUpDown;
    LabeledEdit2: TLabeledEdit;
    UpDown2: TUpDown;
    ComboBox1: TComboBox;
    Label1: TLabel;
    ComboBox2: TComboBox;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    RadioButton0: TRadioButton;
    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 RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure RadioButton5Click(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Refresh(Sender: TObject);
    procedure RefreshVisualStuff(Sender: TObject);
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
    procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure RadioButton0Click(Sender: TObject);
  private
    { Private declarations }
  public
  procedure AddDots(Number: integer);
    { Public declarations }
  end;

var
  Form1:  TForm1;

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

  StrangeLines: TStrangeLines;
  GLLines: TGLLines;
  GLPoints: TGLPoints;

implementation

{$R *.dfm}

procedure TForm1.AddDots(Number: integer);
var
  i: integer;
begin
  //my dots
  with StrangeLines, StrangeLines.Nodes do
  begin
    Clear;
    for i := 1 to Number do
      Add(random * 10 - 5, random * 10 - 5, random * 10 - 5);
  end;

  //lines
  with GLLines.Nodes do
  begin
    Clear;
    for i := 0 to Number - 1 do //replace the two lines and see the result...
      AddNode(StrangeLines.Nodes[i][0], StrangeLines.Nodes[i][1], StrangeLines.Nodes[i][2]);
//      AddNode(random * 10 - 5, random * 10 - 5, random * 10 - 5);
  end;

  //points
  with GLPoints.Positions do
  begin
    Clear;
    for i := 0 to Number - 1 do
      Add(GLLines.Nodes[i].X, GLLines.Nodes[i].Y, GLLines.Nodes[i].Z);
  end;

  RefreshVisualStuff(Self);
end;

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


procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: integer);
begin
  ShiftState :=  Shift;
  NewXX := X;
  NewYY := Y;
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
  StrangeLines := TStrangeLines.CreateAsChild(GLScene1.Objects);
//  StrangeLines.Nodes.EraceSectionBeforeSaving := False;
  GLLines := TGLLines.CreateAsChild(GLScene1.Objects);
  GLLines.NodesAspect := lnaInvisible;
  GLPoints := TGLPoints.CreateAsChild(GLScene1.Objects);
  Randomize;
  RadioButton3Click(Self); //add 1 000 Dots

  //just refresh all the buttons
  UpDown1Click(Self, btNext);
  UpDown2Click(Self, btNext);
  ComboBox1Change(Self);
  ComboBox2Change(Self);
end;


procedure TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: double);
begin
  if (ssRight in ShiftState) or (ssLeft in ShiftState) then
    GLCamera1.MoveAroundTarget(yy - NewYY, xx - NewXX);

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


procedure TForm1.RadioButton0Click(Sender: TObject);
begin
  AddDots(1);
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  AddDots(10);
end;


procedure TForm1.RadioButton2Click(Sender: TObject);
begin
  AddDots(100);
end;


procedure TForm1.RadioButton3Click(Sender: TObject);
begin
  AddDots(1000);
end;


procedure TForm1.RadioButton4Click(Sender: TObject);
begin
  AddDots(10000);
end;


procedure TForm1.RadioButton5Click(Sender: TObject);
begin
  AddDots(100000);
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;

  StrangeLines.Free;
  GLLines.Free;
  GLPoints.Free;
end;

procedure TForm1.Refresh(Sender: TObject);
begin
  //Refresh
  AddDots(StrangeLines.Nodes.Count);
end;

procedure TForm1.RefreshVisualStuff(Sender: TObject);
begin
  if RadioButton6.checked then
  begin
    StrangeLines.Visible := True;
    StrangeLines.DrawLines := CheckBox1.Checked;
    StrangeLines.DrawDots := CheckBox2.Checked;
    GLLines.Visible := False;
    GLPoints.Visible := False;
  end
  else
  begin
    StrangeLines.Visible := False;
    GLLines.Visible := CheckBox1.Checked;
    GLPoints.Visible := CheckBox2.Checked;
  end;
end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
  StrangeLines.LineWidth := UpDown1.Position;
  GLLines.LineWidth := UpDown1.Position;
end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
  StrangeLines.DotSize := UpDown2.Position;
  GLPoints.Size := UpDown2.Position;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  GLLines.LineColor.AsWinColor := StringToColor(ComboBox1.Text);
  StrangeLines.LineColor.Color := GLLines.LineColor.Color;
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
begin
  GLPoints.Colors.Clear;
  GLPoints.Colors.Add(ConvertWinColor(StringToColor(ComboBox2.Text)));
  StrangeLines.DotColor.Color := ConvertWinColor(StringToColor(ComboBox2.Text));
end;

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

procedure TForm1.Button3Click(Sender: TObject);
begin
{$IFDEF STRANGE_INIFILE_SUPPORT}
  StrangeLines.LoadFromIniFile('saved_lines.ini', 'General', '', '', True);
  ShowMessage('Loaded Successfully');
{$ELSE}
  Assert(False, SIF_ERROR);
{$ENDIF}
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

  StrangeLinesDemo.dpr
  StrangeLinesDemo.res
  Unit1.dfm
  Unit1.pas
  _Cleanup.bat
  saved_lines.ini