{************************************************************}
{                   Delphi VCL Extensions                    }
{                                                            }
{       Custom control implements 3D orbit drawing mode      }
{                                                            }
{      Copyright (c) 2002-2013 SoftGold software company     }
{                                                            }
{************************************************************}

unit sgOrbit3D;
{$INCLUDE SGDXF.INC}
interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms, Messages
  {$IFDEF SGDEL_XE3}
  , System.Types, System.UITypes
  {$ENDIF}
  ;

type
  Tsg3DStates = (stateX, stateY, stateZ, stateXY);

  TRotateEvent = procedure(Sender: TObject; const AAxis: Integer;
    const AAngle: Double) of object;

{ TsgCustomOrbit3D

  Control is designed to implement the rotation of the drawing. }

  TsgCustomOrbit3D = class(TGraphicControl)
  private
    FAlignToClientRect: Boolean;
    FBigRadius: Integer;
    FCenter: TPoint;
    FCurrentState: Tsg3DStates;
    FDegreesPerPixel: Double;
    FMouseCoord: TPoint;
    FOnAfterRotate: TRotateEvent;
    FOnBeforeRotate: TRotateEvent;
    FSmallRadius: Integer;
    FOnBeforeCustomRotate: TNotifyEvent;
    FOnAfterCustomRotate: TNotifyEvent;
    FAutoTarget: Boolean;
    function GetBigRadius: Integer;
    function GetCenter: TPoint;
    function GetSmallCenters(Index: Integer): TPoint;
    procedure SetAlignToClientRect(const AValue: Boolean);
    procedure SetAutoTarget(const AValue: Boolean);
    procedure SetBigRadius(const AValue: Integer);
    procedure SetCursorState(const AX, AY: Integer);
    procedure SetSmallRadius(const AValue: Integer);
  protected
    procedure DoAfterCustomRotate; dynamic;
    procedure DoAfterRotate(const AAxis: Integer;
      const AAngle: Double); dynamic;
    procedure DoBeforeCustomRotate; dynamic;
    procedure DoBeforeRotate(const AAxis: Integer;
      const AAngle: Double); dynamic;
    procedure DoRotate(const AAxis: Integer; const AAngle: Double); dynamic;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure RotateDirectly(const ADeltaX, ADeltaY: Integer); virtual;
    procedure Rotate(const AAxis: Integer;
      const AAngle: Double); virtual; abstract;
    procedure SetCenter(const AValue: TPoint);
    property AlignToClientRect: Boolean read FAlignToClientRect
      write SetAlignToClientRect default True;
    property BigRadius: Integer read GetBigRadius write SetBigRadius;
    property Center: TPoint read GetCenter write SetCenter;
    property CurrentState: Tsg3DStates read FCurrentState;
    property DegreesPerPixel: Double read FDegreesPerPixel write FDegreesPerPixel;
    property OnAfterCustomRotate: TNotifyEvent read FOnAfterCustomRotate
      write FOnAfterCustomRotate;
    property OnAfterRotate: TRotateEvent read FOnAfterRotate
      write FOnAfterRotate;
    property OnBeforeCustomRotate: TNotifyEvent read FOnBeforeCustomRotate
      write FOnBeforeCustomRotate;
    property OnBeforeRotate: TRotateEvent read FOnBeforeRotate
      write FOnBeforeRotate;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property SmallCenters[Index: Integer]: TPoint read GetSmallCenters;
    property SmallRadius: Integer read FSmallRadius write SetSmallRadius;
    property AutoTarget: Boolean read FAutoTarget write SetAutoTarget;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  end;

  TsgOrbit3D = class(TsgCustomOrbit3D)
  published
    property AlignToClientRect;
    property BigRadius;
    property OnAfterCustomRotate;
    property OnAfterRotate;
    property OnBeforeCustomRotate;
    property OnBeforeRotate;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property SmallRadius;
  end;

  TsgOrbit3DClass = class of TsgOrbit3D;

implementation

{$R *.RES}

procedure DrawCircle(const ADC: HDC; const ACenter: TPoint;
  const ARadius: Integer);
begin
  Windows.Ellipse(ADC, ACenter.X - ARadius, ACenter.Y - ARadius,
    ACenter.X + ARadius, ACenter.Y + ARadius)
end;

// optimized for integer values
function IsPointInCircle(const ACenter: TPoint;
  const ARadius: Integer; AX, AY: Integer): Boolean;
begin
  AX := AX - ACenter.X;
  AY := AY - ACenter.Y;
  Result := AX * AX + (AY - ARadius) * (AY + ARadius) < 0;
end;

{ TsgCustomOrbit3D }

function TsgCustomOrbit3D.GetBigRadius: Integer;
begin
  if FAlignToClientRect then
  begin
    if Width > Height then
      Result := Height shr 1
    else
      Result := Width shr 1;
    Result := Result - (Result shr 2);
  end
  else
    Result := FBigRadius;
end;

function TsgCustomOrbit3D.GetCenter: TPoint;
begin
  if FAlignToClientRect then
    Result := Point(Width shr 1, Height shr 1)
  else
    Result := FCenter;
end;

{ function TsgCustomOrbit3D.GetSmallCenters

  The method calculates the center of the small circles:
    Index = 0 - left
    Index = 1 - top
    Index = 2 - right
    Index = 3 - bottom. }
function TsgCustomOrbit3D.GetSmallCenters(Index: Integer): TPoint;

  function GetOffset(const AIndex: Integer; const AOffs: Integer): Integer;
  begin
    Result := (AIndex and 1) * (((AIndex and 2) shr 1) shl 1 - 1) * AOffs;
  end;

begin
  Result.X := Center.X + GetOffset(Index - 1, BigRadius);
  Result.Y := Center.Y + GetOffset(Index, BigRadius);
end;

procedure TsgCustomOrbit3D.RotateDirectly(const ADeltaX, ADeltaY: Integer);
begin
  case FCurrentState of
    stateX: DoRotate(0, ADeltaY);                                       // axisX
    stateY: DoRotate(1, ADeltaX);                                       // axisY
    stateZ:
      if Abs(ADeltaX) > Abs(ADeltaY) then
        DoRotate(2, (2 * Ord(FMouseCoord.Y >= Center.Y) - 1) * ADeltaX) // axisZ
      else
        DoRotate(2, (2 * Ord(FMouseCoord.X < Center.X) - 1) * ADeltaY); // axisZ
    stateXY:
      begin
        DoRotate(0, ADeltaY);                                           // axisX
        DoRotate(1, ADeltaX);                                           // axisY
      end;
  end;
end;

{ TsgCustomOrbit3D.SetAlignToClientRect

  Chane property AlignToClientRect. If AlignToClientRect = True then
  orbit will recalc size of radiuses on resize and draw to ClientRect
  of control, otherwise it draw using settings of Center and BigRadius. }
procedure TsgCustomOrbit3D.SetAlignToClientRect(const AValue: Boolean);
begin
  if FAlignToClientRect <> AValue then
  begin
    FAlignToClientRect := AValue;
    Refresh;
  end;
end;

procedure TsgCustomOrbit3D.SetAutoTarget(const AValue: Boolean);
begin
  FAutoTarget := AValue;
end;

procedure TsgCustomOrbit3D.SetBigRadius(const AValue: Integer);
begin
  if FBigRadius <> AValue then
  begin
    FBigRadius := AValue;
    if not FAlignToClientRect then
      Refresh;
  end;
end;

procedure TsgCustomOrbit3D.SetCursorState(const AX, AY: Integer);
var
  I: Integer;
begin
  I := 0;
  while (I <= 3)
     and not IsPointInCircle(SmallCenters[I], SmallRadius, AX, AY) do
    Inc(I);
  if I <= 3 then
    FCurrentState := Tsg3DStates((I and 1) xor 1)
  else
    if IsPointInCircle(Center, BigRadius, AX, AY) then
      FCurrentState := stateXY
    else
      FCurrentState := stateZ;
  Cursor := TCursor(Ord(FCurrentState) + 1);
  Parent.Perform(WM_SETCURSOR, Parent.Handle, HTCLIENT);
end;

procedure TsgCustomOrbit3D.SetSmallRadius(const AValue: Integer);
begin
  if FSmallRadius <> AValue then
  begin
    FSmallRadius := AValue;
    Refresh;
  end;
end;

procedure TsgCustomOrbit3D.DoAfterCustomRotate;
begin
  if Assigned(FOnAfterCustomRotate) then
    FOnAfterCustomRotate(Self);
end;

procedure TsgCustomOrbit3D.DoAfterRotate(const AAxis: Integer;
  const AAngle: Double);
begin
  if Assigned(FOnAfterRotate) then
    FOnAfterRotate(Self, AAxis, AAngle);
end;

procedure TsgCustomOrbit3D.DoBeforeCustomRotate;
begin
  if Assigned(FOnBeforeCustomRotate) then
    FOnBeforeCustomRotate(Self);
end;

procedure TsgCustomOrbit3D.DoBeforeRotate(const AAxis: Integer;
  const AAngle: Double);
begin
  if Assigned(FOnBeforeRotate) then
    FOnBeforeRotate(Self, AAxis, AAngle);
end;

procedure TsgCustomOrbit3D.DoRotate(const AAxis: Integer; const AAngle: Double);
var
  vAngle: Double;
begin
  if AAngle <> 0 then
  begin
    vAngle := AAngle * FDegreesPerPixel;
    DoBeforeRotate(AAxis, vAngle);
    try
      Rotate(AAxis, vAngle);
    finally
      DoAfterRotate(AAxis, vAngle);
    end;
  end;
end;

procedure TsgCustomOrbit3D.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Button = mbLeft then
  begin
    MouseCapture := True;
    FMouseCoord := Point(X, Y);
    SetCursorState(X, Y);
  end;
end;

procedure TsgCustomOrbit3D.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if MouseCapture then
  begin
    if (FMouseCoord.X <> X) or (FMouseCoord.Y <> Y) then
    begin
      DoBeforeCustomRotate;
      try
        RotateDirectly(X - FMouseCoord.X, Y - FMouseCoord.Y);
        FMouseCoord := Point(X, Y);
      finally
        DoAfterCustomRotate;
      end;
    end;
  end
  else
    SetCursorState(X, Y);
end;

procedure TsgCustomOrbit3D.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Button = mbLeft then
  begin
    MouseCapture := False;
    SetCursorState(X, Y);
  end;
end;

procedure TsgCustomOrbit3D.SetCenter(const AValue: TPoint);
begin
  if (FCenter.X <> AValue.X) or (FCenter.Y <> AValue.Y) then
  begin
    FCenter := AValue;
    if not FAlignToClientRect then
      Refresh;
  end;
end;

constructor TsgCustomOrbit3D.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAlignToClientRect := True;
  FAutoTarget := True;
  Align := alClient;
  Color := $008CEB44; //TColor(RGB(68, 235, 140));
  FBigRadius := 100;
  FDegreesPerPixel := 1.;
  FSmallRadius := 10;
end;

procedure TsgCustomOrbit3D.Paint;
const
  cnstOrbitBrush: TLogBrush = (lbStyle: 1;  lbColor: 0; lbHatch: 0);
var
  I: Integer;
  vDC, vOldPen, vOldvBrush: Cardinal;
begin
  inherited Paint;
  vDC := Canvas.Handle;
  vOldPen := SelectObject(vDC, CreatePen(PS_SOLID, 1, Color));
  vOldvBrush := SelectObject(vDC, CreateBrushIndirect(cnstOrbitBrush));
  DrawCircle(vDC, Center, BigRadius);
  for I := 0 to 3 do
    DrawCircle(vDC, SmallCenters[I], SmallRadius);
  DeleteObject(SelectObject(vDC, vOldvBrush));
  DeleteObject(SelectObject(vDC, vOldPen));
end;

initialization
  Screen.Cursors[Ord(stateX) + 1] := Windows.LoadCursor(HInstance, 'X');
  Screen.Cursors[Ord(stateY) + 1] := Windows.LoadCursor(HInstance, 'Y');
  Screen.Cursors[Ord(stateZ) + 1] := Windows.LoadCursor(HInstance, 'Z');
  Screen.Cursors[Ord(stateXY)+ 1] := Windows.LoadCursor(HInstance, 'XY');

end.
