GLScene/Demos/interface/Gizmo/fGizmo.pas

unit fGizmo;

interface

uses
  Winapi.OpenGL,
  System.SysUtils,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.StdCtrls,
  Vcl.Dialogs,
  Vcl.ExtCtrls,

  
  GLS.Scene,
  GLS.Cadencer,
  GLS.PersistentClasses,
  GLS.Objects,
  GLS.SpaceText,
  GLS.SceneViewer,
  GLS.BitmapFont,
  GLS.WindowsFont,
  GLS.HUDObjects,
  GLS.GeomObjects,
  GLS.Gizmo,
 
  GLS.Coordinates,
  GLS.BaseClasses, GLS.VectorFileObjects;

type
  TFormGizmo = class(TForm)
    GLScene1: TGLScene;
    Viewer: TGLSceneViewer;
    Camera: TGLCamera;
    GLDummyCube1: TGLDummyCube;
    GLCadencer1: TGLCadencer;
    GLLightSource1: TGLLightSource;
    GLLightSource2: TGLLightSource;
    RootGizmo: TGLDummyCube;
    Panel1: TPanel;
    Bevel1: TBevel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CBXAxis: TComboBox;
    CheckBox3: TCheckBox;
    CBXOperation: TComboBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    CheckBox11: TCheckBox;
    ColorBox1: TColorBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ColorBox2: TColorBox;
    ColorBox3: TColorBox;
    Label4: TLabel;
    edAutoZoomFactor: TEdit;
    Label5: TLabel;
    edZoomFactor: TEdit;
    CheckBox12: TCheckBox;
    Label6: TLabel;
    edMoveCoef: TEdit;
    edRotateCoef: TEdit;
    CheckBox13: TCheckBox;
    CheckBox14: TCheckBox;
    CheckBox15: TCheckBox;
    GLDodecahedron3: TGLDodecahedron;
    GLArrowLine3: TGLArrowLine;
    GLArrowLine4: TGLArrowLine;
    edScaleCoef: TEdit;
    Label10: TLabel;
    Label11: TLabel;
    edGizmoThickness: TEdit;
    GLSphere1: TGLSphere;
    GLCube1: TGLCube;
    OptPickMode: TRadioGroup;
    WindowsBitmapFont: TGLWindowsBitmapFont;
    Label7: TLabel;
    procedure GLCadencer1Progress(Sender: TObject; const DeltaTime, newTime: Double);
    procedure ViewerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure edAutoZoomFactorKeyPress(Sender: TObject; var Key: Char);
    procedure CheckBox12Click(Sender: TObject);
    procedure CBXAxisChange(Sender: TObject);
    procedure CBXOperationChange(Sender: TObject);
    procedure edMoveCoefChange(Sender: TObject);
    procedure edRotateCoefChange(Sender: TObject);
    procedure edAutoZoomFactorChange(Sender: TObject);
    procedure edZoomFactorChange(Sender: TObject);
    procedure ColorBox1Change(Sender: TObject);
    procedure edScaleCoefChange(Sender: TObject);
    procedure edGizmoThicknessChange(Sender: TObject);
    procedure OptPickModeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure FillPickableObjectsList(root: TGLBaseSceneObject; doClearList: Boolean);
     
  public
     
    mx, my: Integer;
    //    gizmo: TGLGizmoEx;
    noMouseMotion: Boolean;

  end;

var
  FormGizmo: TFormGizmo;
  Gizmo: TGLGizmo;

implementation

{$R *.dfm}

procedure TFormGizmo.GLCadencer1Progress(Sender: TObject; const DeltaTime, newTime: Double);
begin
  Viewer.Invalidate;
end;

procedure TFormGizmo.OptPickModeClick(Sender: TObject);
begin
  Gizmo.PickMode := TGLGizmoPickMode(OptPickMode.ItemIndex);
end;

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

procedure TFormGizmo.ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  //if noMouseMotion then exit;

  if (shift = [ssLeft]) and (gizmo.SelectedObj = nil) then
    Camera.MoveAroundTarget(Y - my, mx - X)
  else if (shift = [ssRight]) and (gizmo.SelectedObj = nil) then
  begin
    if my > Y then
      Camera.AdjustDistanceToTarget(1.05)
    else
      Camera.AdjustDistanceToTarget(0.95);
    Gizmo.MoveCoef := Camera.DistanceToTarget / 1000;
  end
  else
    Gizmo.ViewerMouseMove(X, Y);

  mx := X;
  my := Y;
end;

procedure TFormGizmo.ViewerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Gizmo.ViewerMouseUp(X, Y);
end;

procedure TFormGizmo.FormShow(Sender: TObject);
begin
  Viewer.SetFocus;
  Gizmo.RootGizmo := rootGizmo;
  // Fill list of pickable objects when using PickMode=pmRaycast
  FillPickableObjectsList(GLDummyCube1, True);
end;


// Recurse root object to fill list of pickable objects when using PickMode=pmRaycast
procedure TFormGizmo.FillPickableObjectsList(root: TGLBaseSceneObject; doClearList: Boolean);
var
  t: Integer;
begin
  if doClearList then
    Gizmo.PickableObjectsWithRayCast.Clear;
  for t := 0 to root.Count - 1 do
  begin
    Gizmo.PickableObjectsWithRayCast.Add(root[t]);
    FillPickableObjectsList(root[t], False);
  end;
end;


procedure TFormGizmo.edAutoZoomFactorKeyPress(Sender: TObject; var Key: Char);
begin
  if not CharInSet(Key,['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '.', ',']) then
    Key := #0;

end;

procedure TFormGizmo.CheckBox12Click(Sender: TObject);
var
  check: Boolean;
begin
  // (Sender as TCheckBox).Checked:=Not((Sender as TCheckBox).Checked);
  check := (Sender as TCheckBox).Checked;
  case (Sender as TCheckBox).Tag of
    0: Gizmo.Enabled := Check;
    1: Gizmo.ExcludeObjects := Check;
    2:
    begin
      Gizmo.ForceAxis := Check;
      CBXAxis.Enabled := Check;
    end;
    3:
    begin
      Gizmo.ForceOperation := Check;
      CBXOperation.Enabled := Check;
    end;
    4: Gizmo.ForceUniformScale := Check;
    5: if Check then
        Gizmo.GizmoElements := Gizmo.GizmoElements + [geAxisLabel]
      else
        Gizmo.GizmoElements := Gizmo.GizmoElements - [geAxisLabel];
    6:
    begin
      if Check then
      begin
        Gizmo.GizmoElements := Gizmo.GizmoElements + [geObjectInfos];
        CheckBox7.Enabled := Check;
        CheckBox8.Enabled := Check;
        CheckBox9.Enabled := Check;
      end
      else
      begin
        Gizmo.GizmoElements := Gizmo.GizmoElements - [geObjectInfos];
        CheckBox7.Enabled := Check;
        CheckBox8.Enabled := Check;
        CheckBox9.Enabled := Check;
      end;
    end;
    7: Gizmo.NoZWrite := Check;
    8:
    begin
      Gizmo.AutoZoom := Check;
      if Check then
      begin
        edAutoZoomFactor.Enabled := True;
        edZoomFactor.Enabled := False;
      end
      else
      begin
        edAutoZoomFactor.Enabled := False;
        edZoomFactor.Enabled := True;
      end;
    end;
    9: if Check then
        Gizmo.VisibleInfoLabels := Gizmo.VisibleInfoLabels + [vliName]
      else
        Gizmo.VisibleInfoLabels := Gizmo.VisibleInfoLabels - [vliName];
    10: if Check then
        Gizmo.VisibleInfoLabels := Gizmo.VisibleInfoLabels + [vliOperation]
      else
        Gizmo.VisibleInfoLabels := Gizmo.VisibleInfoLabels - [vliOperation];
    11: if Check then
        Gizmo.VisibleInfoLabels := Gizmo.VisibleInfoLabels + [vliCoords]
      else
        Gizmo.VisibleInfoLabels := Gizmo.VisibleInfoLabels - [vliCoords];
    12: if Check then
        Gizmo.GizmoElements := Gizmo.GizmoElements + [geMove]
      else
        Gizmo.GizmoElements := Gizmo.GizmoElements - [geMove];
    13: if Check then
        Gizmo.GizmoElements := Gizmo.GizmoElements + [geRotate]
      else
        Gizmo.GizmoElements := Gizmo.GizmoElements - [geRotate];
    14: if Check then
        Gizmo.GizmoElements := Gizmo.GizmoElements + [geScale]
      else
        Gizmo.GizmoElements := Gizmo.GizmoElements - [geScale];
  end;
end;

procedure TFormGizmo.CBXAxisChange(Sender: TObject);
begin
  case CBXAxis.ItemIndex of
    0: Gizmo.SelAxis := gaNone;
    1: Gizmo.SelAxis := gaX;
    2: Gizmo.SelAxis := gaXY;
    3: Gizmo.SelAxis := gaXZ;
    4: Gizmo.SelAxis := gaY;
    5: Gizmo.SelAxis := gaYZ;
    6: Gizmo.SelAxis := gaZ;
  end;
end;

procedure TFormGizmo.CBXOperationChange(Sender: TObject);
begin
  case CBXOperation.ItemIndex of
    0: Gizmo.Operation := gopNone;
    1: Gizmo.Operation := gopMove;
    2: Gizmo.Operation := gopRotate;
    3: Gizmo.Operation := gopScale;
  end;
end;

procedure TFormGizmo.edMoveCoefChange(Sender: TObject);
begin
  if edMoveCoef.Text <> '' then
    Gizmo.MoveCoef := StrToFloat(edMoveCoef.Text);
end;

procedure TFormGizmo.edRotateCoefChange(Sender: TObject);
begin
  if edRotateCoef.Text <> '' then
    Gizmo.RotationCoef := StrToFloat(edRotateCoef.Text);
end;

procedure TFormGizmo.edGizmoThicknessChange(Sender: TObject);
begin
  Gizmo.GizmoThickness := StrToFloat(edGizmoThickness.Text);
end;

procedure TFormGizmo.edScaleCoefChange(Sender: TObject);
begin
  if edScaleCoef.Text <> '' then
    Gizmo.ScaleCoef := StrToFloat(edScaleCoef.Text);
end;

procedure TFormGizmo.edAutoZoomFactorChange(Sender: TObject);
begin
  if edAutoZoomFactor.Text <> '' then
    Gizmo.AutoZoomFactor := StrToFloat(edAutoZoomFactor.Text);
end;

procedure TFormGizmo.edZoomFactorChange(Sender: TObject);
begin
  if edZoomFactor.Text <> '' then
    Gizmo.ZoomFactor := StrToFloat(edZoomFactor.Text);
end;

procedure TFormGizmo.ColorBox1Change(Sender: TObject);
begin
  case (Sender as TColorBox).Tag of
    0: Gizmo.BoundingBoxColor.AsWinColor := ColorBox1.Selected;
    1: Gizmo.VisibleInfoLabelsColor.AsWinColor := ColorBox2.Selected;
    2: Gizmo.SelectedColor.AsWinColor := ColorBox3.Selected;
  end;
end;

procedure TFormGizmo.FormCreate(Sender: TObject);
begin
  Gizmo := TGLGizmo.Create(Self);
  Gizmo.LabelFont := WindowsBitmapFont;
  Gizmo.Viewer := Viewer;
end;

procedure TFormGizmo.FormDestroy(Sender: TObject);
begin
  Gizmo.Free;
end;

end.