GLScene/Source/FmLibMaterialPicker.pas

//
// The graphics engine GLScene
//
unit FmLibMaterialPicker;

(* Allows choosing a material in a material library *)

interface

{$I Stage.Defines.inc}

uses
  System.Classes,
  System.Types,
  Vcl.Forms,
  Vcl.StdCtrls,
  Vcl.Buttons,
  Vcl.Controls,
  Vcl.Graphics,

  GLS.Scene,
  GLS.Objects,
  GLS.SceneViewer,
  GLS.Material,
  GLS.Color,
  GLS.Coordinates,
  GLS.BaseClasses,
  GLS.HUDObjects,
  GLS.GeomObjects;

type
  TGLLibMaterialPickerForm = class(TForm)
    ListBoxMaterials: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    BitBtnOk: TBitBtn;
    BitBtnCancel: TBitBtn;
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    LightSource1: TGLLightSource;
    dcLight1: TGLDummyCube;
    dcWorld1: TGLDummyCube;
    Camera1: TGLCamera;
    Cube1: TGLCube;
    Sphere1: TGLSphere;
    FireSphere1: TGLSphere;
    Teapot1: TGLTeapot;
    GLMaterialLibrary1: TGLMaterialLibrary;
    ComboBoxObject1: TComboBox;
    ComboBoxBackGround1: TComboBox;
    BackGroundSprite1: TGLHUDSprite;
    LightSource2: TGLLightSource;
    procedure ListBoxMaterialsClick(Sender: TObject);
    procedure ListBoxMaterialsKeyPress(Sender: TObject; var Key: Char);
    procedure ListBoxMaterialsDblClick(Sender: TObject);
    procedure ComboBoxObject1Change(Sender: TObject);
    procedure ComboBoxBackGround1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewer1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint; var Handled: Boolean);
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
      Y: Integer);
  private
    mx, my: Integer;

    FLibMaterial1: TGLAbstractLibMaterial;
    function GetMaterial1: TGLMaterial;
    procedure SetMaterial1(const Value: TGLMaterial);
    function GetLibMaterial1: TGLAbstractLibMaterial;
    procedure SetLibMaterial1(const Value: TGLAbstractLibMaterial);

  public
    function Execute(var MaterialName: TGLLibMaterialName;
      MaterialLibrary: TGLAbstractMaterialLibrary): Boolean;
    property Material1: TGLMaterial read GetMaterial1 write SetMaterial1;
    property LibMaterial1: TGLAbstractLibMaterial read GetLibMaterial1 write SetLibMaterial1;

  end;

// For registration in GLScene
function GLLibMaterialPickerForm: TGLLibMaterialPickerForm;
procedure ReleaseLibMaterialPickerForm;

//-------------------------------------------------
implementation
//-------------------------------------------------

{$R *.dfm}

var
  vGLLibMaterialPickerForm: TGLLibMaterialPickerForm;

// ------------ GLLibMaterialPickerForm -----------------

function GLLibMaterialPickerForm: TGLLibMaterialPickerForm;
begin
  if not Assigned(vGLLibMaterialPickerForm) then
    vGLLibMaterialPickerForm := TGLLibMaterialPickerForm.Create(nil);
  Result := vGLLibMaterialPickerForm;
end;

// ----------- ReleaseLibMaterialPickerForm --------------

procedure ReleaseLibMaterialPickerForm;
begin
  if Assigned(vGLLibMaterialPickerForm) then
  begin
    vGLLibMaterialPickerForm.Free;
    vGLLibMaterialPickerForm := nil;
  end;
end;

//------------------- FormCreate --------------------------

procedure TGLLibMaterialPickerForm.FormCreate(Sender: TObject);
begin
  // BackGroundSprite positions and size
  BackGroundSprite1.Position.X := GLSceneViewer1.Width div 2;
  BackGroundSprite1.Position.Y := GLSceneViewer1.Height div 2;
  BackGroundSprite1.Width := GLSceneViewer1.Width;
  BackGroundSprite1.Height := GLSceneViewer1.Height;

  ComboBoxObject1.ItemIndex := 0;
  ComboBoxObject1Change(Self);
  ComboBoxBackground1.ItemIndex := 0;
  ComboBoxBackground1Change(Self);
end;

// ----------------------- MouseMove ----------------------

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

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

// ----------------------- MouseWheel ----------------------
procedure TGLLibMaterialPickerForm.GLSceneViewer1MouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  Camera1.AdjustDistanceToTarget(1 - 0.1 * (Abs(WheelDelta) / WheelDelta));
end;


//------------------ Execute --------------------------

function TGLLibMaterialPickerForm.Execute(var MaterialName: TGLLibMaterialName;
  MaterialLibrary: TGLAbstractMaterialLibrary): Boolean;
begin
  MaterialLibrary.SetNamesToTStrings(ListBoxMaterials.Items);
  ListBoxMaterials.ItemIndex := ListBoxMaterials.Items.IndexOf(MaterialName);
  if ((ListBoxMaterials.ItemIndex < 0) and (ListBoxMaterials.Items.Count > 0)) then
    ListBoxMaterials.ItemIndex := 0;
  BitBtnOk.Enabled := (ListBoxMaterials.Items.Count > 0);

  ListBoxMaterialsClick(Self);
  Result := (ShowModal = mrOk);
  if Result then
  begin
    if ListBoxMaterials.ItemIndex >= 0 then
      MaterialName := ListBoxMaterials.Items[ListBoxMaterials.ItemIndex]
    else
      MaterialName := '';
  end;
end;

//-------------------------------------------------------------------

function TGLLibMaterialPickerForm.GetLibMaterial1: TGLAbstractLibMaterial;
begin
   Result := FLibMaterial1;
end;

function TGLLibMaterialPickerForm.GetMaterial1: TGLMaterial;
begin
   Result := GLMaterialLibrary1.Materials[0].Material;
end;


procedure TGLLibMaterialPickerForm.ListBoxMaterialsClick(Sender: TObject);
begin
  if ListBoxMaterials.ItemIndex >= 0 then
    LibMaterial1 := TGLAbstractLibMaterial(ListBoxMaterials.Items.Objects[ListBoxMaterials.ItemIndex]);
   Cube1.Material :=  Material1;
   Sphere1.Material := Material1;
   TeaPot1.Material := Material1;
end;

procedure TGLLibMaterialPickerForm.ListBoxMaterialsKeyPress(Sender: TObject;
  var Key: Char);
begin
  ListBoxMaterialsClick(Sender);
end;

procedure TGLLibMaterialPickerForm.SetLibMaterial1(const Value: TGLAbstractLibMaterial);
begin
  FLibMaterial1 := Value;
  if Assigned(FLibMaterial1) then
  begin
    GLMaterialLibrary1.Materials[0].Material.MaterialLibrary := FLibMaterial1.MaterialLibrary;
    GLMaterialLibrary1.Materials[0].Material.LibMaterialName := FLibMaterial1.Name
  end
  else
  begin
    GLMaterialLibrary1.Materials[0].Material.MaterialLibrary := nil;
    GLMaterialLibrary1.Materials[0].Material.LibMaterialName := '';
  end;
end;

procedure TGLLibMaterialPickerForm.SetMaterial1(const Value: TGLMaterial);
begin
  GLMaterialLibrary1.Materials[0].Material.Assign(Value.GetActualPrimaryMaterial);
end;

// ------------------- ComboBoxObject1Change -----------------------------

procedure TGLLibMaterialPickerForm.ComboBoxObject1Change(Sender: TObject);
begin
  var i: Integer := ComboBoxObject1.ItemIndex;
  Cube1.Visible := i = 0;
  Sphere1.Visible := i = 1;
  Teapot1.Visible := i = 2;
end;

// ------------------- ComboBoxBackGround1Change -----------------------------

procedure TGLLibMaterialPickerForm.ComboBoxBackGround1Change(Sender: TObject);
var
  bgColor: TColor;  // from Vcl.Graphics
begin
  case ComboBoxBackground1.ItemIndex of
    1: bgColor := clWhite;
    2: bgColor := clBlack;
    3: bgColor := clBlue;
    4: bgColor := clRed;
    5: bgColor := clGreen;
  else
    bgColor := clNone;   // 0 - pattern background
  end;
  BackGroundSprite1.Material.Texture.Disabled := (bgColor <> clNone);
  BackGroundSprite1.Material.FrontProperties.Diffuse.Color := ConvertWinColor(bgColor);
end;


procedure TGLLibMaterialPickerForm.ListBoxMaterialsDblClick(Sender: TObject);
begin
  BitBtnOk.Click;
end;


//-----------------------------------------------------------------
initialization
//-----------------------------------------------------------------

finalization

 ReleaseLibMaterialPickerForm;

end.