Unit1.pas from Sector-37 at Krugle

Show Unit1.pas syntax highlighted

//this is a modified example, original author of which is Blaise Bernier (08/12/2003)
unit Unit1;

interface

{$I GLScene.inc}

uses
  //VCL
  Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls,
  Dialogs, StdCtrls, Graphics,
  //GLScene
  GLMisc, GLWin32Viewer, GLVectorFileObjects, GLObjects, OpenGL1x,
  GLCadencer, GLScene, GLBehaviours,
  //FileFormats
  GLFile3DS, JPEG,
  //Strange
  StrangeModelManager {$IFDEF STRANGE_INIFILE_SUPPORT},StrangeIniObjects{$ENDIF};

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    GLSceneViewer1: TGLSceneViewer;
    GLScene1: TGLScene;
    gloMasterDummy: TGLDummyCube;
    GLCamera1: TGLCamera;
    gloScene: TGLDummyCube;
    Button1: TButton;
    GLLightSource1: TGLLightSource;
    lblCount: TLabel;
    lstModels: TListBox;
    lblProxies: TLabel;
    c1: TComboBox;
    c2: TComboBox;
    Button2: TButton;
    Image1: TImage;
    GLCadencer1: TGLCadencer;
    Timer1: TTimer;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    procedure UpdateGUI;
    { Public declarations }
  end;

var
  Form1:   TForm1;
  Manager: TStrangeModelManager;  // The model Manager
  Mx, My:  Integer;



implementation

{$R *.dfm}

procedure TForm1.UpdateGUI;
var
  Tmp: Integer;
begin
  // Keep track of the Manager's list
  lblCount.Caption := 'Models in the list : ' + IntToStr(gloMasterDummy.Count);
  lblProxies.Caption := 'Proxies in the scene : ' + IntToStr(gloScene.Count);
  Tmp := lstModels.ItemIndex;
  lstModels.Items := Manager.ModelList;
  if lstModels.Count > Tmp then
    lstModels.ItemIndex := Tmp;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
  // Create the Manager : give him a dummycube to store the freeforms
  //    and give him the path to the models
  Manager := TStrangeModelManager.Create(gloMasterDummy);
end;


procedure TForm1.Button1Click(Sender: TObject);

  function RandomCoord: Single;
  begin
    Result := (Random * 20) - 10;
  end;

var
  NewProxy: TGLProxyObject;
  Bitmap:   TBitmap;

begin
  // This is the creation of a new proxy
  NewProxy := TGLProxyObject(gloScene.AddNewChild(TGLProxyObject));
  NewProxy.Position.X := RandomCoord;
  NewProxy.Position.Y := RandomCoord;
  NewProxy.Position.Z := RandomCoord;

  // Need a master object for this new proxy?
  // Just use the Manager :
  NewProxy.MasterObject := Manager.LoadModel(c1.Text, c2.Text);
  Bitmap := TGLActor(NewProxy.MasterObject).Material.Texture.Image.GetBitmap32(GL_TEXTURE_2D).Create32BitsBitmap;
  Image1.Picture.Bitmap.Assign(Bitmap);
  Bitmap.Free;
  UpdateGUI;
end;


procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  //Rotate the camera

  if (ssRight in Shift) then
    GLCamera1.MoveAroundTarget(Y - mY, mX - X);

  mX := X;
  mY := Y;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
  sel:   string;
  I:     Integer;
  Count: Byte;
  hwnd:  THandle;
begin
  if (lstModels.Items.Text = '') or (lstModels.ItemIndex = -1) then
  begin
    ShowMessage('Error: Nothing was selected, dude!');
    Exit;
  end;
  sel := lstModels.Items[lstModels.ItemIndex];
  Manager.ModelList.Find(sel, I);
  hwnd := TGLActor(Manager.ModelList.Objects[I]).Material.Texture.Handle;

  I := 0;
  Count := GLoScene.Count;
  while I <= (Count - 1) do
  begin
    if TGLActor(TGLProxyObject(GLoScene.Children[I]).masterobject).material.Texture.Handle = hwnd then
    begin
      GLoScene.Children[I].Free;
      Dec(Count);
    end
    else
      Inc(I);
  end;
  UpdateGUI;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Caption := 'StrangeModelManager Test application     ' + GLSceneViewer1.FramesPerSecondText;
  GLSceneViewer1.ResetPerformanceMonitor;
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
  if (lstModels.Items.Text = '') or (lstModels.ItemIndex = -1) then
  begin
    ShowMessage('Error: Nothing was selected, dude!');
    Exit;
  end;
  //first remove all the proxies
  Button2Click(self);
  //then remove the masterobject
  Manager.RemoveModel(lstModels.ItemIndex, True);
  UpdateGUI;
end;


procedure TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double);
begin
  gloScene.Turn(deltaTime * 10);
end;

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

end.
See more files for this project here