2018-11-08 00:24:28 +03:00
// Copyright (©) Ivan Bondarev, Stanislav Mihalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
/// Модуль трёхмерной графики
unit Graph3D;
{$reference System.Xml.dll}
{$reference HelixToolkit.Wpf.dll}
interface
uses GraphWPFBase;
uses System. Windows;
uses System. Windows. Controls;
uses System. Windows. Shapes;
uses System. Windows. Media;
uses System. Windows. Media. Animation;
uses System. Windows. Media. Media3D;
uses System. Windows. Markup;
uses System. XML;
uses System. IO;
uses System. Threading;
uses System. Windows. Input;
uses HelixToolkit. Wpf;
//uses Petzold.Media3D;
//{{{doc: Начало секции 1 }}}
type
// -----------------------------------------------------
//>> Типы модуля Graph3D # Graph3D types
// -----------------------------------------------------
/// Тип клавиши
Key = System. Windows. Input. Key;
/// Цветовые константы
Colors = System. Windows. Media. Colors;
/// Тип цвета
GColor = System. Windows. Media. Color;
/// Тип материала
GMaterial = System. Windows. Media. Media3D. Material;
/// Тип диффузного материала
GDiffuseMaterial = System. Windows. Media. Media3D. DiffuseMaterial;
/// Тип материала свечения
GEmissiveMaterial = System. Windows. Media. Media3D. EmissiveMaterial;
/// Тип камеры
GCamera = System. Windows. Media. Media3D. ProjectionCamera;
/// Тип прямоугольника
GRect = System. Windows. Rect;
/// Тип режима камеры
CameraMode = HelixToolkit. Wpf. CameraMode;
/// Тип предопределенных материалов
GMaterials= Helixtoolkit. Wpf. Materials;
/// Тип точки
Point = System. Windows. Point;
/// Тип 3D-точки
Point3D = System. Windows. Media. Media3D. Point3D;
/// Тип 3D-вектора
Vector3D = System. Windows. Media. Media3D. Vector3D;
/// Тип 3D-луча
Ray3D = HelixToolkit. Wpf. Ray3D;
/// Тип 3D-прямой
Line3D = class( Ray3D) end ;
/// Тип плоскости
Plane3D = HelixToolkit. Wpf. Plane3D;
/// Тип 3D-матрицы
Matrix3D = System. Windows. Media. Media3D. Matrix3D;
var
hvp: HelixViewport3D;
LightsGroup: Model3DGroup;
gvl: GridLinesVisual3D;
// -----------------------------------------------------
//>> Короткие функции модуля Graph3D # Graph3D short functions
// -----------------------------------------------------
2018-12-12 21:09:07 +03:00
procedure Invoke( p: ( ) - > ( ) ) ;
2018-11-08 00:24:28 +03:00
/// Возвращает цвет по красной, зеленой и синей составляющей (в диапазоне 0..255)
function RGB( r, g, b: byte ) : Color;
/// Возвращает цвет по красной, зеленой и синей составляющей и параметру прозрачности (в диапазоне 0..255)
function ARGB( a, r, g, b: byte ) : Color;
/// Возвращает серый цвет с интенсивностью b
function GrayColor( b: byte ) : Color;
/// Возвращает случайный цвет
function RandomColor: Color;
/// Возвращает полностью прозрачный цвет
function EmptyColor: Color;
/// Возвращает точку с координатами (x,y)
function Pnt( x, y: real ) : Point;
/// Возвращает прямоугольник с координатами угла (x,y), шириной w и высотой h
function Rect( x, y, w, h: real ) : GRect;
/// Возвращает 3D-точку с координатами (x,y,z)
function P3D( x, y, z: real ) : Point3D;
/// Возвращает 3D-вектор с координатами (x,y,z)
function V3D( x, y, z: real ) : Vector3D;
/// Возвращает 3D-размер с координатами (x,y,z)
function Sz3D( x, y, z: real ) : Size3D;
// -----------------------------------------------------
//>> Graph3D: функции для создания материалов Materials # Graph3D Materials functions
// -----------------------------------------------------
/// Диффузный материал
function DiffuseMaterial( c: Color) : Material;
/// Зеркальный материал
function SpecularMaterial( specularBrightness: byte ; specularpower: real : = 1 0 0 ) : Material;
/// Зеркальный материал
function SpecularMaterial( c: Color; specularpower: real : = 1 0 0 ) : Material;
/// Светящийся материал
function EmissiveMaterial( c: Color) : Material;
/// Материал, формируемый на основе изображения. M,N - количество повторений изображения по ширине и высоте
function ImageMaterial( fname: string ; M: real : = 1 ; N: real : = 1 ) : Material;
/// Радужный материал
function RainbowMaterial: Material;
type
// -----------------------------------------------------
//>> Graph3D: класс Materials # Graph3D Materials class
// -----------------------------------------------------
///!#
/// Класс для создания материалов
Materials = class
/// Диффузный материал
class function Diffuse( c: Color) : = DiffuseMaterial( c) ;
/// Зеркальный материал
class function Specular( specularBrightness: byte : = 2 5 5 ; specularpower: real : = 1 0 0 ) : = SpecularMaterial( specularBrightness, specularpower) ;
/// Зеркальный материал
class function Specular( c: Color; specularpower: real : = 1 0 0 ) : = SpecularMaterial( c, specularpower) ;
/// Светящийся материал
class function Emissive( c: Color) : = EmissiveMaterial( c) ;
/// Материал, формируемый на основе изображения. M,N - количество повторений изображения по ширине и высоте
class function Image( fname: string ; M: real : = 1 ; N: real : = 1 ) : = ImageMaterial( fname, M, N) ;
/// Радужный материал
class function Rainbow : = RainbowMaterial;
end ;
type
// -----------------------------------------------------
//>> Graph3D: класс View3DType # Graph3D View3DType class
// -----------------------------------------------------
///!#
/// Класс пространства отображения
View3DType = class
private
procedure SetSGLP( v: boolean ) : = gvl. Visible : = v;
procedure SetSGL( v: boolean ) : = Invoke( SetSGLP, v) ;
function GetSGL: boolean : = InvokeBoolean( ( ) - > gvl. Visible) ;
procedure SetSCIP( v: boolean ) : = hvp. ShowCameraInfo : = v;
procedure SetSCI( v: boolean ) : = Invoke( SetSCIP, v) ;
function GetSCI: boolean : = InvokeBoolean( ( ) - > hvp. ShowCameraInfo) ;
procedure SetSVCP( v: boolean ) : = hvp. ShowViewCube : = v;
procedure SetSVC( v: boolean ) : = Invoke( SetSVCP, v) ;
function GetSVC: boolean : = InvokeBoolean( ( ) - > hvp. ShowViewCube) ;
procedure SetTP( v: string ) : = hvp. Title : = v;
procedure SetT( v: string ) : = Invoke( SetTP, v) ;
function GetT: string : = InvokeString( ( ) - > hvp. Title) ;
procedure SetSTP( v: string ) : = hvp. SubTitle : = v;
procedure SetST( v: string ) : = Invoke( SetSTP, v) ;
function GetST: string : = InvokeString( ( ) - > hvp. SubTitle) ;
procedure SetCMP( v: HelixToolkit. Wpf. CameraMode) : = hvp. CameraMode : = v;
procedure SetCM( v: HelixToolkit. Wpf. CameraMode) : = Invoke( SetCMP, v) ;
function GetCM: HelixToolkit. Wpf. CameraMode : = Invoke& < HelixToolkit. Wpf. CameraMode> ( ( ) - > hvp. CameraMode) ;
procedure SetBCP( v: GColor) : = hvp. Background : = new SolidColorBrush( v) ;
procedure SetBC( v: GColor) : = Invoke( SetBCP, v) ;
function GetBC: GColor : = Invoke& < GColor> ( ( ) - > ( hvp. Background as SolidColorBrush) . Color) ;
procedure ExportP( fname: string ) : = hvp. Viewport. Export( fname, hvp. Background) ;
public
/// Отображать ли координатную систему
property ShowCoordinateSystem: boolean
read InvokeBoolean( ( ) - > hvp. ShowCoordinateSystem)
write Invoke( procedure( v: boolean ) - > hvp. ShowCoordinateSystem : = v, value) ;
/// Отображать ли координатную сетку
property ShowGridLines: boolean read GetSGL write SetSGL;
/// Отображать ли информацию о камере
property ShowCameraInfo: boolean read GetSCI write SetSCI;
/// Отображать ли ViewCube
property ShowViewCube: boolean read GetSVC write SetSVC;
/// Заголовок пространства отображения
property Title: string read GetT write SetT;
/// Подзаголовок пространства отображения
property SubTitle: string read GetST write SetST;
/// Режим камеры
property CameraMode: HelixToolkit. Wpf. CameraMode read GetCM write SetCM;
/// Цвет фона
property BackgroundColor: GColor read GetBC write SetBC;
/// Сохраняет содержимое 3d-окна в файл
procedure Save( fname: string ) : = Invoke( ExportP, fname) ;
end ;
// -----------------------------------------------------
//>> Graph3D: класс CameraType # Graph3D CameraType class
// -----------------------------------------------------
///!#
/// Класс камеры
CameraType = class
private
function Cam: GCamera : = hvp. Camera;
procedure SetPP( p: Point3D) ;
begin
Cam. Position : = p;
end ;
procedure SetP( p: Point3D) : = Invoke( SetPP, p) ;
function GetP: Point3D : = Invoke& < Point3D> ( ( ) - > Cam. Position) ;
procedure SetLDP( v: Vector3D) : = Cam. LookDirection : = v;
procedure SetLD( v: Vector3D) : = Invoke( SetLDP, v) ;
function GetLD: Vector3D : = Invoke& < Vector3D> ( ( ) - > Cam. LookDirection) ;
procedure SetUDP( v: Vector3D) : = Cam. UpDirection : = v;
procedure SetUD( v: Vector3D) : = Invoke( SetUDP, v) ;
function GetUD: Vector3D : = Invoke& < Vector3D> ( ( ) - > Cam. UpDirection) ;
procedure SetDP( d: real ) ;
begin
var dist : = Cam. Position. DistanceTo( P3D( 0 , 0 , 0 ) ) ;
Cam. Position : = Cam. Position. Multiply( d / dist) ;
end ;
procedure SetD( d: real ) : = Invoke( SetDP, d) ;
function GetD: real : = InvokeReal( ( ) - > Cam. Position. DistanceTo( P3D( 0 , 0 , 0 ) ) ) ;
procedure MoveOnP( x, y, z: real ) ;
begin
Cam. Position + = V3D( x, y, z) //:= P3D(Cam.Position.
end ;
procedure MoveOnPV( v: Vector3D) ;
begin
Cam. Position + = v;
end ;
procedure AddMoveForceP( x, y, z: real ) ;
begin
hvp. CameraController. ShowCameraTarget : = True ;
hvp. CameraController. AddMoveForce( x, y, z) ;
end ;
procedure AddRotateForceP( x, y: real ) ;
begin
hvp. CameraController. AddRotateForce( x, y) ;
end ;
procedure RotateP( axis: Vector3D; angle: real ) ;
begin
var look : = Cam. LookDirection;
var q : = new Quaternion( axis, angle) ;
var qConjugate : = q;
qConjugate. Conjugate( ) ;
var p : = new Quaternion( look. X, look. Y, look. Z, 0 ) ;
var qRotatedPoint : = q * p * qConjugate;
Cam. LookDirection : = V3D( qRotatedPoint. X, qRotatedPoint. Y, qRotatedPoint. Z) ;
end ;
public
/// Позиция камеры
property Position: Point3D read GetP write SetP;
/// Направление взгляда камеры
property LookDirection: Vector3D read GetLD write SetLD;
/// Направление "вверх" камеры
property UpDirection: Vector3D read GetUD write SetUD;
/// Расстояние камеры до начала координат
property Distanse: real read GetD write SetD;
/// Перемещает камеру на вектор (dx,dy,dz)
procedure MoveOn( dx, dy, dz: real ) : = Invoke( MoveOnP, dx, dy, dz) ;
/// Перемещает камеру на вектор v
procedure MoveOn( v: Vector3D) : = Invoke( MoveOnPV, v) ;
/// Обеспечивает плавное движение камеры
procedure AddMoveForce( ForwardForce, RightForce, UpForce: real ) : = Invoke( AddMoveForceP, RightForce, UpForce, ForwardForce) ;
/// Обеспечивает плавное движение камеры вперед с некоторой силой
procedure AddForwardForce( Force: real : = 0.2 ) : = AddMoveForce( Force, 0 , 0 ) ;
/// Обеспечивает плавное движение камеры назад с некоторой силой
procedure AddBackwardForce( Force: real : = 0.2 ) : = AddMoveForce( - Force, 0 , 0 ) ;
/// Обеспечивает плавное движение камеры вправо
procedure AddRightForce( Force: real : = 0.2 ) : = AddMoveForce( 0 , Force, 0 ) ;
/// Обеспечивает плавное движение камеры влево
procedure AddLeftForce( Force: real : = 0.2 ) : = AddMoveForce( 0 , - Force, 0 ) ;
/// Обеспечивает плавное движение камеры вверх
procedure AddUpForce( Force: real : = 0.2 ) : = AddMoveForce( 0 , 0 , Force) ;
/// Обеспечивает плавное движение камеры вниз
procedure AddDownForce( Force: real : = 0.2 ) : = AddMoveForce( 0 , 0 , - Force) ;
/// Обеспечивает плавный поворот камеры
procedure AddRotateForce( RightForce, UpForce: real ) : = Invoke( AddRotateForceP, RightForce, UpForce) ;
/// Поворачивает камеру на данный угол относительно данной оси
procedure Rotate( axis: Vector3D; angle: real ) : = Invoke( RotateP, axis, angle) ;
end ;
///!#
/// Класс источника света
LightsType = class
public
/// Количество источников света
property Count: integer read Invoke& < integer > ( ( ) - > LightsGroup. Children. Count) ;
/// Добавляет направленный источник света
procedure AddDirectionalLight( c: Color; v: Vector3D) : = Invoke( ( ) - > LightsGroup. Children. Add( new DirectionalLight( c, v) ) ) ;
/// Добавляет конусообразный источник света
procedure AddSpotLight( c: Color; p: Point3D; v: Vector3D; outerconeangle, innerconeangle: real ) : = Invoke( ( ) - > LightsGroup. Children. Add( new SpotLight( c, p, v, outerconeangle, innerconeangle) ) ) ;
/// Добавляет точечный источник света
procedure AddPointLight( c: Color; p: Point3D) : = Invoke( ( ) - > LightsGroup. Children. Add( new PointLight( c, p) ) ) ;
/// Удаляет источник света
procedure RemoveLight( i: integer ) : = Invoke( ( ) - > LightsGroup. Children. RemoveAt( i) ) ;
{ procedure Proba( ) ;
begin
var p : = new PointLight( Colors. Gray, P3D( 2 , 2 , 2 ) ) ;
p. Color : = Colors. Gray;
p. Position : = P3D( 3 , 3 , 3 ) ;
end ; }
end ;
// -----------------------------------------------------
//>> Graph3D: класс GridLinesType # Graph3D GridLinesType class
// -----------------------------------------------------
///!#
/// Класс координатной сетки
GridLinesType = class
private
procedure SetW( r: real ) : = Invoke( procedure( r: real ) - > gvl. Width : = r, r) ;
function GetW: real : = InvokeReal( ( ) - > gvl. Width) ;
procedure SetL( r: real ) : = Invoke( procedure( r: real ) - > gvl. Length : = r, r) ;
function GetL: real : = InvokeReal( ( ) - > gvl. Length ) ;
procedure SetMj( r: real ) : = Invoke( procedure( r: real ) - > gvl. MajorDistance : = r, r) ;
function GetMj: real : = InvokeReal( ( ) - > gvl. MajorDistance) ;
procedure SetMn( r: real ) : = Invoke( procedure( r: real ) - > gvl. MinorDistance : = r, r) ;
function GetMn: real : = InvokeReal( ( ) - > gvl. MinorDistance) ;
procedure SetN( r: Vector3D) : = Invoke( procedure( r: Vector3D) - > gvl. Normal : = r, r) ;
function GetN: Vector3D : = Inv( ( ) - > gvl. Normal) ;
public
/// Ширина координаной сетки (размер по оси OY)
property Width: real read GetW write SetW;
/// Длина координаной сетки (размер по оси OX)
property Length : real read GetL write SetL;
/// Вектор нормали координаной сетки
property Normal: Vector3D read GetN write SetN;
/// Большое расстояние между линиями координаной сетки
property MajorDistance: real read GetMj write SetMj;
/// Маленькое расстояние между линиями координаной сетки
property MinorDistance: real read GetMn write SetMn;
end ;
type
AnimationBase = class ;
ObjectWithChildren3D = class ;
// -----------------------------------------------------
//>> Graph3D: класс Object3D # Graph3D Object3D class
// -----------------------------------------------------
///!#
/// Базовый класс трехмерных объектов
Object3D = class
( DependencyObject) // для генерации документации
private
model: Visual3D;
Parent: ObjectWithChildren3D;
transfgroup : = new Transform3DGroup;
rotatetransform : = new MatrixTransform3D;
scaletransform : = new ScaleTransform3D;
transltransform: TranslateTransform3D;
procedure AddToObject3DList;
procedure DeleteFromObject3DList;
procedure CreateBase0( m: Visual3D; x, y, z: real ) ;
begin
model : = m;
transltransform : = new TranslateTransform3D( x, y, z) ;
//transfgroup.Children.Add(new MatrixTransform3D); // ответственен за поворот. Н е храним в отдельной переменной т.к. при повороте меняется сам объект, а не поля объекта!!!
transfgroup. Children. Add( rotatetransform) ;
transfgroup. Children. Add( scaletransform) ;
transfgroup. Children. Add( transltransform) ;
model. Transform : = transfgroup;
hvp. Children. Add( model) ;
AddToObject3DList;
end ;
procedure SetX( xx: real ) : = Invoke( ( ) - > begin transltransform. OffsetX + = xx - Self. X; end ) ;
function GetX: real : = InvokeReal( ( ) - > transfgroup. Value. OffsetX) ;
procedure SetY( yy: real ) : = Invoke( ( ) - > begin transltransform. OffsetY + = yy - Self. Y; end ) ;
function GetY: real : = InvokeReal( ( ) - > transfgroup. Value. OffsetY) ;
procedure SetZ( zz: real ) : = Invoke( ( ) - > begin transltransform. OffsetZ + = zz - Self. Z; end ) ;
function GetZ: real : = InvokeReal( ( ) - > transfgroup. Value. OffsetZ) ;
function GetPos: Point3D : = Invoke& < Point3D> ( ( ) - > P3D( Self. X, Self. Y, Self. Z) ) ;
function FindVisual( v: Visual3D) : Object3D; virtual ;
begin
if model = v then
Result : = Self
end ;
function GetColor: GColor : = EmptyColor;
procedure SetColor( c: GColor) ;
begin end ;
protected
function CreateObject: Object3D; virtual ; // нужно для клонирования
begin
Result : = nil ;
end ;
procedure CloneChildren( from: Object3D) ; virtual ;
begin
end ;
function CloneT: Object3D; virtual ;
begin
Result : = CreateObject;
Result . CloneChildren( Self) ;
var ind : = ( model. Transform as Transform3DGroup) . Children. IndexOf( rotatetransform) ;
( Result . model. Transform as Transform3DGroup) . Children[ ind] : = ( model. Transform as Transform3DGroup) . Children[ ind] . Clone;
Result . rotatetransform : = ( Result . model. Transform as Transform3DGroup) . Children[ ind] as MatrixTransform3d;
//(Result.model.Transform as Transform3DGroup).Children[1] := (model.Transform as Transform3DGroup).Children[1].Clone;
//(Result.model.Transform as Transform3DGroup).Children[2] := (model.Transform as Transform3DGroup).Children[2].Clone;
//(Result.model.Transform as Transform3DGroup).Children[3] := (model.Transform as Transform3DGroup).Children[3].Clone; //- почему-то это не нужно!!! с ним не работает!
end ;
public
constructor( model: Visual3D) : = CreateBase0( model, 0 , 0 , 0 ) ;
/// Координата X
property X: real read GetX write SetX;
/// Координата Y
property Y: real read GetY write SetY;
/// Координата Z
property Z: real read GetZ write SetZ;
/// Перемещает 3D-объект к точке (xx,yy,zz)
function MoveTo( xx, yy, zz: real ) : Object3D : =
Invoke& < Object3D> ( ( ) - > begin
transltransform. OffsetX + = xx - Self. X;
transltransform. OffsetY + = yy - Self. Y;
transltransform. OffsetZ + = zz - Self. Z;
Result : = Self;
end ) ;
/// Перемещает 3D-объект к точке p
function MoveTo( p: Point3D) : Object3D : = MoveTo( p. X, p. y, p. z) ;
/// Перемещает 3D-объект на вектор (dx,dy,dz)
function MoveOn( dx, dy, dz: real ) : Object3D : = MoveTo( x + dx, y + dy, z + dz) ;
/// Перемещает 3D-объект на вектор v
function MoveOn( v: Vector3D) : Object3D : = MoveOn( v. X, v. Y, v. Z) ;
/// Перемещает x-координату 3D-объекта на dx
function MoveOnX( dx: real ) : Object3D : = MoveOn( dx, 0 , 0 ) ;
/// Перемещает y-координату 3D-объекта на dy
function MoveOnY( dy: real ) : Object3D : = MoveOn( 0 , dy, 0 ) ;
/// Перемещает z-координату 3D-объекта на dz
function MoveOnZ( dz: real ) : Object3D : = MoveOn( 0 , 0 , dz) ;
/// Цвет 3D-объекта
property Color: GColor read GetColor write SetColor; virtual ;
private
procedure MoveToProp( p: Point3D) : = MoveTo( p) ;
public
/// Позиция 3D-объекта
property Position: Point3D read GetPos write MoveToProp;
/// Масштабирует 3D-объект в f раз
function Scale( f: real ) : Object3D : =
Invoke& < Object3D> ( ( ) - > begin
scaletransform. ScaleX * = f;
scaletransform. ScaleY * = f;
scaletransform. ScaleZ * = f;
Result : = Self;
end ) ;
/// Масштабирует 3D-объект в f раз по оси OX
function ScaleX( f: real ) : Object3D : =
Invoke& < Object3D> ( ( ) - > begin
scaletransform. ScaleX * = f;
Result : = Self;
end ) ;
/// Масштабирует 3D-объект в f раз по оси OY
function ScaleY( f: real ) : Object3D : =
Invoke& < Object3D> ( ( ) - > begin
scaletransform. ScaleY * = f;
Result : = Self;
end ) ;
/// Масштабирует 3D-объект в f раз по оси OZ
function ScaleZ( f: real ) : Object3D : =
Invoke& < Object3D> ( ( ) - > begin
scaletransform. ScaleZ * = f;
Result : = Self;
end ) ;
/// Поворачивает объект на угол angle вокруг оси axis
function Rotate( axis: Vector3D; angle: real ) : Object3D : =
Invoke& < Object3D> ( ( ) - > begin
var m : = Matrix3D. Identity;
m. Rotate( new Quaternion( axis, angle) ) ;
var ind : = transfgroup. Children. IndexOf( rotatetransform) ;
rotatetransform : = new MatrixTransform3D( m * rotatetransform. Value) ;
transfgroup. Children[ ind] : = rotatetransform;
Result : = Self;
end ) ;
/// Поворачивает объект на угол angle вокруг оси axis относительно точки center
function RotateAt( axis: Vector3D; angle: real ; center: Point3D) : Object3D : =
Invoke& < Object3D> ( ( ) - > begin
var m : = Matrix3D. Identity;
m. RotateAt( new Quaternion( axis, angle) , center) ;
var ind : = transfgroup. Children. IndexOf( rotatetransform) ;
rotatetransform : = new MatrixTransform3D( m * rotatetransform. Value) ;
transfgroup. Children[ ind] : = rotatetransform;
Result : = Self;
end ) ;
/// Возвращает анимацию перемещения объекта к точке (x, y, z) за seconds секунд. В конце анимации выполняется процедура Completed
function AnimMoveTo( x, y, z: real ; seconds: real ; Completed: procedure ) : AnimationBase;
/// Возвращает анимацию перемещения объекта к точке (x, y, z) за seconds секунд
function AnimMoveTo( x, y, z: real ; seconds: real : = 1 ) : AnimationBase : = AnimMoveTo( x, y, z, seconds, nil ) ;
/// Возвращает анимацию перемещения объекта к точке p за seconds секунд. В конце анимации выполняется процедура Completed
function AnimMoveTo( p: Point3D; seconds: real ; Completed: procedure ) : = AnimMoveTo( p. x, p. y, p. z, seconds, Completed) ;
/// Возвращает анимацию перемещения объекта к точке p за seconds секунд
function AnimMoveTo( p: Point3D; seconds: real : = 1 ) : = AnimMoveTo( p. x, p. y, p. z, seconds, nil ) ;
/// Возвращает анимацию перемещения объекта по траектории, заданной последовательностью точек trajectory за seconds секунд. В конце анимации выполняется процедура Completed
function AnimMoveTrajectory( trajectory: sequence of Point3D; seconds: real ; Completed: procedure ) : AnimationBase;
/// Возвращает анимацию перемещения объекта по траектории, заданной последовательностью точек trajectory за seconds секунд
function AnimMoveTrajectory( trajectory: sequence of Point3D; seconds: real : = 1 ) : AnimationBase : = AnimMoveTrajectory( trajectory, seconds, nil ) ;
/// Возвращает анимацию перемещения объекта на вектор (dx, dy, dz) за seconds секунд. В конце анимации выполняется процедура Completed
function AnimMoveOn( dx, dy, dz: real ; seconds: real ; Completed: procedure ) : AnimationBase;
/// Возвращает анимацию перемещения объекта на вектор (dx, dy, dz) за seconds секунд
function AnimMoveOn( dx, dy, dz: real ; seconds: real : = 1 ) : AnimationBase : = AnimMoveOn( dx, dy, dz, seconds, nil ) ;
/// Возвращает анимацию перемещения объекта на вектор v за seconds секунд. В конце анимации выполняется процедура Completed
function AnimMoveOn( v: Vector3D; seconds: real ; Completed: procedure ) : = AnimMoveOn( v. x, v. y, v. z, seconds, Completed) ;
/// Возвращает анимацию перемещения объекта на вектор v за seconds секунд
function AnimMoveOn( v: Vector3D; seconds: real : = 1 ) : = AnimMoveOn( v. x, v. y, v. z, seconds, nil ) ;
/// Возвращает анимацию перемещения объекта по оси OX на величину dx за seconds секунд. В конце анимации выполняется процедура Completed
function AnimMoveOnX( dx: real ; seconds: real ; Completed: procedure ) : = AnimMoveOn( dx, 0 , 0 , seconds, Completed) ;
/// Возвращает анимацию перемещения объекта по оси OX на величину dx за seconds секунд
function AnimMoveOnX( dx: real ; seconds: real ) : = AnimMoveOnX( dx, seconds, nil ) ;
/// Возвращает анимацию перемещения объекта по оси OX на величину dx за 1 секунду
function AnimMoveOnX( dx: real ) : = AnimMoveOnX( dx, 1 , nil ) ;
/// Возвращает анимацию перемещения объекта по оси OY на величину dy за seconds секунд. В конце анимации выполняется процедура Completed
function AnimMoveOnY( dy: real ; seconds: real ; Completed: procedure ) : = AnimMoveOn( 0 , dy, 0 , seconds, Completed) ;
/// Возвращает анимацию перемещения объекта по оси OY на величину dy за seconds секунд
function AnimMoveOnY( dy: real ; seconds: real ) : = AnimMoveOnY( dy, seconds, nil ) ;
/// Возвращает анимацию перемещения объекта по оси OZ на величину dz за 1 секунду
function AnimMoveOnY( dy: real ) : = AnimMoveOnY( dy, 1 , nil ) ;
/// Возвращает анимацию перемещения объекта по оси OZ на величину dz за seconds секунд. В конце анимации выполняется процедура Completed
function AnimMoveOnZ( dz: real ; seconds: real ; Completed: procedure ) : = AnimMoveOn( 0 , 0 , dz, seconds, Completed) ;
/// Возвращает анимацию перемещения объекта по оси OZ на величину dz за seconds секунд
function AnimMoveOnZ( dz: real ; seconds: real ) : = AnimMoveOnZ( dz, seconds, nil ) ;
/// Возвращает анимацию перемещения объекта по оси OZ на величину dz за 1 секунду
function AnimMoveOnZ( dz: real ) : = AnimMoveOnZ( dz, 1 , nil ) ;
/// Возвращает анимацию масштабирования объекта на величину sc за seconds секунд. В конце анимации выполняется процедура Completed
function AnimScale( sc: real ; seconds: real ; Completed: procedure ) : AnimationBase;
/// Возвращает анимацию масштабирования объекта по оси OX на величину sc за seconds секунд. В конце анимации выполняется процедура Completed
function AnimScaleX( sc: real ; seconds: real ; Completed: procedure ) : AnimationBase;
/// Возвращает анимацию масштабирования объекта по оси OY на величину sc за seconds секунд. В конце анимации выполняется процедура Completed
function AnimScaleY( sc: real ; seconds: real ; Completed: procedure ) : AnimationBase;
/// Возвращает анимацию масштабирования объекта по оси OZ на величину sc за seconds секунд. В конце анимации выполняется процедура Completed
function AnimScaleZ( sc: real ; seconds: real ; Completed: procedure ) : AnimationBase;
/// Возвращает анимацию масштабирования объекта на величину sc за seconds секунд
function AnimScale( sc: real ; seconds: real : = 1 ) : AnimationBase : = AnimScale( sc, seconds, nil ) ;
/// Возвращает анимацию масштабирования объекта по оси OX на величину sc за seconds секунд
function AnimScaleX( sc: real ; seconds: real : = 1 ) : AnimationBase : = AnimScale( sc, seconds, nil ) ;
/// Возвращает анимацию масштабирования объекта по оси OY на величину sc за seconds секунд
function AnimScaleY( sc: real ; seconds: real : = 1 ) : AnimationBase : = AnimScale( sc, seconds, nil ) ;
/// Возвращает анимацию масштабирования объекта по оси OZ на величину sc за seconds секунд
function AnimScaleZ( sc: real ; seconds: real : = 1 ) : AnimationBase : = AnimScale( sc, seconds, nil ) ;
/// Возвращает анимацию поворота объекта вокруг вектора (vx,vy,vz) на величину angle за seconds секунд. В конце анимации выполняется процедура Completed
function AnimRotate( vx, vy, vz, angle: real ; seconds: real ; Completed: procedure ) : AnimationBase;
/// Возвращает анимацию поворота объекта вокруг вектора (vx,vy,vz) на величину angle за seconds секунд
function AnimRotate( vx, vy, vz, angle: real ; seconds: real : = 1 ) : AnimationBase : = AnimRotate( vx, vy, vz, angle, seconds, nil ) ;
/// Возвращает анимацию поворота объекта вокруг вектора v, направленного из центра объекта, на величину angle за seconds секунд. В конце анимации выполняется процедура Completed
function AnimRotate( v: Vector3D; angle: real ; seconds: real ; Completed: procedure ) : = AnimRotate( v. x, v. y, v. z, angle, seconds, Completed) ;
/// Возвращает анимацию поворота объекта вокруг вектора v, направленного из центра объекта, на величину angle за seconds секунд
function AnimRotate( v: Vector3D; angle: real ; seconds: real : = 1 ) : = AnimRotate( v. x, v. y, v. z, angle, seconds, nil ) ;
/// Возвращает анимацию поворота объекта вокруг вектора axis, направленного из точки center, на величину angle за seconds секунд. В конце анимации выполняется процедура Completed
function AnimRotateAt( axis: Vector3D; angle: real ; center: Point3D; seconds: real ; Completed: procedure ) : AnimationBase;
/// Возвращает анимацию поворота объекта вокруг вектора axis, направленного из точки center, на величину angle за seconds секунд
function AnimRotateAt( axis: Vector3D; angle: real ; center: Point3D; seconds: real : = 1 ) : AnimationBase : = AnimRotateAt( axis, angle, center, seconds, nil ) ;
/// Клонирует 3D-объект
function Clone: Object3D : = Invoke& < Object3D> ( CloneT) ;
private
procedure SaveP( fname: string ) ;
begin
var f : = new System. IO. StreamWriter( fname) ;
XamlWriter. Save( Model, f) ;
f. Close( )
end ;
public
/// Сохраняет 3D-объект в файл
procedure Save( fname: string ) ; virtual : = Invoke( SaveP, fname) ; // надо её сделать виртуальной!
class function Load( fname: string ) : Object3D : = Invoke& < Object3D> ( ( ) - > begin
var m : = XamlReader. Load( new System. IO. FileStream( fname, System. IO. FileMode. Open) ) as Visual3D;
Result : = new Object3D( m) ;
end ) ;
/// Удаляет 3D-объект
procedure Destroy( ) ; virtual : = DeleteFromObject3DList;
end ;
// -----------------------------------------------------
//>> Graph3D: класс ObjectWithChildren3D # Graph3D ObjectWithChildren3D class
// -----------------------------------------------------
/// 3D-объект с дочерними подобъектами
ObjectWithChildren3D = class( Object3D) // model is ModelVisual3D
private
l : = new List< Object3D> ;
procedure DestroyT;
begin
end ;
procedure AddT( obj: Object3D) ;
begin
var p : = Self;
while p < > nil do
begin
if obj = p then
raise new System. ArgumentException( 'Group.Add: Нельзя в дочерние элементы группы добавить себя или своего предка' ) ;
p : = p. Parent
end ;
if obj. Parent = Self then
exit;
if obj. Parent = nil then
hvp. Children. Remove( obj. model)
else
begin
var q : = obj. Parent. model as ModelVisual3D;
q. Children. Remove( obj. model) ;
obj. Parent. l. Remove( obj) ;
end ;
( model as ModelVisual3D) . Children. Add( obj. model) ;
l. Add( obj) ;
obj. Parent : = Self;
end ;
procedure RemoveT( obj: Object3D) ;
begin
var b : = ( model as ModelVisual3D) . Children. Remove( obj. model) ;
if not b then exit;
l. Remove( obj) ;
hvp. Children. Add( obj. model) ;
obj. Parent : = nil ;
end ;
function GetObj( i: integer ) : Object3D : = l[ i] ;
function CountT: integer : = ( model as ModelVisual3D) . Children. Count;
function FindVisual( v: Visual3D) : Object3D; override ;
begin
Result : = nil ;
if model = v then
Result : = Self
else
foreach var x in l do
begin
Result : = x. FindVisual( v) ;
if Result < > nil then
exit;
end ;
end ;
protected
procedure CloneChildren( from: Object3D) ; override ;
begin
var ll : = ( from as ObjectWithChildren3D) . l;
if ll. Count = 0 then exit;
foreach var xx in ll do
AddChild( xx. Clone) ;
end ;
public
/// Добавить дочерний подобъект
procedure AddChild( obj: Object3D) : = Invoke( AddT, obj) ;
/// i-тый дочерний подобъект
property Items[ i: integer ] : Object3D read GetObj; default ;
/// Количество дочерних подобъектов
function Count: integer : = Invoke& < integer > ( CountT) ;
private
procedure DestroyP;
begin
if Parent = nil then
hvp. Children. Remove( model)
else
begin
var q : = Parent. model as ModelVisual3D;
q. Children. Remove( model) ;
Parent. l. Remove( Self) ;
end ;
model : = nil ;
end ;
public
/// Удалить дочерний подобъект
procedure Destroy; override ;
begin
inherited Destroy;
Invoke( DestroyP) ;
end ;
end ;
// -----------------------------------------------------
//>> Graph3D: класс ObjectWithMaterial3D # Graph3D ObjectWithMaterial3D class
// -----------------------------------------------------
/// 3D-объект с материалом
ObjectWithMaterial3D = class( ObjectWithChildren3D) // model is MeshElement3D
private
procedure CreateBase( m: MeshElement3D; x, y, z: real ; mat: GMaterial) ;
begin
CreateBase0( m, x, y, z) ;
m. Material : = mat;
//MaterialHelper.ChangeOpacity(mat,0.1);
//MaterialHelper.ChangeOpacity(BackMaterial,0.1);
//m.BackMaterial := nil;
end ;
function GetColorP: GColor;
begin
Result : = EmptyColor;
var g : = Material as System. Windows. Media. Media3D. MaterialGroup;
if g = nil then exit;
var t : = g. Children[ 0 ] as System. Windows. Media. Media3D. DiffuseMaterial;
if t = nil then exit;
var v : = t. Brush as System. Windows. Media. SolidColorBrush;
if v = nil then exit;
Result : = v. Color;
end ;
function GetColor: GColor : = Invoke& < GColor> ( GetColorP) ;
procedure SetColorP( c: GColor) : = ( model as MeshElement3D) . Material : = MaterialHelper. CreateMaterial( c) ;
procedure SetColor( c: GColor) : = Invoke( SetColorP, c) ;
procedure SetVP( v: boolean ) : = ( model as MeshElement3D) . Visible : = v;
procedure SetV( v: boolean ) : = Invoke( SetVP, v) ;
function GetV: boolean : = Invoke& < boolean > ( ( ) - > ( model as MeshElement3D) . Visible) ;
procedure SetMP( mat: GMaterial) : = ( model as MeshElement3D) . Material : = mat;
procedure SetMaterial( mat: GMaterial) : = Invoke( SetMP, mat) ;
function GetMaterial: GMaterial : = Invoke& < GMaterial> ( ( ) - > ( model as MeshElement3D) . Material) ;
procedure SetBMP( mat: GMaterial) : = ( model as MeshElement3D) . BackMaterial : = mat;
procedure SetBMaterial( mat: GMaterial) : = Invoke( SetBMP, mat) ;
function GetBMaterial: GMaterial : = Invoke& < GMaterial> ( ( ) - > ( model as MeshElement3D) . BackMaterial) ;
public
/// Цвет объекта
property Color: GColor read GetColor write SetColor; override ;
/// Материал объекта
property Material: GMaterial read GetMaterial write SetMaterial;
/// Материал задней поверхности объекта
property BackMaterial: GMaterial read GetBMaterial write SetBMaterial;
/// Видим ли объект
property Visible: boolean read GetV write SetV;
end ;
/// Группа 3D-объектов
Group3D = class( ObjectWithChildren3D)
protected
function CreateObject: Object3D; override : = new Group3D( X, Y, Z) ;
2019-03-11 23:09:55 +03:00
//public
protected
2018-11-08 00:24:28 +03:00
constructor( x, y, z: real ) : = CreateBase0( new ModelVisual3D, x, y, z) ;
constructor( x, y, z: real ; lst: sequence of Object3D) ;
begin
CreateBase0( new ModelVisual3D, x, y, z) ;
foreach var xx in lst do
AddChild( xx) ;
end ;
/// ВОзвращает клон группы 3D-объектов
function Clone : = ( inherited Clone) as Group3D;
end ;
//------------------------------ Animations -----------------------------------
// -----------------------------------------------------
//>> Graph3D: класс AnimationBase # Graph3D AnimationBase class
// -----------------------------------------------------
/// Базовый класс анимации 3D-объектов
AnimationBase = class
private
Element: Object3D;
Seconds: real ;
// Completed - действие при завершении элементарной (не составной) анимации (имеющей единую продолжительность).
// Н е учитывается составными анимациями - у них есть AnimationCompleted. Работает точнее чем sb.Completed.
Completed: procedure ;
// AnimationCompleted - фигурирует только в WhenCompleted. Неточна. После неё индивидуальные анимации делают ещё один шаг
AnimationCompleted: procedure ;
ApplyDecorators : = new List< Action0> ;
procedure ApplyAllDecorators; virtual ;
begin
foreach var d in ApplyDecorators do
d( ) ;
end ;
procedure InitAnimWait; virtual ;
begin
end ;
private
class function AddDoubleAnimRemainderHelper( d: DoubleAnimationBase; sb: StoryBoard; seconds: real ; ttname: string ; prop: Object ) : DoubleAnimationBase;
begin
d. Duration : = new System. Windows. Duration( System. TimeSpan. FromSeconds( seconds) ) ;
StoryBoard. SetTargetName( d, ttname) ;
StoryBoard. SetTargetProperty( d, new PropertyPath( prop) ) ;
sb. Children. Add( d) ;
Result : = d;
end ;
protected
sb: StoryBoard;
class function AddDoubleAnimByName( sb: StoryBoard; toValue, seconds: real ; ttname: string ; prop: Object ) : DoubleAnimationBase;
begin
var d : = new DoubleAnimation( ) ;
d. To : = toValue;
Result : = AddDoubleAnimRemainderHelper( d, sb, seconds, ttname, prop) ;
end ;
class function AddDoubleAnimOnByName( sb: StoryBoard; toValue, seconds: real ; ttname: string ; prop: Object ) : DoubleAnimationBase;
begin
var d : = new DoubleAnimation( ) ;
d. By : = toValue;
Result : = AddDoubleAnimRemainderHelper( d, sb, seconds, ttname, prop) ;
end ;
class function AddDoubleAnimByNameUsingKeyframes( sb: StoryBoard; a: sequence of real ; seconds: real ; ttname: string ; prop: Object ) : DoubleAnimationBase;
begin
var d : = new DoubleAnimationUsingKeyframes;
d. KeyFrames : = new DoubleKeyFrameCollection;
foreach var x in a do
d. KeyFrames. Add( new LinearDoubleKeyFrame( x) ) ; // не указываем keytime - надеемся, что по секунде
Result : = AddDoubleAnimRemainderHelper( d, sb, seconds, ttname, prop) ;
end ;
{ class function AddDoubleAnimByNameUsingTrajectory( sb: StoryBoard; a: sequence of real ; seconds: real ; ttname: string ; prop: Object ; waittime: real : = 0.0 ) : DoubleAnimationBase;
begin
var d : = new DoubleAnimationUsingKeyframes;
d. KeyFrames : = new DoubleKeyFrameCollection;
foreach var x in a do
d. KeyFrames. Add( new LinearDoubleKeyFrame( x) ) ; // не указываем keytime - надеемся, что по секунде
d. Duration : = new System. Windows. Duration( System. TimeSpan. FromSeconds( seconds) ) ;
d. BeginTime : = System. TimeSpan. FromSeconds( waittime) ;
StoryBoard. SetTargetName( d, ttname) ;
StoryBoard. SetTargetProperty( d, new PropertyPath( prop) ) ;
sb. Children. Add( d) ;
Result : = d;
end ; }
function RegisterName( sb: StoryBoard; element: Object ; ttname: string ) : boolean ;
begin
Result : = False ;
if MainWindow. FindName( ttname) = nil then
begin
MainWindow. RegisterName( ttname, element) ;
sb. Completed + = ( o, e) - > begin
if MainWindow. FindName( ttname) < > nil then
MainWindow. UnregisterName( ttname) ;
end ;
Result : = True ;
end ;
end ;
procedure InitAnim; virtual : = InitAnimWait;
private
function CreateStoryboard: StoryBoard;
begin
sb : = new StoryBoard;
var storyboardName : = 's' + sb. GetHashCode;
MainWindow. Resources. Add( storyboardName, sb) ;
var an : = AnimationCompleted;
sb. Completed + = ( o, e) - > begin
MainWindow. Resources. Remove( storyboardName) ;
if an < > nil then
an;
end ;
Result : = sb;
end ;
public
constructor( e: Object3D; sec: real ; Completed: procedure : = nil ) ;
begin
Self. Completed : = Completed;
( Element, Seconds) : = ( e, sec) ;
end ;
/// Устанавливает действие по завершению анимации
function WhenCompleted( act: procedure ) : AnimationBase;
begin
Self. AnimationCompleted : = act;
Result : = Self;
end ;
2019-05-25 21:53:02 +03:00
function Clone: AnimationBase; virtual ;
begin
Result : = Self;
end ;
2018-11-08 00:24:28 +03:00
private
procedure BeginT;
begin
sb : = CreateStoryboard;
InitAnim;
ApplyAllDecorators;
sb. Begin ;
end ;
procedure RemoveT : = begin
sb. Pause;
sb. Remove;
sb : = new Storyboard;
end ;
procedure ChangeT( a: AnimationBase) ;
begin
sb : = CreateStoryboard;
foreach var d in a. sb. Children do
sb. Children. Add( d) ;
end ;
public
/// Начинает анимацию
procedure & Begin ; virtual : = Invoke( BeginT) ;
/// Удаляет анимацию
procedure Remove : = Invoke( RemoveT) ;
/// Меняет анимацию на другую
procedure Change( a: AnimationBase) : = Invoke( ChangeT, a) ;
/// Делает паузу анимации
procedure Pause : = if sb < > nil then sb. Pause;
/// Возобновляет анимацию
procedure Resume : = if sb < > nil then sb. Resume;
/// Возвращает продолжительность анимации
function Duration: real ; virtual : = seconds;
/// Указывает анимацию, выполняющуюся после данной
function & Then( second: AnimationBase) : AnimationBase;
/// Модификатор анимации, выполняющий её бесконечно. Н е может быть применен к группе анимаций
function Forever: AnimationBase; virtual : = Self;
/// Модификатор анимации, возвращающий объект в исходное положение. Н е может быть применен к группе анимаций
function AutoReverse: AnimationBase; virtual : = Self;
/// Модификатор анимации, устанавливающий ускорение анимации в начале и замедление анимации в конце
function AccelerationRatio( acceleration: real ; deceleration: real : = 0 ) : AnimationBase; virtual : = Self;
end ;
EmptyAnimation = class( AnimationBase)
public
constructor( wait: real ) : = Seconds : = wait;
procedure InitAnim( ) ; override : = InitAnimWait;
end ;
Double1AnimationBase = class( AnimationBase)
private
v: real ;
da: DoubleAnimationBase;
public
constructor( e: Object3D; sec: real ; value: real ; Completed: procedure : = nil ) ;
begin
inherited Create( e, sec, Completed) ;
v : = value;
end ;
2019-05-25 21:53:02 +03:00
function Clone: AnimationBase; override : = new Double1AnimationBase( Element, Seconds, v, nil ) ;
2018-11-08 00:24:28 +03:00
function AutoReverse: AnimationBase; override ;
begin
ApplyDecorators. Add( ( ) - > begin
da. AutoReverse : = True ;
end ) ;
Result : = Self;
end ;
function Forever: AnimationBase; override ;
begin
ApplyDecorators. Add( ( ) - > begin
da. RepeatBehavior : = RepeatBehavior. Forever;
end ) ;
Result : = Self;
end ;
function AccelerationRatio( acceleration: real ; deceleration: real : = 0 ) : AnimationBase; override ;
begin
if acceleration < 0 then acceleration : = 0 ;
if acceleration > 1 then acceleration : = 1 ;
if deceleration < 0 then deceleration : = 0 ;
if deceleration > 1 then deceleration : = 1 ;
if acceleration + deceleration > 1 then
begin
acceleration / = acceleration + deceleration;
deceleration : = 1 - acceleration;
end ;
ApplyDecorators. Add( ( ) - > begin
da. AccelerationRatio : = acceleration;
da. DecelerationRatio : = deceleration;
end ) ;
Result : = Self;
end ;
end ;
Double3AnimationBase = class( AnimationBase)
private
x, y, z: real ;
dax, day, daz: DoubleAnimationBase;
public
constructor( e: Object3D; sec: real ; xx, yy, zz: real ; Completed: procedure : = nil ) ;
begin
inherited Create( e, sec, Completed) ;
( x, y, z) : = ( xx, yy, zz) ;
end ;
2019-05-25 21:53:02 +03:00
function Clone: AnimationBase; override : = new Double3AnimationBase( Element, Seconds, x, y, z, nil ) ;
2018-11-08 00:24:28 +03:00
function AutoReverse: AnimationBase; override ;
begin
ApplyDecorators. Add( ( ) - > begin
dax. AutoReverse : = True ;
day. AutoReverse : = True ;
daz. AutoReverse : = True ;
end ) ;
Result : = Self;
end ;
function Forever: AnimationBase; override ;
begin
ApplyDecorators. Add( ( ) - > begin
dax. RepeatBehavior : = RepeatBehavior. Forever;
day. RepeatBehavior : = RepeatBehavior. Forever;
daz. RepeatBehavior : = RepeatBehavior. Forever;
end ) ;
Result : = Self;
end ;
function AccelerationRatio( acceleration: real ; deceleration: real : = 0 ) : AnimationBase; override ;
begin
if acceleration < 0 then acceleration : = 0 ;
if acceleration > 1 then acceleration : = 1 ;
if deceleration < 0 then deceleration : = 0 ;
if deceleration > 1 then deceleration : = 1 ;
if acceleration + deceleration > 1 then
begin
acceleration / = acceleration + deceleration;
deceleration : = 1 - acceleration;
end ;
ApplyDecorators. Add( ( ) - > begin
dax. AccelerationRatio : = acceleration;
day. AccelerationRatio : = acceleration;
daz. AccelerationRatio : = acceleration;
dax. DecelerationRatio : = deceleration;
day. DecelerationRatio : = deceleration;
daz. DecelerationRatio : = deceleration;
end ) ;
Result : = Self;
end ;
end ;
OffsetAnimationOn = class( Double3AnimationBase)
private
el: TranslateTransform3D;
procedure Hand( o: object ; e: System. EventArgs) ;
begin
var el0 : = Element. transltransform;
el0. OffsetX + = el. OffsetX;
el0. OffsetY + = el. OffsetY;
el0. OffsetZ + = el. OffsetZ;
Element. transfgroup. Children. Remove( el) ;
if Completed < > nil then
Completed( ) ;
end ;
procedure InitAnimWait; override ;
begin
el : = new TranslateTransform3D( ) ;
Element. transfgroup. Children. Add( el) ;
var ttname : = 't' + el. GetHashCode;
if not RegisterName( sb, el, ttname) then ;
dax : = AddDoubleAnimOnByName( sb, x, seconds, ttname, TranslateTransform3D. OffsetXProperty) ;
day : = AddDoubleAnimOnByName( sb, y, seconds, ttname, TranslateTransform3D. OffsetYProperty) ;
daz : = AddDoubleAnimOnByName( sb, z, seconds, ttname, TranslateTransform3D. OffsetZProperty) ;
daz. Completed + = Hand;
end ;
public
2019-05-25 21:53:02 +03:00
function Clone: AnimationBase; override : = new OffsetAnimationOn( Element, Seconds, x, y, z, nil ) ;
2018-11-08 00:24:28 +03:00
end ;
OffsetAnimation = class( OffsetAnimationOn)
procedure InitAnimWait; override ;
begin
el : = new TranslateTransform3D( ) ;
Element. transfgroup. Children. Add( el) ;
var ttname : = 't' + el. GetHashCode;
if not RegisterName( sb, el, ttname) then ;
dax : = AddDoubleAnimOnByName( sb, x- Element. x, seconds, ttname, TranslateTransform3D. OffsetXProperty) ;
day : = AddDoubleAnimOnByName( sb, y- Element. y, seconds, ttname, TranslateTransform3D. OffsetYProperty) ;
daz : = AddDoubleAnimOnByName( sb, z- Element. z, seconds, ttname, TranslateTransform3D. OffsetZProperty) ;
daz. Completed + = Hand;
end ;
public
2019-05-25 21:53:02 +03:00
function Clone: AnimationBase; override : = new OffsetAnimation( Element, Seconds, x, y, z, nil ) ;
2018-11-08 00:24:28 +03:00
end ;
OffsetAnimationUsingKeyframes = class( Double3AnimationBase)
private
el: TranslateTransform3D;
a: sequence of Point3D;
procedure Hand( o: object ; e: System. EventArgs) ;
begin
var el0 : = Element. transltransform;
el0. OffsetX + = el. OffsetX;
el0. OffsetY + = el. OffsetY;
el0. OffsetZ + = el. OffsetZ;
Element. transfgroup. Children. Remove( el) ;
if Completed < > nil then
Completed( ) ;
end ;
procedure InitAnimWait; override ;
begin
el : = new TranslateTransform3D( ) ;
Element. transfgroup. Children. Add( el) ;
var ttname : = 't' + el. GetHashCode;
if not RegisterName( sb, el, ttname) then ;
var aa : = a. ToArray;
dax : = AddDoubleAnimByNameUsingKeyframes( sb, aa. Select( p - > p. x- Element. x) , seconds, ttname, TranslateTransform3D. OffsetXProperty) ;
day : = AddDoubleAnimByNameUsingKeyframes( sb, aa. Select( p - > p. y- Element. y) , seconds, ttname, TranslateTransform3D. OffsetYProperty) ;
daz : = AddDoubleAnimByNameUsingKeyframes( sb, aa. Select( p - > p. z- Element. z) , seconds, ttname, TranslateTransform3D. OffsetZProperty) ;
daz. Completed + = Hand;
end ;
public
constructor( e: Object3D; sec: real ; aa: sequence of Point3D; Completed: procedure : = nil ) ;
begin
inherited Create( e, sec, Completed) ;
a : = aa;
end ;
2019-05-25 21:53:02 +03:00
function Clone: AnimationBase; override : = new OffsetAnimationUsingKeyframes( Element, Seconds, a, nil ) ;
2018-11-08 00:24:28 +03:00
end ;
ScaleAnimation = class( Double3AnimationBase)
private
scale: real ;
el: ScaleTransform3D;
procedure Hand( o: object ; e: System. EventArgs) ;
begin
2019-04-21 13:01:24 +03:00
if not dax. AutoReverse then
begin
var el0 : = Element. scaletransform;
el0. ScaleX + = el. ScaleX;
el0. ScaleY + = el. ScaleY;
el0. ScaleZ + = el. ScaleZ;
end ;
2018-11-08 00:24:28 +03:00
Element. transfgroup. Children. Remove( el) ;
if Completed < > nil then
Completed( ) ;
end ;
procedure InitAnimWait; override ;
begin
el : = new ScaleTransform3D( ) ;
Element. transfgroup. Children. Add( el) ;
var sctransform : = Element. scaletransform;
var ttname : = 's' + sctransform. GetHashCode;
if not RegisterName( sb, sctransform, ttname) then ;
dax : = AddDoubleAnimByName( sb, scale, seconds, ttname, ScaleTransform3D. ScaleXProperty) ;
day : = AddDoubleAnimByName( sb, scale, seconds, ttname, ScaleTransform3D. ScaleYProperty) ;
daz : = AddDoubleAnimByName( sb, scale, seconds, ttname, ScaleTransform3D. ScaleZProperty) ;
daz. Completed + = Hand;
end ;
public
constructor( e: Object3D; sec: real ; sc: real ; Completed: procedure : = nil ) ;
begin
inherited Create( e, sec, Completed) ;
scale : = sc;
end ;
2019-05-25 21:53:02 +03:00
function Clone: AnimationBase; override : = new ScaleAnimation( Element, Seconds, scale, nil ) ;
2018-11-08 00:24:28 +03:00
end ;
ScaleXAnimation = class( Double1AnimationBase)
private
scale: real ;
el: ScaleTransform3D;
procedure Hand( o: object ; e: System. EventArgs) ;
begin
2019-04-21 13:01:24 +03:00
if not da. AutoReverse then
begin
var el0 : = Element. scaletransform;
el0. ScaleX + = el. ScaleX;
end ;
2018-11-08 00:24:28 +03:00
Element. transfgroup. Children. Remove( el) ;
if Completed < > nil then
Completed( ) ;
end ;
procedure InitAnimWait; override ;
begin
el : = new ScaleTransform3D( ) ;
Element. transfgroup. Children. Add( el) ;
var sctransform : = Element. scaletransform;
var ttname : = 's' + sctransform. GetHashCode;
if not RegisterName( sb, sctransform, ttname) then ;
da : = AddDoubleAnimByName( sb, scale, seconds, ttname, ScaleTransform3D. ScaleXProperty) ;
da. Completed + = Hand;
end ;
public
constructor( e: Object3D; sec: real ; sc: real ; Completed: procedure : = nil ) ;
begin
inherited Create( e, sec, Completed) ;
scale : = sc;
end ;
2019-05-25 21:53:02 +03:00
function Clone: AnimationBase; override : = new ScaleXAnimation( Element, Seconds, scale, nil ) ;
2018-11-08 00:24:28 +03:00
end ;
ScaleYAnimation = class( ScaleXAnimation)
private
procedure Hand( o: object ; e: System. EventArgs) ;
begin
2019-04-21 13:01:24 +03:00
if not da. AutoReverse then
begin
var el0 : = Element. scaletransform;
el0. ScaleY + = el. ScaleY;
end ;
2018-11-08 00:24:28 +03:00
Element. transfgroup. Children. Remove( el) ;
if Completed < > nil then
Completed( ) ;
end ;
procedure InitAnimWait; override ;
begin
el : = new ScaleTransform3D( ) ;
Element. transfgroup. Children. Add( el) ;
var sctransform : = Element. scaletransform;
var ttname : = 's' + sctransform. GetHashCode;
if not RegisterName( sb, sctransform, ttname) then ;
da : = AddDoubleAnimByName( sb, scale, seconds, ttname, ScaleTransform3D. ScaleYProperty) ;
da. Completed + = Hand;
end ;
2019-05-25 21:53:02 +03:00
public
function Clone: AnimationBase; override : = new ScaleYAnimation( Element, Seconds, scale, nil ) ;
2018-11-08 00:24:28 +03:00
end ;
ScaleZAnimation = class( ScaleXAnimation)
private
procedure Hand( o: object ; e: System. EventArgs) ;
begin
2019-04-21 13:01:24 +03:00
if not da. AutoReverse then
begin
var el0 : = Element. scaletransform;
el0. ScaleZ + = el. ScaleZ;
end ;
2018-11-08 00:24:28 +03:00
Element. transfgroup. Children. Remove( el) ;
if Completed < > nil then
Completed( ) ;
end ;
procedure InitAnimWait; override ;
begin
el : = new ScaleTransform3D( ) ;
Element. transfgroup. Children. Add( el) ;
var sctransform : = Element. scaletransform;
var ttname : = 's' + sctransform. GetHashCode;
if not RegisterName( sb, sctransform, ttname) then ;
da : = AddDoubleAnimByName( sb, scale, seconds, ttname, ScaleTransform3D. ScaleZProperty) ;
da. Completed + = Hand;
end ;
2019-05-25 21:53:02 +03:00
public
function Clone: AnimationBase; override : = new ScaleZAnimation( Element, Seconds, scale, nil ) ;
2018-11-08 00:24:28 +03:00
end ;
RotateAtAnimation = class( Double1AnimationBase)
private
vx, vy, vz, angle: real ;
center: Point3D;
el: RotateTransform3D;
procedure Hand( o: object ; e: System. EventArgs) ;
begin
var rot : = el. Rotation as AxisAngleRotation3D;
2019-04-21 13:01:24 +03:00
if not da. AutoReverse then
Element. RotateAt( rot. Axis, angle, center) ;
2018-11-08 00:24:28 +03:00
Element. transfgroup. Children. Remove( el) ;
if Completed < > nil then
Completed( ) ;
end ;
procedure InitAnimWait; override ;
begin
el : = new RotateTransform3D( ) ;
el. Rotation : = new AxisAngleRotation3D( ) ;
Element. transfgroup. Children. Insert( 0 , el) ; // До основной матрицы, связанной с поворотом
var rottransform : = el;
rottransform. CenterX : = center. x;
rottransform. CenterY : = center. y;
rottransform. CenterZ : = center. z;
var rot : = rottransform. Rotation as AxisAngleRotation3D;
var ttname : = 'r' + rot. GetHashCode;
if not RegisterName( sb, rot, ttname) then ;
rot. Angle : = 0 ; //?
rot. Axis : = V3D( vx, vy, vz) ; //?
//var elem: Object3D := Element;
// М б da.Completed
da : = AddDoubleAnimByName( sb, angle, seconds, ttname, AxisAngleRotation3D. AngleProperty) ;
da. Completed + = Hand;
end ;
public
constructor( e: Object3D; sec: real ; vvx, vvy, vvz, a: real ; c: Point3D; Completed: procedure : = nil ) ;
begin
inherited Create( e, sec, Completed) ;
( vx, vy, vz, angle, center) : = ( vvx, vvy, vvz, a, c)
end ;
2019-05-25 21:53:02 +03:00
public
function Clone: AnimationBase; override : = new RotateAtAnimation( Element, Seconds, vx, vy, vz, angle, center, nil ) ;
2018-11-08 00:24:28 +03:00
end ;
CompositeAnimation = class( AnimationBase)
private
ll: List< AnimationBase> ;
public
constructor( params l: array of AnimationBase) : = ll : = Lst( l) ;
constructor( l: List< AnimationBase> ) : = ll : = l;
end ;
GroupAnimation = class( CompositeAnimation)
public
function Duration: real ; override : = ll. Select( l - > l. Duration) . Max;
function Add( b: AnimationBase) : GroupAnimation;
begin
ll + = b;
Result : = Self;
end ;
class function operator + = ( a: GroupAnimation; b: AnimationBase) : GroupAnimation;
begin
a. ll + = b;
Result : = a;
end ;
procedure BeginT;
begin
for var i: = 0 to ll. Count- 1 do
ll[ i] . Begin ;
end ;
procedure & Begin ; override : = Invoke( BeginT) ;
end ;
SequenceAnimation = class( CompositeAnimation)
public
function Duration: real ; override : = ll. Select( l - > l. Duration) . Sum;
function Add( b: AnimationBase) : SequenceAnimation;
begin
ll + = b;
Result : = Self;
end ;
class function operator + = ( a: SequenceAnimation; b: AnimationBase) : SequenceAnimation;
begin
a. ll + = b;
Result : = a;
end ;
procedure BeginT;
2019-05-25 21:53:02 +03:00
begin
//Println(Self.GetType+' '+ll.Count);
2018-11-08 00:24:28 +03:00
for var ii: = 0 to ll. Count- 2 do
begin
var i : = ii; // параметр цикла неправильно захватывается лямбдой
var lll : = ll; // поле предка - вообще не захватывается
// Если ll[i] - CompositeAnimation, то надо повесить Completed на самую правую не CompositeAnimation
var lf : = ll[ i] ;
2019-05-25 21:53:02 +03:00
var llf : = ll;
var lli : = i;
2018-11-08 00:24:28 +03:00
while lf is CompositeAnimation do
begin
var ca : = lf as CompositeAnimation;
lf : = ca. ll[ ca. ll. Count- 1 ] ;
2019-05-25 21:53:02 +03:00
llf : = ca. ll;
lli : = ca. ll. Count- 1 ;
2018-11-08 00:24:28 +03:00
end ;
2019-05-25 21:53:02 +03:00
// lf надо в любом случае клонировать
// Клонируем. Надо еще списки клонировать! А то в a+a во втором списке последний элемент - клонированный - в обоих списках!
lf : = lf. Clone;
llf[ lli] : = lf;
2018-11-08 00:24:28 +03:00
lf. Completed + = procedure - >
begin
2019-05-25 21:53:02 +03:00
//Print('Completed '+lf.GetType.ToString);
//Println(i+1);
2018-11-08 00:24:28 +03:00
lll[ i+ 1 ] . Begin ;
end ;
end ;
ll[ 0 ] . Begin ;
end ;
procedure & Begin ; override : = Invoke( BeginT) ;
end ;
/// Класс, содержащий комбинации анимаций: группа и последовательность
Animate = class
public
/// Возвращает группу анимаций, выполняющихся параллельно
class function Group( params l: array of AnimationBase) : = new GroupAnimation( Lst( l) ) ;
/// Возвращает последовательность анимаций, выполняющихся последовательно
class function & Sequence( params l: array of AnimationBase) : = new SequenceAnimation( l) ;
end ;
type
// -----------------------------------------------------
//>> Graph3D: класс SphereT # Graph3D SphereT class
// -----------------------------------------------------
/// Класс сферы
SphereT = class( ObjectWithMaterial3D)
private
function Model : = inherited model as SphereVisual3D;
procedure SetRP( r: real ) : = Model. Radius : = r;
procedure SetR( r: real ) : = Invoke( SetRP, r) ;
function GetR: real : = InvokeReal( ( ) - > Model. Radius) ;
function NewVisualObject( r: real ) : SphereVisual3D;
begin
var sph : = new SphereVisual3D;
sph. Center : = P3D( 0 , 0 , 0 ) ;
sph. Radius : = r;
Result : = sph;
end ;
protected
function CreateObject: Object3D; override : = new SphereT( X, Y, Z, Radius, Material. Clone) ;
constructor : = CreateBase( NewVisualObject( 1 ) , 0 , 0 , 0 , Materialhelper. CreateMaterial( Colors. Blue) ) ;
public
2018-12-12 21:09:07 +03:00
constructor( x, y, z, r: real ; m: Gmaterial) : = CreateBase( NewVisualObject( r) , x, y, z, m) ;
2018-11-08 00:24:28 +03:00
/// Радиус сферы
property Radius: real read GetR write SetR;
/// Возвращает клон сферы
function Clone : = ( inherited Clone) as SphereT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс EllipsoidT # Graph3D EllipsoidT class
// -----------------------------------------------------
/// Класс эллипсоида
EllipsoidT = class( ObjectWithMaterial3D)
private
function Model : = inherited model as EllipsoidVisual3D;
procedure SetRX( r: real ) : = Invoke( procedure( r: real ) - > Model. RadiusX : = r, r) ;
function GetRX: real : = InvokeReal( ( ) - > Model. RadiusX) ;
procedure SetRYP( r: real ) : = Model. RadiusY : = r;
procedure SetRY( r: real ) : = Invoke( SetRYP, r) ;
function GetRY: real : = InvokeReal( ( ) - > Model. RadiusY) ;
procedure SetRZP( r: real ) : = Model. RadiusZ : = r;
procedure SetRZ( r: real ) : = Invoke( SetRZP, r) ;
function GetRZ: real : = InvokeReal( ( ) - > Model. RadiusZ) ;
function NewVisualObject( rx, ry, rz: real ) : EllipsoidVisual3D;
begin
var ell : = new EllipsoidVisual3D;
ell. Center : = P3D( 0 , 0 , 0 ) ;
ell. RadiusX : = rx;
ell. RadiusY : = ry;
ell. RadiusZ : = rz;
Result : = ell;
end ;
protected
function CreateObject: Object3D; override : = new EllipsoidT( X, Y, Z, RadiusX, RadiusY, RadiusZ, Material. Clone) ;
constructor( x, y, z, rx, ry, rz: real ; m: GMaterial) : = CreateBase( NewVisualObject( rx, ry, rz) , x, y, z, m) ;
public
/// Радиус эллипсоида по оси X
property RadiusX: real read GetRX write SetRX;
/// Радиус эллипсоида по оси Y
property RadiusY: real read GetRY write SetRY;
/// Радиус эллипсоида по оси Z
property RadiusZ: real read GetRZ write SetRZ;
/// Возвращает клон эллипсоида
function Clone : = ( inherited Clone) as EllipsoidT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс CubeT # Graph3D CubeT class
// -----------------------------------------------------
/// Класс куба
CubeT = class( ObjectWithMaterial3D)
private
function model : = inherited model as CubeVisual3D;
procedure SetWP( r: real ) : = model. SideLength : = r;
procedure SetW( r: real ) : = Invoke( SetWP, r) ;
function GetW: real : = InvokeReal( ( ) - > model. SideLength) ;
private
function NewVisualObject( w: real ) : CubeVisual3D;
begin
var bx : = new CubeVisual3D;
bx. Center : = P3D( 0 , 0 , 0 ) ;
bx. SideLength : = w;
Result : = bx;
end ;
protected
function CreateObject: Object3D; override : = new CubeT( X, Y, Z, SideLength, Material. Clone) ;
constructor( x, y, z, w: real ; m: GMaterial) : = CreateBase( NewVisualObject( w) , x, y, z, m) ;
public
/// Сторона куба
property SideLength: real read GetW write SetW;
/// Возвращает клон куба
function Clone : = ( inherited Clone) as CubeT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс BoxT # Graph3D BoxT class
// -----------------------------------------------------
/// Класс паралеллепипеда
BoxT = class( ObjectWithMaterial3D)
private
function model : = inherited model as BoxVisual3D;
procedure SetWP( r: real ) : = model. Width : = r;
procedure SetW( r: real ) : = Invoke( SetWP, r) ;
function GetW: real : = InvokeReal( ( ) - > model. Width) ;
procedure SetHP( r: real ) : = model. Height : = r;
procedure SetH( r: real ) : = Invoke( SetHP, r) ;
function GetH: real : = InvokeReal( ( ) - > model. Height) ;
procedure SetLP( r: real ) : = model. Length : = r;
procedure SetL( r: real ) : = Invoke( SetLP, r) ;
function GetL: real : = InvokeReal( ( ) - > model. Length ) ;
procedure SetSzP( r: Size3D) : = ( model. Length , model. Width, model. Height) : = ( r. X, r. Y, r. Z) ;
procedure SetSz( r: Size3D) : = Invoke( SetSzP, r) ;
function GetSz: Size3D : = Inv( ( ) - > Sz3D( model. Length , model. Width, model. Height) ) ;
private
function NewVisualObject( l, w, h: real ) : BoxVisual3D;
begin
var bx : = new BoxVisual3D;
bx. Center : = P3D( 0 , 0 , 0 ) ;
( bx. Width, bx. Height, bx. Length ) : = ( w, h, l) ;
Result : = bx;
end ;
protected
function CreateObject: Object3D; override : = new BoxT( X, Y, Z, Length , Width, Height, Material. Clone) ;
constructor( x, y, z, l, w, h: real ; m: GMaterial) : = CreateBase( NewVisualObject( l, w, h) , x, y, z, m) ;
public
/// Возвращает длину паралеллепипеда (по оси X)
property Length : real read GetL write SetL;
/// Возвращает ширину паралеллепипеда (по оси Y)
property Width: real read GetW write SetW;
/// Возвращает высоту паралеллепипеда (по оси Z)
property Height: real read GetH write SetH;
/// Возвращает размеры паралеллепипеда
property Size: Size3D read GetSz write SetSz;
/// Возвращает клон паралеллепипеда
function Clone : = ( inherited Clone) as BoxT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс ArrowT # Graph3D ArrowT class
// -----------------------------------------------------
/// Класс 3D-стрелки
ArrowT = class( ObjectWithMaterial3D)
private
function model : = inherited model as ArrowVisual3D;
procedure SetDP( r: real ) : = model. Diameter : = r;
procedure SetD( r: real ) : = Invoke( SetDP, r) ;
function GetD: real : = InvokeReal( ( ) - > model. Diameter) ;
procedure SetLP( r: real ) : = model. HeadLength : = r;
procedure SetL( r: real ) : = Invoke( SetLP, r) ;
function GetL: real : = InvokeReal( ( ) - > model. HeadLength) ;
procedure SetDirP( r: Vector3D) : = model. Direction : = r;
procedure SetDir( r: Vector3D) : = Invoke( SetDirP, r) ;
function GetDir: Vector3D : = Invoke& < Vector3D> ( ( ) - > model. Direction) ;
private
function NewVisualObject( dx, dy, dz, d, hl: real ) : ArrowVisual3D;
begin
var a : = new ArrowVisual3D;
a. HeadLength : = hl;
a. Diameter : = d;
a. Origin : = P3D( 0 , 0 , 0 ) ;
Result : = a;
end ;
protected
function CreateObject: Object3D; override : = new ArrowT( X, Y, Z, Direction. X, Direction. Y, Direction. Z, Diameter, HeadLength, Material. Clone) ;
constructor( x, y, z, dx, dy, dz, d, hl: real ; m: GMaterial) ;
begin
var a : = NewVisualObject( dx, dy, dz, d, hl) ;
CreateBase( a, x, y, z, m) ;
a. Direction : = V3D( dx, dy, dz) ;
end ;
public
/// Длина наконечника 3D-стрелки
property HeadLength: real read GetL write SetL;
/// Диаметр 3D-стрелки
property Diameter: real read GetD write SetD;
/// направление 3D-стрелки
property Direction: Vector3D read GetDir write SetDir;
/// Возвращает клон 3D-стрелки
function Clone : = ( inherited Clone) as ArrowT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс TruncatedConeT # Graph3D TruncatedConeT class
// -----------------------------------------------------
/// Класс усеченного конуса
TruncatedConeT = class( ObjectWithMaterial3D)
private
function model : = inherited model as TruncatedConeVisual3D;
procedure SetH( r: real ) : = Invoke( procedure( r: real ) - > model. Height : = r, r) ;
function GetH: real : = InvokeReal( ( ) - > model. Height) ;
procedure SetBRP( r: real ) : = model. BaseRadius : = r;
procedure SetBR( r: real ) : = Invoke( SetBRP, r) ;
function GetBR: real : = InvokeReal( ( ) - > model. BaseRadius) ;
procedure SetTRP( r: real ) : = model. TopRadius : = r;
procedure SetTR( r: real ) : = Invoke( SetTRP, r) ;
function GetTR: real : = InvokeReal( ( ) - > model. TopRadius) ;
procedure SetTCP( r: boolean ) : = model. TopCap : = r;
procedure SetTC( r: boolean ) : = Invoke( SetTCP, r) ;
function GetTC: boolean : = Invoke& < boolean > ( ( ) - > model. TopCap) ;
private
function NewVisualObject( h, baser, topr: real ; sides: integer ; topcap: boolean ) : TruncatedConeVisual3D;
begin
var a : = new TruncatedConeVisual3D;
a. Origin : = P3D( 0 , 0 , 0 ) ;
a. BaseRadius : = baser;
a. TopRadius : = topr;
a. Height : = h;
a. TopCap : = topcap;
a. ThetaDiv : = sides + 1 ;
a. BaseCap : = True ;
Result : = a;
end ;
protected
function CreateObject: Object3D; override : = new TruncatedConeT( X, Y, Z, Height, BaseRadius, TopRadius, ( model as TruncatedConeVisual3D) . ThetaDiv - 1 , Topcap, Material. Clone) ;
constructor( x, y, z, h, baser, topr: real ; sides: integer ; topcap: boolean ; m: GMaterial) ;
begin
var a : = NewVisualObject( h, baser, topr, sides, topcap) ;
CreateBase( a, x, y, z, m) ;
end ;
public
/// Высота усеченного конуса
property Height: real read GetH write SetH;
/// Радиус основания усеченного конуса
property BaseRadius: real read GetBR write SetBR;
/// Верхний радиус усеченного конуса
property TopRadius: real read GetTR write SetTR;
/// Есть ли шапочка у усеченного конуса
property Topcap: boolean read GetTC write SetTC;
/// Возвращает клон усеченного конуса
function Clone : = ( inherited Clone) as TruncatedConeT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс CylinderT # Graph3D CylinderT class
// -----------------------------------------------------
/// Класс цилиндра
CylinderT = class( TruncatedConeT)
private
procedure SetR( r: real ) ;
begin
BaseRadius : = r;
TopRadius : = r;
end ;
function GetR: real : = BaseRadius;
protected
function CreateObject: Object3D; override : = new CylinderT( X, Y, Z, Height, Radius, ( model as TruncatedConeVisual3D) . ThetaDiv - 1 , Topcap, Material. Clone) ;
constructor( x, y, z, h, r: real ; ThetaDiv: integer ; topcap: boolean ; m: GMaterial) ;
begin
var a : = NewVisualObject( h, r, r, ThetaDiv, topcap) ;
CreateBase( a, x, y, z, m) ;
end ;
public
/// Радиус цилиндра
property Radius: real read GetR write SetR;
/// Возвращает клон цилиндра
function Clone : = ( inherited Clone) as CylinderT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс TeapotT # Graph3D TeapotT class
// -----------------------------------------------------
/// Класс чайника
TeapotT = class( ObjectWithMaterial3D)
private
procedure SetVP( v: boolean ) : = ( model as MeshElement3D) . Visible : = v;
procedure SetV( v: boolean ) : = Invoke( SetVP, v) ;
function GetV: boolean : = Invoke& < boolean > ( ( ) - > ( model as MeshElement3D) . Visible) ;
protected
function CreateObject: Object3D; override : = new TeapotT( X, Y, Z, Material. Clone) ;
constructor( x, y, z: real ; m: GMaterial) ;
begin
var a : = new Teapot;
CreateBase( a, x, y, z, m) ;
Rotate( V3D( 1 , 0 , 0 ) , 9 0 ) ;
end ;
public
/// Видим ли чайник
property Visible: boolean read GetV write SetV;
/// Возвращает клон чайника
function Clone : = ( inherited Clone) as TeapotT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс CoordinateSystemT # Graph3D CoordinateSystemT class
// -----------------------------------------------------
/// Класс системы координат
CoordinateSystemT = class( ObjectWithChildren3D)
private
procedure SetALP( r: real ) : = ( model as CoordinateSystemVisual3D) . ArrowLengths : = r;
procedure SetAL( r: real ) : = Invoke( SetALP, r) ;
function GetAL: real : = InvokeReal( ( ) - > ( model as CoordinateSystemVisual3D) . ArrowLengths) ;
function GetD: real : = InvokeReal( ( ) - > ( ( model as CoordinateSystemVisual3D) . Children[ 0 ] as ArrowVisual3D) . Diameter) ;
protected
function CreateObject: Object3D; override : = new CoordinateSystemT( X, Y, Z, ArrowLengths, Diameter) ;
constructor( x, y, z, arrlength, diameter: real ) ;
begin
var a : = new CoordinateSystemVisual3D;
CreateBase0( a, x, y, z) ;
a. ArrowLengths : = arrlength;
( a. Children[ 0 ] as ArrowVisual3D) . Diameter : = diameter;
( a. Children[ 1 ] as ArrowVisual3D) . Diameter : = diameter;
( a. Children[ 2 ] as ArrowVisual3D) . Diameter : = diameter;
( a. Children[ 3 ] as CubeVisual3D) . SideLength : = diameter;
end ;
public
/// Длина стрелок системы координат
property ArrowLengths: real read GetAL write SetAL;
/// Диаметр стрелок системы координат
property Diameter: real read GetD;
/// Возвращает клон системы координат
function Clone : = ( inherited Clone) as CoordinateSystemT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс BillboardTextT # Graph3D BillboardTextT class
// -----------------------------------------------------
/// Класс текста на билборде (всегда направлен к камере)
BillboardTextT = class( ObjectWithChildren3D)
private
function model : = inherited model as BillboardTextVisual3D;
procedure SetTP( r: string ) : = model. Text : = r;
procedure SetT( r: string ) : = Invoke( SetTP, r) ;
function GetT: string : = InvokeString( ( ) - > model. Text ) ;
procedure SetFSP( r: real ) : = model. FontSize : = r;
procedure SetFS( r: real ) : = Invoke( SetFSP, r) ;
function GetFS: real : = InvokeReal( ( ) - > model. FontSize) ;
protected
function CreateObject: Object3D; override : = new BillboardTextT( X, Y, Z, Text , FontSize) ;
constructor( x, y, z: real ; text : string ; fontsize: real ) ;
begin
var a : = new BillboardTextVisual3D;
CreateBase0( a, x, y, z) ;
a. Position : = p3D( 0 , 0 , 0 ) ;
a. Text : = text ;
a. FontSize : = fontsize;
end ;
public
/// Текст на билборде
property Text : string read GetT write SetT;
/// Размер шрифта на билборде
property FontSize: real read GetFS write SetFS;
/// Возвращает клон билборда
function Clone : = ( inherited Clone) as BillboardTextT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс TextT # Graph3D TextT class
// -----------------------------------------------------
/// Класс 3D-текстового объекта
TextT = class( ObjectWithChildren3D)
private
_fontname: string ;
function model : = inherited model as TextVisual3D;
procedure SetTP( r: string ) : = model. Text : = r;
procedure SetT( r: string ) : = Invoke( SetTP, r) ;
function GetT: string : = InvokeString( ( ) - > model. Text ) ;
procedure SetFSP( r: real ) : = model. Height : = r;
procedure SetFS( r: real ) : = Invoke( SetFS, r) ;
function GetFS: real : = InvokeReal( ( ) - > model. Height) ;
procedure SetUP( v: Vector3D) : = model. UpDirection : = v;
procedure SetU( v: Vector3D) : = Invoke( SetUP, v) ;
function GetU: Vector3D : = Invoke& < Vector3D> ( ( ) - > model. UpDirection) ;
procedure SetNP( fontname: string ) : = model. FontFamily : = new FontFamily( fontname) ;
procedure SetN( fontname: string ) : = Invoke( SetTP, fontname) ;
function GetN: string : = InvokeString( ( ) - > _fontname) ;
procedure SetColorP( c: GColor) : = model. Foreground : = new SolidColorBrush( c) ;
procedure SetColor( c: GColor) : = Invoke( SetColorP, c) ;
function GetColor: GColor : = Invoke& < GColor> ( ( ) - > ( model. Foreground as SolidColorBrush) . Color) ;
protected
function CreateObject: Object3D; override : = new TextT( X, Y, Z, Text , Height, FontName, Color) ;
constructor( x, y, z: real ; text : string ; height: real ; fontname: string ; c: GColor) ;
begin
var a : = new TextVisual3D;
a. Position : = p3D( 0 , 0 , 0 ) ;
a. Text : = text ;
a. Height : = height;
//a.HorizontalAlignment := HorizontalAlignment.Left;
Self. _fontname : = fontname;
a. FontFamily : = new FontFamily( fontname) ;
a. Foreground : = new SolidColorBrush( c) ;
CreateBase0( a, x, y, z) ;
end ;
public
/// Текст на 3D-текстовом объекте
property Text : string read GetT write SetT;
/// Высота 3D-текстового объекта
property Height: real read GetFS write SetFS;
/// Имя шрифта 3D-текстового объекта
property FontName: string read GetN write SetN;
/// Направление "вверх" для 3D-текстового объекта
property UpDirection: Vector3D read GetU write SetU;
/// Цвет 3D-текстового объекта
property Color: GColor read GetColor write SetColor; override ;
/// Возвращает клон 3D-текстового объекта
function Clone : = ( inherited Clone) as TextT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс RectangleT # Graph3D RectangleT class
// -----------------------------------------------------
/// Класс 3D-прямоугольника
RectangleT = class( ObjectWithMaterial3D)
private
function model : = inherited model as RectangleVisual3D;
procedure SetWP( r: real ) : = model. Width : = r;
procedure SetW( r: real ) : = Invoke( SetWP, r) ;
function GetW: real : = InvokeReal( ( ) - > model. Width) ;
procedure SetLP( r: real ) : = model. Length : = r;
procedure SetL( r: real ) : = Invoke( SetLP, r) ;
function GetL: real : = InvokeReal( ( ) - > model. Length ) ;
procedure SetLDP( r: Vector3D) : = model. LengthDirection : = r;
procedure SetLD( r: Vector3D) : = Invoke( SetLDP, r) ;
function GetLD: Vector3D : = Invoke& < Vector3D> ( ( ) - > model. LengthDirection) ;
procedure SetNP( r: Vector3D) : = model. Normal : = r;
procedure SetN( r: Vector3D) : = Invoke( SetNP, r) ;
function GetN: Vector3D : = Invoke& < Vector3D> ( ( ) - > model. Normal) ;
protected
function CreateObject: Object3D; override : = new RectangleT( X, Y, Z, Length , Width, Normal, LengthDirection, Material) ;
constructor( x, y, z, Length , Width: real ; Normal, LengthDirection: Vector3D; m: GMaterial) ;
begin
var a : = new RectangleVisual3D;
a. Origin : = P3D( 0 , 0 , 0 ) ;
a. Width : = Width;
a. Length : = Length ;
a. LengthDirection : = lengthdirection;
a. Normal : = normal;
CreateBase( a, x, y, z, m) ;
end ;
public
/// Ширина 3D-прямоугольника
property Width: real read GetW write SetW;
/// Длина 3D-прямоугольника
property Length : real read GetL write SetL;
/// Направление длины 3D-прямоугольника
property LengthDirection: Vector3D read GetLD write SetLD;
/// Нормаль к 3D-прямоугольнику
property Normal: Vector3D read GetN write SetN;
/// Возвращает клон 3D-прямоугольника
function Clone : = ( inherited Clone) as RectangleT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс FileModelT # Graph3D FileModelT class
// -----------------------------------------------------
/// Класс 3D-модели
FileModelT = class( ObjectWithChildren3D)
private
fn: string ;
procedure SetMP( mat: GMaterial) : = ( model as FileModelVisual3D) . DefaultMaterial : = mat;
procedure SetMaterial( mat: GMaterial) : = Invoke( SetMP, mat) ;
function GetMaterial: GMaterial : = Invoke& < GMaterial> ( ( ) - > ( model as FileModelVisual3D) . DefaultMaterial) ;
public
//property Color: GColor write SetColor;
property Material: GMaterial read GetMaterial write SetMaterial; // не работает почему-то на запись
{ procedure SetVP( v: boolean ) : = ( model as FileModelVisual3D) . Visibility : = v;
procedure SetV( v: boolean ) : = Invoke( SetVP, v) ;
function GetV: boolean : = Invoke& < boolean > ( ( ) - > ( model as FileModelVisual3D) . Visibility) ; }
protected
function CreateObject: Object3D; override : = new FileModelT( X, Y, Z, fn, Material. Clone) ;
constructor( x, y, z: real ; fname: string ; mat: GMaterial) ;
begin
{ '.3ds' : r : = new studioreader( nil ) ;
'.lwo' : r : = new lworeader( nil ) ;
'.stl' : r : = new stlreader( nil ) ;
'.obj' , '.objx' : r : = new objreader( nil ) ; }
var a : = new FileModelVisual3D;
a. DefaultMaterial : = mat;
a. Source : = fname;
CreateBase0( a, x, y, z) ;
end ;
public
/// Возвращает клон 3D-модели
function Clone : = ( inherited Clone) as FileModelT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс PipeT # Graph3D PipeT class
// -----------------------------------------------------
/// Класс трубы
PipeT = class( ObjectWithMaterial3D)
private
function model : = inherited model as PipeVisual3D;
procedure SetDP( r: real ) : = model. Diameter : = r * 2 ;
procedure SetD( r: real ) : = Invoke( SetDP, r) ;
function GetD: real : = InvokeReal( ( ) - > model. Diameter / 2 ) ;
procedure SetIDP( r: real ) : = model. InnerDiameter : = r * 2 ;
procedure SetID( r: real ) : = Invoke( SetIDP, r) ;
function GetID: real : = InvokeReal( ( ) - > model. InnerDiameter / 2 ) ;
procedure SetHP( r: real ) : = model. Point2 : = P3D( 0 , 0 , r) ;
procedure SetH( r: real ) : = Invoke( SetHP, r) ;
function GetH: real : = InvokeReal( ( ) - > model. Point2. Z) ;
protected
function CreateObject: Object3D; override : = new PipeT( X, Y, Z, Height, Radius, InnerRadius, Material) ;
constructor( x, y, z, h, r, ir: real ; m: GMaterial) ;
begin
var a : = new PipeVisual3D;
a. Diameter : = r * 2 ;
a. InnerDiameter : = ir * 2 ;
a. Point1 : = P3D( 0 , 0 , 0 ) ;
a. Point2 : = P3D( 0 , 0 , h) ;
CreateBase( a, x, y, z, m) ;
end ;
public
/// Радиус трубы
property Radius: real read GetD write SetD;
/// Внутренний радиус трубы
property InnerRadius: real read GetID write SetID;
/// Высота трубы
property Height: real read GetH write SetH;
/// Возвращает клон трубы
function Clone : = ( inherited Clone) as PipeT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс LegoT # Graph3D LegoT class
// -----------------------------------------------------
/// Класс лего-детали
LegoT = class( ObjectWithMaterial3D)
private
//function model := inherited model as LegoVisual3D;
procedure SetWP( r: integer ) ;
procedure SetW( r: integer ) ;
function GetW: integer ;
procedure SetHP( r: integer ) ;
procedure SetH( r: integer ) ;
function GetH: integer ;
procedure SetLP( r: integer ) ;
procedure SetL( r: integer ) ;
function GetL: integer ;
{ procedure SetSzP( r: Size3D) ;
begin
var mmm : = model as LegoVisual3D;
( mmm. Columns, mmm. Rows, mmm. Height) : = ( r. X, r. Y, r. Z) ;
end ;
procedure SetSz( r: Size3D) : = Invoke( SetSzP, r) ;
function GetSz: Size3D : = Invoke& < Size3D> ( ( ) - > begin var mmm : = model as LegoVisual3D; Result : = Sz3D( mmm. Length , mmm. Width, mmm. Height) end ) ; }
protected
function CreateObject: Object3D; override : = new LegoT( X, Y, Z, Columns, Rows, Height, Material) ;
public
constructor( x, y, z: real ; Rows, Columns, Height: integer ; m: GMaterial) ;
/// Количество кирпичиков лего-детали по оси X
property Columns: integer read GetL write SetL;
/// Количество кирпичиков лего-детали по оси Y
property Rows: integer read GetW write SetW;
/// Высота лего-детали, измеряемая в количестве деталей одинарной высоты
property Height: integer read GetH write SetH;
{property Size: Size3D read GetSz write SetSz;}
/// Возвращает клон лего-детали
function Clone : = ( inherited Clone) as LegoT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс PlatonicAbstractT # Graph3D PlatonicAbstractT class
// -----------------------------------------------------
/// Абстрактный класс платоновых тел
PlatonicAbstractT = class( ObjectWithMaterial3D)
private
function GetLength: real ;
procedure SetLengthP( r: real ) ;
public
/// Длина грани
property Length : real read GetLength write Invoke( SetLengthP, value) ;
end ;
// -----------------------------------------------------
//>> Graph3D: класс IcosahedronT # Graph3D IcosahedronT class
// -----------------------------------------------------
/// Класс икосаэдра
IcosahedronT = class( PlatonicAbstractT)
protected
function CreateObject: Object3D; override : = new IcosahedronT( X, Y, Z, Length , Material) ;
public
constructor( x, y, z, Length : real ; m: GMaterial) ;
/// Возвращает клон икосаэдра
function Clone : = ( inherited Clone) as IcosahedronT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс DodecahedronT # Graph3D DodecahedronT class
// -----------------------------------------------------
/// Класс додекаэдра
DodecahedronT = class( PlatonicAbstractT)
protected
function CreateObject: Object3D; override : = new DodecahedronT( X, Y, Z, Length , Material) ;
public
constructor( x, y, z, Length : real ; m: GMaterial) ;
/// Возвращает клон додекаэдра
function Clone : = ( inherited Clone) as DodecahedronT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс TetrahedronT # Graph3D TetrahedronT class
// -----------------------------------------------------
/// Класс тетраэдра
TetrahedronT = class( PlatonicAbstractT)
protected
function CreateObject: Object3D; override : = new TetrahedronT( X, Y, Z, Length , Material) ;
public
constructor( x, y, z, Length : real ; m: GMaterial) ;
/// Возвращает клон тетраэдра
function Clone : = ( inherited Clone) as TetrahedronT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс OctahedronT # Graph3D OctahedronT class
// -----------------------------------------------------
/// Класс октаэдра
OctahedronT = class( PlatonicAbstractT)
protected
function CreateObject: Object3D; override : = new OctahedronT( X, Y, Z, Length , Material) ;
public
constructor( x, y, z, Length : real ; m: GMaterial) ;
/// Возвращает клон октаэдра
function Clone : = ( inherited Clone) as OctahedronT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс TriangleT # Graph3D TriangleT class
// -----------------------------------------------------
/// Класс 3D-треугольника
TriangleT = class( ObjectWithMaterial3D)
protected
procedure SetP1( p: Point3D) ;
function GetP1: Point3D;
procedure SetP2( p: Point3D) ;
function GetP2: Point3D;
procedure SetP3( p: Point3D) ;
function GetP3: Point3D;
function CreateObject: Object3D; override ;
public
constructor( p1, p2, p3: Point3D; m: Gmaterial) ;
/// Первая точка 3D-треугольника
property P1: Point3D read GetP1 write SetP1;
/// Вторая точка 3D-треугольника
property P2: Point3D read GetP2 write SetP2;
/// Третья точка 3D-треугольника
property P3: Point3D read GetP3 write SetP3;
/// Устанавливает точки 3D-треугольника
procedure SetPoints( p1, p2, p3: Point3D) ;
end ;
// -----------------------------------------------------
//>> Graph3D: класс PrismT # Graph3D PrismT class
// -----------------------------------------------------
/// Класс правильной призмы
PrismT = class( ObjectWithMaterial3D)
private
procedure SetR( r: real ) ;
function GetR: real ;
procedure SetH( r: real ) ;
function GetH: real ;
procedure SetN( n: integer ) ;
function GetN: integer ;
protected
function CreateObject: Object3D; override : = new PrismT( X, Y, Z, N, Radius, Height, Material. Clone) ;
public
constructor( x, y, z: real ; N: integer ; r, h: real ; m: Gmaterial) ;
/// Радиус правильной призмы
property Radius: real read GetR write SetR;
/// Высота правильной призмы
property Height: real read GetH write SetH;
/// Количество углов правильной призмы
property N: integer read GetN write SetN;
/// Возвращает клон правильной призмы
function Clone : = ( inherited Clone) as PrismT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс PyramidT # Graph3D PyramidT class
// -----------------------------------------------------
/// Класс правильной пирамиды
PyramidT = class( PrismT)
private
protected
function CreateObject: Object3D; override : = new PyramidT( X, Y, Z, N, Radius, Height, Material. Clone) ;
public
constructor( x, y, z: real ; N: integer ; r, h: real ; m: GMaterial) ;
/// Радиус правильной пирамиды
property Radius: real read GetR write SetR;
/// Высота правильной пирамиды
property Height: real read GetH write SetH;
/// Количество углов правильной пирамиды
property N: integer read GetN write SetN;
/// Возвращает клон правильной пирамиды
function Clone : = ( inherited Clone) as PyramidT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс PrismTWireframe # Graph3D PrismTWireframe class
// -----------------------------------------------------
/// Класс проволочной правильной призмы
PrismTWireframe = class( ObjectWithChildren3D)
private
fn: integer ;
fh, fr: real ;
function Model : = inherited model as LinesVisual3D;
procedure SetCP( c: GColor) : = ( model as LinesVisual3D) . Color : = c;
procedure SetC( c: GColor) : = Invoke( SetCP, c) ;
function GetC: GColor : = Invoke& < GColor> ( ( ) - > ( model as LinesVisual3D) . Color) ;
procedure SetTP( th: real ) : = ( model as LinesVisual3D) . Thickness : = th;
procedure SetT( th: real ) : = Invoke( SetTP, th) ;
function GetT: real : = InvokeReal( ( ) - > ( model as LinesVisual3D) . Thickness) ;
procedure SetRP( value: real ) ;
begin
if fr = value then
exit;
fr : = value;
( model as LinesVisual3D) . Points : = CreatePoints;
end ;
procedure SetR( value: real ) : = Invoke( SetRP, value) ;
procedure SetHP( value: real ) ;
begin
if fh = value then
exit;
fh : = value;
( model as LinesVisual3D) . Points : = CreatePoints;
end ;
procedure SetH( value: real ) : = Invoke( SetHP, value) ;
procedure SetNP( value: integer ) ;
begin
if fN = value then
exit;
fN : = value;
( model as LinesVisual3D) . Points : = CreatePoints;
end ;
procedure SetN( value: integer ) : = Invoke( SetNP, value) ;
function CreatePoints: Point3DCollection; virtual ;
begin
var pc : = new Point3DCollection;
2018-11-19 02:48:19 +03:00
var a : = PartitionPoints( 0 , 2 * Pi, N) . Select( x - > P3D( fr * cos( x) , fr * sin( x) , 0 ) ) . ToArray;
var b : = PartitionPoints( 0 , 2 * Pi, N) . Select( x - > P3D( fr * cos( x) , fr * sin( x) , fh) ) . ToArray;
2018-11-08 00:24:28 +03:00
for var i : = 0 to a. High - 1 do
begin
pc. Add( a[ i] ) ;
pc. Add( b[ i] ) ;
end ;
for var i : = 0 to a. High - 1 do
begin
pc. Add( a[ i] ) ;
pc. Add( a[ i + 1 ] ) ;
end ;
for var i : = 0 to a. High - 1 do
begin
pc. Add( b[ i] ) ;
pc. Add( b[ i + 1 ] ) ;
end ;
Result : = pc;
end ;
function NewVisualObject( N: integer ; Radius, Height: real ; Thickness: real ; c: GColor) : LinesVisual3D;
begin
( fn, fr, fh) : = ( n, Radius, Height) ;
var ls : = new LinesVisual3D;
ls. Thickness : = Thickness;
ls. Color : = c;
ls. Points : = CreatePoints;
Result : = ls;
end ;
protected
function CreateObject: Object3D; override : = new PrismTWireframe( X, Y, Z, N, Radius, Height, ( model as LinesVisual3D) . Thickness, ( model as LinesVisual3D) . Color) ;
public
function Points: Point3DCollection; virtual ;
begin
2018-11-19 02:48:19 +03:00
var a : = PartitionPoints( 0 , 2 * Pi, N) . Select( x - > P3D( fr * cos( x) , fr * sin( x) , 0 ) ) . SkipLast;
var b : = PartitionPoints( 0 , 2 * Pi, N) . Select( x - > P3D( fr * cos( x) , fr * sin( x) , fh) ) . SkipLast;
2018-11-08 00:24:28 +03:00
var pc : = new Point3DCollection( a + b) ;
Result : = pc;
end ;
constructor( x, y, z: real ; N: integer ; Radius, Height: real ; Thickness: real ; c: GColor) : =
CreateBase0( NewVisualObject( N, Radius, Height, Thickness, c) , x, y, z) ;
/// Радиус проволочной правильной призмы
property Radius: real read fr write SetR;
/// Высота проволочной правильной призмы
property Height: real read fh write SetH;
/// Количество углов проволочной правильной призмы
property N: integer read fn write SetN;
/// Цвет проволоки правильной призмы
property Color: GColor read GetC write SetC; override ;
/// Толщина проволоки правильной призмы
property Thickness: real read GetT write SetT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс PyramidTWireframe # Graph3D PyramidTWireframe class
// -----------------------------------------------------
/// Класс проволочной правильной пирамиды
PyramidTWireframe = class( PrismTWireframe)
protected
function CreateObject: Object3D; override : = new PyramidTWireframe( X, Y, Z, N, Radius, Height, ( model as LinesVisual3D) . Thickness, ( model as LinesVisual3D) . Color) ;
private
function CreatePoints: Point3DCollection; override ;
begin
var pc : = new Point3DCollection;
2018-11-19 02:48:19 +03:00
var a : = PartitionPoints( 0 , 2 * Pi, N) . Select( x - > P3D( fr * cos( x) , fr * sin( x) , 0 ) ) . ToArray;
2018-11-08 00:24:28 +03:00
var b : = P3D( 0 , 0 , fh) ;
for var i : = 0 to a. High - 1 do
begin
pc. Add( a[ i] ) ;
pc. Add( b) ;
end ;
for var i : = 0 to a. High - 1 do
begin
pc. Add( a[ i] ) ;
pc. Add( a[ i + 1 ] ) ;
end ;
Result : = pc;
end ;
public
/// Радиус проволочной правильной пирамиды
property Radius: real read fr write SetR;
/// Высота проволочной правильной пирамиды
property Height: real read fh write SetH;
/// Количество углов проволочной правильной пирамиды
property N: integer read fn write SetN;
/// Цвет проволоки правильной пирамиды
property Color: GColor read GetC write SetC; override ;
/// Толщина проволоки правильной пирамиды
property Thickness: real read GetT write SetT;
end ;
P3DArray = array of Point3D;
//P3DList = List<Point3D>;
// -----------------------------------------------------
//>> Graph3D: класс SegmentsT # Graph3D SegmentsT class
// -----------------------------------------------------
/// Класс Н а б о р 3D-отрезков
SegmentsT = class( ObjectWithChildren3D)
private
function Model : = inherited model as LinesVisual3D;
function GetTP: real : = Model. Thickness;
function GetT: real : = InvokeReal( GetTP) ;
procedure SetT( t: real ) : = Invoke( procedure( t: real ) - > Model. Thickness : = t, t) ;
function GetCP: GColor : = Model. Color;
function GetC: GColor : = Invoke& < GColor> ( GetCP) ;
procedure SetC( t: GColor) : = Invoke( procedure( t: GColor) - > Model. Color : = t, t) ;
function GetPP: array of Point3D : = Model. Points. ToArray;
function GetP: array of Point3D; virtual : = Invoke& < array of Point3D> ( GetPP) ;
procedure SetPP( pp: array of Point3D) : = Model. Points : = new Point3DCollection( pp) ;
procedure SetP( pp: array of Point3D) : = Invoke( SetPP, pp) ;
protected
function CreateObject: Object3D; override : = new SegmentsT( Points, Thickness, Color) ;
public
constructor( points: sequence of Point3D; thickness: real ; c: GColor) ;
begin
var l : = new LinesVisual3D;
l. Thickness : = thickness;
l. Color : = c;
l. Points : = new Point3DCollection( points) ;
CreateBase0( l, 0 , 0 , 0 ) ;
end ;
/// Толщина 3D-отрезков
property Thickness: real read GetT write SetT;
/// Цвет 3D-отрезков
property Color: GColor read GetC write SetC; override ;
/// Точки 3D-отрезков
property Points: array of Point3D read GetP write SetP;
/// Возвращает клон 3D-отрезков
function Clone : = ( inherited Clone) as SegmentsT;
end ;
// -----------------------------------------------------
//>> Graph3D: класс TorusT # Graph3D TorusT class
// -----------------------------------------------------
/// Класс Т о р (бублик)
TorusT = class( ObjectWithMaterial3D)
private
procedure SetD( d: real ) : = Invoke( procedure( d: real ) - > ( model as TorusVisual3D) . TorusDiameter : = d, d) ;
function GetD: real : = InvokeReal( ( ) - > ( model as TorusVisual3D) . TorusDiameter) ;
procedure SetTD( d: real ) : = Invoke( procedure( d: real ) - > ( model as TorusVisual3D) . TubeDiameter : = d, d) ;
function GetTD: real : = InvokeReal( ( ) - > ( model as TorusVisual3D) . TubeDiameter) ;
protected
function CreateObject: Object3D; override : = new TorusT( X, Y, Z, Diameter, TubeDiameter, Material. Clone) ;
public
constructor( x, y, z: real ; Diameter, TubeDiameter: real ; m: Gmaterial) ;
begin
var t : = new TorusVisual3D;
t. TorusDiameter : = Diameter;
t. TubeDiameter : = TubeDiameter;
CreateBase( t, x, y, z, m) ;
end ;
/// Диаметр тора
property Diameter: real read GetD write SetD;
/// Диаметр трубы тора
property TubeDiameter: real read GetTD write SetTD;
/// Возвращает клон тора
function Clone : = ( inherited Clone) as PrismT;
end ;
// -----------------------------------------------------
//>> Graph3D: сервисные функции # Graph3D service functions
// -----------------------------------------------------
/// Возвращает материал по умолчанию
function DefaultMaterial: Material;
/// Возвращает пустую группу объектов в точке (x, y, z)
function Group( x, y, z: integer ) : Group3D;
/// Возвращает пустую группу объектов в точке p
function Group( p: Point3D) : Group3D;
/// Возвращает пустую группу объектов в точке (0, 0, 0)
function Group: Group3D;
/// Возвращает группу объектов, перечисленных как параметры
function Group( params lst: array of Object3D) : Group3D;
/// Возвращает группу объектов из последовательности en
function Group( en: sequence of Object3D) : Group3D;
// -----------------------------------------------------
//>> Graph3D: функции для создания 3D-объектов # Graph3D functions for creation 3D-objects
// -----------------------------------------------------
/// Возвращает сферу с центром в точке (x, y, z) радиуса Radius
function Sphere( x, y, z, Radius: real ; m: Material : = DefaultMaterial) : SphereT;
/// Возвращает сферу с центром в точке center радиуса Radius
function Sphere( center: Point3D; Radius: real ; m: Material : = DefaultMaterial) : SphereT;
/// Возвращает эллипсоид с центром в точке (x, y, z) и радиусами RadiusX, RadiusY, RadiusZ
function Ellipsoid( x, y, z, RadiusX, RadiusY, RadiusZ: real ; m: Material : = DefaultMaterial) : EllipsoidT;
/// Возвращает эллипсоид с центром в точке center и радиусами RadiusX, RadiusY, RadiusZ
function Ellipsoid( center: Point3D; RadiusX, RadiusY, RadiusZ: real ; m: Material : = DefaultMaterial) : EllipsoidT;
/// Возвращает эллипсоид с центром в точке (x, y, z) и длиной стороны SideLength
function Cube( x, y, z, SideLength: real ; m: Material : = DefaultMaterial) : CubeT;
/// Возвращает эллипсоид с центром в точке center и длиной стороны SideLength
function Cube( center: Point3D; SideLength: real ; m: Material : = DefaultMaterial) : CubeT;
/// Возвращает паралеллепипед с центром в точке (x, y, z) и размерами SizeX, SizeY, SizeZ
function Box( x, y, z, SizeX, SizeY, SizeZ: real ; m: Material : = DefaultMaterial) : BoxT;
/// Возвращает паралеллепипед с центром в точке center и размерами SizeX, SizeY, SizeZ
function Box( center: Point3D; sz: Size3D; m: Material : = DefaultMaterial) : BoxT;
/// Возвращает 3D-стрелку с центром в точке (x, y, z), направлением (vx, vy, vz), диаметра Diameter и длиной наконечника HeadLength
function Arrow( x, y, z, vx, vy, vz, Diameter, HeadLength: real ; m: Material : = DefaultMaterial) : ArrowT;
/// Возвращает 3D-стрелку с центром в точке (x, y, z), направлением (vx, vy, vz), диаметра Diameter
function Arrow( x, y, z, vx, vy, vz, Diameter: real ; m: Material : = DefaultMaterial) : ArrowT;
/// Возвращает 3D-стрелку с центром в точке (x, y, z), направлением (vx, vy, vz)
function Arrow( x, y, z, vx, vy, vz: real ; m: Material : = DefaultMaterial) : ArrowT;
/// Возвращает 3D-стрелку с центром в точке p, направлением p, диаметра Diameter и длиной наконечника HeadLength
function Arrow( p: Point3D; v: Vector3D; Diameter, HeadLength: real ; m: Material : = DefaultMaterial) : ArrowT;
/// Возвращает 3D-стрелку с центром в точке p, направлением p, диаметра Diameter
function Arrow( p: Point3D; v: Vector3D; Diameter: real ; m: Material : = DefaultMaterial) : ArrowT;
/// Возвращает 3D-стрелку с центром в точке p, направлением p
function Arrow( p: Point3D; v: Vector3D; m: Material : = DefaultMaterial) : ArrowT;
///--
function TruncatedCone( x, y, z, Height, Radius, TopRadius: real ; topcap: boolean ; m: Material : = DefaultMaterial) : TruncatedConeT;
/// Возвращает усеченный конус с центром основания в точке (x, y, z) высоты Height, радиуса основания Radius, верхнего радиуса TopRadius
function TruncatedCone( x, y, z, Height, Radius, TopRadius: real ; m: Material : = DefaultMaterial) : TruncatedConeT;
///--
function TruncatedCone( p: Point3D; Height, Radius, TopRadius: real ; topcap: boolean ; m: Material : = DefaultMaterial) : TruncatedConeT;
/// Возвращает усеченный конус с центром основания в точке p высоты Height, радиуса основания Radius, верхнего радиуса TopRadius
function TruncatedCone( p: Point3D; Height, Radius, TopRadius: real ; m: Material : = DefaultMaterial) : TruncatedConeT;
///--
function Cylinder( x, y, z, Height, Radius: real ; topcap: boolean ; m: Material : = DefaultMaterial) : CylinderT;
/// Возвращает цилиндр с центром основания в точке (x, y, z) высоты Height радиуса Radius
function Cylinder( x, y, z, Height, Radius: real ; m: Material : = DefaultMaterial) : CylinderT;
///--
function Cylinder( p: Point3D; Height, Radius: real ; topcap: boolean ; m: Material : = DefaultMaterial) : CylinderT;
/// Возвращает цилиндр с центром основания в точке p высоты Height радиуса Radius
function Cylinder( p: Point3D; Height, Radius: real ; m: Material : = DefaultMaterial) : CylinderT;
/// Возвращает трубу с центром основания в точке (x, y, z) высотой Height, радиусом Radius и внутренним радиусом InnerRadius
function Tube( x, y, z, Height, Radius, InnerRadius: real ; m: Material : = DefaultMaterial) : PipeT;
/// Возвращает трубу с центром основания в точке p высотой Height, радиусом Radius и внутренним радиусом InnerRadius
function Tube( p: Point3D; Height, Radius, InnerRadius: real ; m: Material : = DefaultMaterial) : PipeT;
/// Возвращает конус с центром основания в точке (x, y, z) высотой Height, радиусом Radius
function Cone( x, y, z, Height, Radius: real ; m: Material : = DefaultMaterial) : TruncatedConeT;
/// Возвращает конус с центром основания в точке p высотой Height, радиусом Radius
function Cone( p: Point3D; Height, Radius: real ; m: Material : = DefaultMaterial) : TruncatedConeT;
/// Возвращает чайник с центром в точке (x, y, z)
function Teapot( x, y, z: real ; c: Material : = DefaultMaterial) : TeapotT;
/// Возвращает чайник с центром в точке p
function Teapot( p: Point3D; c: Material : = DefaultMaterial) : TeapotT;
/// Возвращает текст на билборде с центром в точке (x, y, z) с размером шрифта Fontsize
function BillboardText( x, y, z: real ; Text : string ; Fontsize: real : = 1 2 ) : BillboardTextT;
/// Возвращает текст на билборде с центром в точке p с размером шрифта Fontsize
function BillboardText( p: Point3D; Text : string ; Fontsize: real : = 1 2 ) : BillboardTextT;
/// Возвращает координатную систему с длиной стрелок ArrowsLength и диаметром стрелок Diameter
function CoordinateSystem( ArrowsLength, Diameter: real ) : CoordinateSystemT;
/// Возвращает координатную систему с длиной стрелок ArrowsLength
function CoordinateSystem( ArrowsLength: real ) : CoordinateSystemT;
/// Возвращает 3D-текст с центром в точке (x, y, z) с высотой Height, именем шрифта FontName заданного цвета
function Text3D( x, y, z: real ; Text : string ; Height: real ; FontName: string : = 'Arial' ; c: Color : = Colors. Black) : TextT;
/// Возвращает 3D-текст с центром в точке p с высотой Height, именем шрифта FontName заданного цвета
function Text3D( p: Point3D; Text : string ; Height: real ; FontName: string : = 'Arial' ; c: Color : = Colors. Black) : TextT;
/// Возвращает 3D-текст с центром в точке (x, y, z) с высотой Height заданного цвета
function Text3D( x, y, z: real ; Text : string ; Height: real ; c: Color) : TextT;
/// Возвращает 3D-текст с центром в точке p с высотой Height заданного цвета
function Text3D( p: Point3D; Text : string ; Height: real ; c: Color) : TextT;
/// Возвращает 3D-прямоугольник с центром в точке (x, y, z) длины Length, ширины Width, нормалью Normal и направлением длины LengthDirection
function Rectangle3D( x, y, z, Length , Width: real ; Normal, LengthDirection: Vector3D; m: Material : = DefaultMaterial) : RectangleT;
/// Возвращает 3D-прямоугольник с центром в точке p длины Length, ширины Width, нормалью Normal и направлением длины LengthDirection
function Rectangle3D( p: Point3D; Length , Width: real ; Normal, LengthDirection: Vector3D; m: Material : = DefaultMaterial) : RectangleT;
/// Возвращает 3D-прямоугольник с центром в точке (x, y, z) длины Length, ширины Width, нормалью Normal
function Rectangle3D( x, y, z, Length , Width: real ; Normal: Vector3D; m: Material : = DefaultMaterial) : RectangleT;
/// Возвращает 3D-прямоугольник с центром в точке (x, y, z) длины Length, ширины Width
function Rectangle3D( x, y, z, Length , Width: real ; m: Material : = DefaultMaterial) : RectangleT;
/// Возвращает 3D-прямоугольник с центром в точке p длины Length, ширины Width, нормалью Normal
function Rectangle3D( p: Point3D; Length , Width: real ; Normal: Vector3D; m: Material : = DefaultMaterial) : RectangleT;
/// Возвращает 3D-прямоугольник с центром в точке p длины Length, ширины Width
function Rectangle3D( p: Point3D; Length , Width: real ; m: Material : = DefaultMaterial) : RectangleT;
/// Загружает модель из файла в форматах .obj, .3ds, .lwo, .objz, .stl, .off и отображает е е в точке (x, y, z)
function FileModel3D( x, y, z: real ; fname: string ; m: Material) : FileModelT;
/// Загружает модель из файла в форматах .obj, .3ds, .lwo, .objz, .stl, .off и отображает е е в точке p
function FileModel3D( p: Point3D; fname: string ; m: Material) : FileModelT;
/// Возвращает правильную призму с центром основания в точке (x, y, z), количеством сторон Sides, высотой Height и радиусом Radius
function Prism( x, y, z: real ; Sides: integer ; Height, Radius: real ; m: Material : = DefaultMaterial) : PrismT;
/// Возвращает правильную призму с центром основания в точке p, количеством сторон Sides, высотой Height и радиусом Radius
function Prism( p: Point3D; Sides: integer ; Height, Radius: real ; m: Material : = DefaultMaterial) : PrismT;
/// Возвращает проволочную правильную призму с центром основания в точке (x, y, z), количеством сторон Sides, высотой Height, радиусом Radius и толщиной проволоки Thickness
function PrismWireFrame( x, y, z: real ; Sides: integer ; Height, Radius: real ; Thickness: real : = 1.2 ; c: Color : = GrayColor( 6 4 ) ) : PrismTWireFrame;
/// Возвращает проволочную правильную призму с центром основания в точке p, количеством сторон Sides, высотой Height, радиусом Radius и толщиной проволоки Thickness
function PrismWireFrame( p: Point3D; Sides: integer ; Height, Radius: real ; Thickness: real : = 1.2 ; c: Color : = GrayColor( 6 4 ) ) : PrismTWireFrame;
/// Возвращает правильную пирамиду с центром основания в точке (x, y, z), количеством сторон Sides, высотой Height и радиусом Radius
function Pyramid( x, y, z: real ; Sides: integer ; Height, Radius: real ; m: Material : = DefaultMaterial) : PyramidT;
/// Возвращает правильную пирамиду с центром основания в точке p, количеством сторон Sides, высотой Height и радиусом Radius
function Pyramid( p: Point3D; Sides: integer ; Height, Radius: real ; m: Material : = DefaultMaterial) : PyramidT;
/// Возвращает проволочную правильную пирамиду с центром основания в точке (x, y, z), количеством сторон Sides, высотой Height и радиусом Radius
function PyramidWireFrame( x, y, z: real ; Sides: integer ; Height, Radius: real ; Thickness: real : = 1.2 ; c: Color : = GrayColor( 6 4 ) ) : PyramidTWireFrame;
/// Возвращает проволочную правильную пирамиду с центром основания в точке p, количеством сторон Sides, высотой Height и радиусом Radius
function PyramidWireFrame( p: Point3D; Sides: integer ; Height, Radius: real ; Thickness: real : = 1.2 ; c: Color : = GrayColor( 6 4 ) ) : PyramidTWireFrame;
/// Возвращает лего-деталь с центром в точке (x, y, z), размера (Rows, Columns, Height), измеряемом в количестве кирпичиков по каждой размерности
function Lego( x, y, z: real ; Rows, Columns, Height: integer ; m: Material : = DefaultMaterial) : LegoT;
/// Возвращает икосаэдр с центром в точке (x, y, z) и радиусом описанной окружности Radius
function Icosahedron( x, y, z, Radius: real ; m: Material : = DefaultMaterial) : IcosahedronT;
/// Возвращает додекаэдр с центром в точке (x, y, z) и радиусом описанной окружности Radius
function Dodecahedron( x, y, z, Radius: real ; m: Material : = DefaultMaterial) : DodecahedronT;
/// Возвращает тетраэдр с центром в точке (x, y, z) и радиусом описанной окружности Radius
function Tetrahedron( x, y, z, Radius: real ; m: Material : = DefaultMaterial) : TetrahedronT;
/// Возвращает октаэдр с центром в точке (x, y, z) и радиусом описанной окружности Radius
function Octahedron( x, y, z, Radius: real ; m: Material : = DefaultMaterial) : OctahedronT;
/// Возвращает икосаэдр с центром в точке p и радиусом описанной окружности Radius
function Icosahedron( p: Point3D; Radius: real ; m: Material : = DefaultMaterial) : IcosahedronT;
/// Возвращает додекаэдр с центром в точке p и радиусом описанной окружности Radius
function Dodecahedron( p: Point3D; Radius: real ; m: Material : = DefaultMaterial) : DodecahedronT;
/// Возвращает тетраэдр с центром в точке p и радиусом описанной окружности Radius
function Tetrahedron( p: Point3D; Radius: real ; m: Material : = DefaultMaterial) : TetrahedronT;
/// Возвращает октаэдр с центром в точке p и радиусом описанной окружности Radius
function Octahedron( p: Point3D; Radius: real ; m: Material : = DefaultMaterial) : OctahedronT;
/// Возвращает набор отрезков, задаваемых последовательностью точек points, толщиной Thickness, заданного цвета. Количество точек должно быть четным
function Segments3D( points: sequence of Point3D; Thickness: real : = 1.2 ; c: Color : = GrayColor( 6 4 ) ) : SegmentsT;
/// Возвращает ломаную, задаваемую последовательностью точек points, толщиной Thickness, заданного цвета
function Polyline3D( points: sequence of Point3D; Thickness: real : = 1.2 ; c: Color : = GrayColor( 6 4 ) ) : SegmentsT;
/// Возвращает замкнутую ломаную, задаваемую последовательностью точек points, толщиной Thickness, заданного цвета
function Polygon3D( points: sequence of Point3D; Thickness: real : = 1.2 ; c: Color : = GrayColor( 6 4 ) ) : SegmentsT;
/// Возвращает отрезок из точки p1 в точку p2 толщиной Thickness заданного цвета
function Segment3D( p1, p2: Point3D; Thickness: real : = 1.2 ; c: Color : = GrayColor( 6 4 ) ) : SegmentsT;
/// Возвращает тор (бублик) с центром в точке (x, y, z), диаметром Diameter и диаметром трубы TubeDiameter
function Torus( x, y, z, Diameter, TubeDiameter: real ; m: Material : = DefaultMaterial) : TorusT;
/// Возвращает тор (бублик) с центром в точке p, диаметром Diameter и диаметром трубы TubeDiameter
function Torus( p: Point3D; Diameter, TubeDiameter: real ; m: Material : = DefaultMaterial) : TorusT;
/// Возвращает треугольник, соединяющий точки p1, p2, p3
function Triangle( p1, p2, p3: Point3D; m: Material : = DefaultMaterial) : TriangleT;
// Конец примитивов
//------------------------------------------------------------------------------------
// -----------------------------------------------------
//>> Graph3D: функции для создания невизуальных объектов # Graph3D functions for creation non-visual objects
// -----------------------------------------------------
/// Возвращает невизуальную плоскость, проходящую через точку p и имеющую нормаль Normal
function Plane( p: Point3D; Normal: Vector3D) : Plane3D;
/// Возвращает невизуальный луч, проходящий через точку p в направлении вектора v
function Ray( p: Point3D; v: Vector3D) : Ray3D;
/// Возвращает невизуальную прямую, проходящую через точку p в направлении вектора v
function Line( p: Point3D; v: Vector3D) : Line3D;
/// Возвращает невизуальную прямую, проходящую через точки p1 и p2
function Line( p1, p2: Point3D) : Line3D;
/// Возвращает невизуальный луч, выпущенный из камеры и проходящий через точку (x,y) экрана
function GetRay( x, y: real ) : Ray3D;
/// Создает пустую анимацию заданной длительности
function EmptyAnim( sec: real ) : EmptyAnimation;
// -----------------------------------------------------
//>> Graph3D: функции для определения ближайших точек и объектов # Graph3D functions for nearest points and objects
// -----------------------------------------------------
/// Возвращает ближайший 3D-объект, который пересекает луч, выпущенный из камеры и проходящий через точку (x,y) экрана
function FindNearestObject( x, y: real ) : Object3D;
/// Возвращает точку на ближайшем 3D-объекте, который пересекает луч, выпущенный из камеры и проходящий через точку (x,y) экрана. Если пересечения нет, возвращается точка BadPoint
function FindNearestObjectPoint( x, y: real ) : Point3D;
/// Возвращает точку на плоскости Plane, которую пересекает невизуальный луч, выпущенный из камеры и проходящий через точку (x,y) экрана
function PointOnPlane( Plane: Plane3D; x, y: real ) : Point3D;
/// Возвращает ближайшую точку на линии Line с лучом, выпущенным из камеры и проходящем через точку (x,y) экрана
function NearestPointOnLine( Line: Ray3D; x, y: real ) : Point3D;
var
// -----------------------------------------------------
//>> События модуля Graph3D # Graph3D events
// -----------------------------------------------------
/// Событие нажатия на кнопку мыши. (x,y) - координаты курсора мыши в момент наступления события, mousebutton = 1, если нажата левая кнопка мыши, и 2, если нажата правая кнопка мыши
OnMouseDown: procedure( x, y: real ; mousebutton: integer ) ;
/// Событие отжатия кнопки мыши. (x,y) - координаты курсора мыши в момент наступления события, mousebutton = 1, если отжата левая кнопка мыши, и 2, если отжата правая кнопка мыши
OnMouseUp: procedure( x, y: real ; mousebutton: integer ) ;
/// Событие перемещения мыши. (x,y) - координаты курсора мыши в момент наступления события, mousebutton = 0, если кнопка мыши не нажата, 1, если нажата левая кнопка мыши, и 2, если нажата правая кнопка мыши
OnMouseMove: procedure( x, y: real ; mousebutton: integer ) ;
/// Событие нажатия клавиши
OnKeyDown: procedure( k: Key) ;
/// Событие отжатия клавиши
OnKeyUp: procedure( k: Key) ;
2018-12-22 12:56:57 +03:00
/// Событие нажатия символьной клавиши
OnKeyPress: procedure( ch: char ) ;
2018-11-08 00:24:28 +03:00
var
// -----------------------------------------------------
//>> Переменные модуля Graph3D # Graph3D variables
// -----------------------------------------------------
/// Пространство отображения
View3D: View3DType;
/// Графическое окно
Window: WindowType;
/// Камера
Camera: CameraType;
/// Источники света
Lights: LightsType;
/// Координатная сетка
GridLines: GridLinesType;
/// Список 3D-объектов
Object3DList : = new List< Object3D> ;
/// Орт (единичный вектор) оси OX
OrtX: Vector3D : = V3D( 1 , 0 , 0 ) ;
/// Орт (единичный вектор) оси OY
OrtY: Vector3D : = V3D( 0 , 1 , 0 ) ;
/// Орт (единичный вектор) оси OZ
OrtZ: Vector3D : = V3D( 0 , 0 , 1 ) ;
/// Точка начала координат
Origin: Point3D : = P3D( 0 , 0 , 0 ) ;
/// Плоскость OXY
PlaneXY: Plane3D : = Plane( Origin, OrtZ) ;
/// Плоскость OYZ
PlaneYZ: Plane3D : = Plane( Origin, OrtX) ;
/// Плоскость OXZ
PlaneXZ: Plane3D : = Plane( Origin, OrtY) ;
/// Ось OX
XAxis: Ray3D : = Ray( Origin, OrtX) ;
/// Ось OY
YAxis: Ray3D : = Ray( Origin, OrtY) ;
/// Ось OZ
ZAxis: Ray3D : = Ray( Origin, OrtZ) ;
/// Плохая точка (возвращается в случае неуспеха функцией FindNearestObjectPoint)
BadPoint: Point3D : = P3D( real . MaxValue, real . MaxValue, real . MaxValue) ;
//{{{--doc: Конец секции 1 }}}
///--
procedure __InitModule__;
///--
procedure __FinalizeModule__;
implementation
2018-12-12 21:09:07 +03:00
procedure Invoke( p: ( ) - > ( ) ) : = GraphWPFBase. Invoke( p) ;
2018-11-08 00:24:28 +03:00
function RGB( r, g, b: byte ) : = Color. Fromrgb( r, g, b) ;
function ARGB( a, r, g, b: byte ) : = Color. FromArgb( a, r, g, b) ;
function P3D( x, y, z: real ) : = new Point3D( x, y, z) ;
function V3D( x, y, z: real ) : = new Vector3D( x, y, z) ;
function Sz3D( x, y, z: real ) : = new Size3D( x, y, z) ;
function Pnt( x, y: real ) : = new Point( x, y) ;
function Rect( x, y, w, h: real ) : = new System. Windows. Rect( x, y, w, h) ;
function RandomColor: Color : = RGB( Random( 2 5 6 ) , Random( 2 5 6 ) , Random( 2 5 6 ) ) ;
function EmptyColor: Color : = ARGB( 0 , 0 , 0 , 0 ) ;
function GrayColor( b: byte ) : Color : = RGB( b, b, b) ;
function RandomSolidBrush: SolidColorBrush : = new SolidColorBrush( RandomColor) ;
type
IMHelper = auto class
fname: string ;
M, N: real ;
function ImageMaterial: Material;
begin
//Result := MaterialHelper.CreateImageMaterial(fname)
var bi : = new System. Windows. Media. Imaging. BitmapImage( ) ;
bi. BeginInit( ) ;
bi. UriSource : = new System. Uri( fname, System. UriKind. Relative) ;
bi. EndInit( ) ;
var b : = new ImageBrush( bi) ;
b. Viewport : = Rect( 0 , 0 , M, N) ;
if ( M < > 1 ) or ( N < > 1 ) then
b. TileMode : = TileMode. Tile;
Result : = new GDiffuseMaterial( b) ;
end ;
end ;
DEMHelper = auto class
c: Color;
function Diffuse : = new GDiffuseMaterial( new SolidColorBrush( c) ) ;
function Emissive : = new GEmissiveMaterial( new SolidColorBrush( c) ) ;
end ;
SpMHelper = auto class
c: Color;
specularpower: real ;
function SpecularMaterial : = new System. Windows. Media. Media3D. SpecularMaterial( new SolidColorBrush( c) , specularpower) ;
end ;
function ImageMaterial( fname: string ; M, N: real ) : Material : = Invoke& < Material> ( IMHelper. Create( fname, M, N) . ImageMaterial) ;
function DiffuseMaterial( c: Color) : Material : = Invoke& < Material> ( DEMHelper. Create( c) . Diffuse) ;
function SpecularMaterial( specularBrightness: byte ; specularpower: real ) : Material : = Invoke& < Material> ( SpMHelper. Create( RGB( specularBrightness, specularBrightness, specularBrightness) , specularpower) . SpecularMaterial) ;
function SpecularMaterial( c: Color; specularpower: real ) : Material : = Invoke& < Material> ( SpMHelper. Create( c, specularpower) . SpecularMaterial) ;
function EmissiveMaterial( c: Color) : Material : = Invoke& < Material> ( DEMHelper. Create( c) . Emissive) ;
function RainbowMaterial: Material : = GMaterials. Rainbow;
//function wplus: real := SystemParameters.WindowResizeBorderThickness.Left + SystemParameters.WindowResizeBorderThickness.Right;
//function hplus: real := SystemParameters.WindowCaptionHeight + SystemParameters.WindowResizeBorderThickness.Top + SystemParameters.WindowResizeBorderThickness.Bottom;
function Object3D. AnimMoveTo( x, y, z, seconds: real ; Completed: procedure ) : = new OffsetAnimation( Self, seconds, x, y, z, Completed) ;
function Object3D. AnimMoveTrajectory( trajectory: sequence of Point3D; seconds: real ; Completed: procedure ) : = new OffsetAnimationUsingKeyframes( Self, seconds, trajectory, Completed) ;
function Object3D. AnimMoveOn( dx, dy, dz, seconds: real ; Completed: procedure ) : = new OffsetAnimationOn( Self, seconds, dx, dy, dz, Completed) ;
function Object3D. AnimScale( sc, seconds: real ; Completed: procedure ) : = new ScaleAnimation( Self, seconds, sc, Completed) ;
function Object3D. AnimScaleX( sc, seconds: real ; Completed: procedure ) : = new ScaleXAnimation( Self, seconds, sc, Completed) ;
function Object3D. AnimScaleY( sc, seconds: real ; Completed: procedure ) : = new ScaleYAnimation( Self, seconds, sc, Completed) ;
function Object3D. AnimScaleZ( sc, seconds: real ; Completed: procedure ) : = new ScaleZAnimation( Self, seconds, sc, Completed) ;
function Object3D. AnimRotate( vx, vy, vz, angle, seconds: real ; Completed: procedure ) : = new RotateAtAnimation( Self, seconds, vx, vy, vz, angle, P3D( 0 , 0 , 0 ) , Completed) ;
function Object3D. AnimRotateAt( axis: Vector3D; angle: real ; center: Point3D; seconds: real ; Completed: procedure ) : = new RotateAtAnimation( Self, seconds, axis. X, axis. y, axis. z, angle, center, Completed) ;
procedure Object3D. AddToObject3DList : = Object3DList. Add( Self) ;
procedure Object3D. DeleteFromObject3DList;
begin
var oc : = Self as ObjectWithChildren3D;
foreach var c in oc. l do
c. DeleteFromObject3DList;
Object3DList. Remove( Self)
end ;
function EmptyAnim( sec: real ) : = EmptyAnimation. Create( sec) ;
function AnimationBase. & Then( second: AnimationBase) : AnimationBase : = Animate. Sequence( Self, second) ;
//------------------------------ End Animation -------------------------------
type
LegoVisual3D = class( MeshElement3D)
private
public
class HeightProperty: DependencyProperty;
class RowsProperty: DependencyProperty;
class ColumnsProperty: DependencyProperty;
class DivisionsProperty: DependencyProperty;
private
procedure SetHeight( value: integer ) : = SetValue( HeightProperty, value) ;
function GetHeight : = integer( GetValue( HeightProperty) ) ;
procedure SetRows( value: integer ) : = SetValue( RowsProperty, value) ;
function GetRows : = integer( GetValue( RowsProperty) ) ;
procedure SetColumns( value: integer ) : = SetValue( ColumnsProperty, value) ;
function GetColumns : = integer( GetValue( ColumnsProperty) ) ;
procedure SetDivisions( value: integer ) : = SetValue( DivisionsProperty, value) ;
function GetDivisions : = integer( GetValue( DivisionsProperty) ) ;
class constructor ;
begin
HeightProperty : = DependencyProperty. Register( 'Height' , typeof( integer ) , typeof( LegoVisual3D) , new UIPropertyMetadata( 3 , GeometryChanged) ) ;
RowsProperty : = DependencyProperty. Register( 'Raws' , typeof( integer ) , typeof( LegoVisual3D) , new UIPropertyMetadata( 3 , GeometryChanged) ) ;
ColumnsProperty : = DependencyProperty. Register( 'Columns' , typeof( integer ) , typeof( LegoVisual3D) , new UIPropertyMetadata( 3 , GeometryChanged) ) ;
DivisionsProperty : = DependencyProperty. Register( 'Divisions' , typeof( integer ) , typeof( LegoVisual3D) , new UIPropertyMetadata( 4 8 ) ) ;
end ;
public
property Height: integer read GetHeight write SetHeight;
property Rows: integer read GetRows write SetRows;
property Columns: integer read GetColumns write SetColumns;
property Divisions: integer read GetDivisions write SetDivisions;
public
function Tessellate( ) : MeshGeometry3D; override ;
const
m = 1 / 0.008 ;
grid = 0.008 * m;
margin = 0.0001 * m;
wallThickness = 0.001 * m;
plateThickness = 0.0032 * m;
brickThickness = 0.0096 * m;
knobHeight = 0.0018 * m;
knobDiameter = 0.0048 * m;
outerDiameter = 0.00651 * m;
axleDiameter = 0.00475 * m;
holeDiameter = 0.00485 * m;
begin
var width : = Columns * grid - margin * 2 ;
var length : = Rows * grid - margin * 2 ;
var height1 : = Height * plateThickness;
var builder : = new MeshBuilder( true , true ) ;
for var i : = 0 to Columns - 1 do
for var j : = 0 to Rows - 1 do
begin
var o : = new Point3D( ( i + 0.5 ) * grid, ( j + 0.5 ) * grid, height1) ;
builder. AddCone( o, new Vector3D( 0 , 0 , 1 ) , knobDiameter / 2 , knobDiameter / 2 , knobHeight, false , true , Divisions) ;
builder. AddPipe( new Point3D( o. X, o. Y, o. Z - wallThickness) , new Point3D( o. X, o. Y, wallThickness) ,
knobDiameter, outerDiameter, Divisions) ;
end ;
builder. AddBox( new Point3D( Columns * 0.5 * grid, Rows * 0.5 * grid, height1 - wallThickness / 2 ) , width, length ,
wallThickness,
BoxFaces. All) ;
builder. AddBox( new Point3D( margin + wallThickness / 2 , Rows * 0.5 * grid, height1 / 2 - wallThickness / 2 ) ,
wallThickness, length , height1 - wallThickness,
BoxFaces. All xor BoxFaces. Top) ;
builder. AddBox(
new Point3D( Columns * grid - margin - wallThickness / 2 , Rows * 0.5 * grid, height1 / 2 - wallThickness / 2 ) ,
wallThickness, length , height1 - wallThickness,
BoxFaces. All xor BoxFaces. Top) ;
builder. AddBox( new Point3D( Columns * 0.5 * grid, margin + wallThickness / 2 , height1 / 2 - wallThickness / 2 ) ,
width, wallThickness, height1 - wallThickness,
BoxFaces. All xor BoxFaces. Top) ;
builder. AddBox(
new Point3D( Columns * 0.5 * grid, Rows * grid - margin - wallThickness / 2 , height1 / 2 - wallThickness / 2 ) ,
width, wallThickness, height1 - wallThickness,
BoxFaces. All xor BoxFaces. Top) ;
Result : = builder. ToMesh( false ) ;
end ;
end ;
constructor LegoT. Create( x, y, z: real ; Rows, Columns, Height: integer ; m: GMaterial) ;
begin
var bx : = new LegoVisual3D;
( bx. Rows, bx. Height, bx. Columns) : = ( Rows, Height, Columns) ;
CreateBase( bx, x, y, z, m) ;
end ;
procedure LegoT. SetWP( r: integer ) : = ( model as LegoVisual3D) . Rows : = r;
procedure LegoT. SetW( r: integer ) : = Invoke( SetWP, r) ;
function LegoT. GetW: integer : = InvokeInteger( ( ) - > ( model as LegoVisual3D) . Rows) ;
procedure LegoT. SetHP( r: integer ) : = ( model as LegoVisual3D) . Height : = r;
procedure LegoT. SetH( r: integer ) : = Invoke( SetHP, r) ;
function LegoT. GetH: integer : = InvokeInteger( ( ) - > ( model as LegoVisual3D) . Height) ;
procedure LegoT. SetLP( r: integer ) : = ( model as LegoVisual3D) . Columns : = r;
procedure LegoT. SetL( r: integer ) : = Invoke( SetLP, r) ;
function LegoT. GetL: integer : = InvokeInteger( ( ) - > ( model as LegoVisual3D) . Columns) ;
type
Panel = class
Points: array of Point3D;
TriangleIndex: integer ;
end ;
ModelTypes = ( TetrahedronType, OctahedronType, HexahedronType, IcosahedronType, DodecahedronType, StellatedOctahedronType, MyAny) ;
PanelModelBuilder = class
Panels: List< Panel> : = new List< Panel> ;
TriangleIndexToPanelIndex: List< integer > ;
procedure AddPanel( params points: array of Point3D) ;
begin
var p : = new Panel;
p. points : = points;
Panels. Add( p) ;
end ;
procedure AddPanel( params coords: array of real ) ;
begin
var points : = new Point3D[ coords. Length div 3 ] ;
for var i : = 0 to coords. Length div 3 - 1 do
points[ i] : = new Point3D( coords[ i * 3 ] , coords[ i * 3 + 1 ] , coords[ i * 3 + 2 ] ) ;
Reverse( points) ;
AddPanel( points) ;
end ;
function ToMeshGeometry3D( ) : MeshGeometry3D;
begin
TriangleIndexToPanelIndex : = new List< integer > ;
var tm : = new MeshBuilder( false , false ) ;
var panelIndex : = 0 ;
foreach var p in Panels do
begin
p. TriangleIndex : = tm. Positions. Count;
tm. AddTriangleFan( p. Points, nil , nil ) ;
for var i : = 0 to p. Points. Length - 3 do
TriangleIndexToPanelIndex. Add( panelIndex) ;
panelIndex + = 1 ;
end ;
var panelsGeometry : = tm. ToMesh( false ) ;
Result : = panelsGeometry;
end ;
end ;
function CreateModel( CurrentModelType: ModelTypes; a: real ) : MeshGeometry3D;
begin
var pmb : = new PanelModelBuilder( ) ;
case CurrentModelType of
TetrahedronType:
begin
a / = Sqrt( 8 ) ; // тогда длина р е б р а = 1
pmb. AddPanel( a, a, a, - a, a, - a, a, - a, - a) ;
pmb. AddPanel( - a, a, - a, - a, - a, a, a, - a, - a) ;
pmb. AddPanel( a, a, a, a, - a, - a, - a, - a, a) ;
pmb. AddPanel( a, a, a, - a, - a, a, - a, a, - a) ;
end ;
OctahedronType:
begin
a / = 2 ;
var b : = 0.5 * ( 2 * Sqrt( 2 ) ) * a;
pmb. AddPanel( - a, 0 , a, - a, 0 , - a, 0 , b, 0 ) ;
pmb. AddPanel( - a, 0 , - a, a, 0 , - a, 0 , b, 0 ) ;
pmb. AddPanel( a, 0 , - a, a, 0 , a, 0 , b, 0 ) ;
pmb. AddPanel( a, 0 , a, - a, 0 , a, 0 , b, 0 ) ;
pmb. AddPanel( a, 0 , - a, - a, 0 , - a, 0 , - b, 0 ) ;
pmb. AddPanel( - a, 0 , - a, - a, 0 , a, 0 , - b, 0 ) ;
pmb. AddPanel( a, 0 , a, a, 0 , - a, 0 , - b, 0 ) ;
pmb. AddPanel( - a, 0 , a, a, 0 , a, 0 , - b, 0 ) ;
end ;
HexahedronType:
begin
a / = 2 ;
pmb. AddPanel( - a, - a, a, a, - a, a, a, - a, - a, - a, - a, - a) ;
pmb. AddPanel( - a, a, - a, - a, a, a, - a, - a, a, - a, - a, - a) ;
pmb. AddPanel( - a, a, a, a, a, a, a, - a, a, - a, - a, a) ;
pmb. AddPanel( a, a, - a, a, a, a, - a, a, a, - a, a, - a) ;
pmb. AddPanel( a, - a, a, a, a, a, a, a, - a, a, - a, - a) ;
pmb. AddPanel( a, - a, - a, a, a, - a, - a, a, - a, - a, - a, - a) ;
end ;
IcosahedronType:
begin
a / = Sqrt( 5 ) - 1 ;
var phi : = ( 1 + Sqrt( 5 ) ) / 2 ;
var b : = 1.0 / ( 2 * phi) * 2 * a;
pmb. AddPanel( 0 , b, - a, b, a, 0 , - b, a, 0 ) ;
pmb. AddPanel( 0 , b, a, - b, a, 0 , b, a, 0 ) ;
pmb. AddPanel( 0 , b, a, 0 , - b, a, - a, 0 , b) ;
pmb. AddPanel( 0 , b, a, a, 0 , b, 0 , - b, a) ;
pmb. AddPanel( 0 , b, - a, 0 , - b, - a, a, 0 , - b) ;
pmb. AddPanel( 0 , b, - a, - a, 0 , - b, 0 , - b, - a) ;
pmb. AddPanel( 0 , - b, a, b, - a, 0 , - b, - a, 0 ) ;
pmb. AddPanel( 0 , - b, - a, - b, - a, 0 , b, - a, 0 ) ;
pmb. AddPanel( - b, a, 0 , - a, 0 , b, - a, 0 , - b) ;
pmb. AddPanel( - b, - a, 0 , - a, 0 , - b, - a, 0 , b) ;
pmb. AddPanel( b, a, 0 , a, 0 , - b, a, 0 , b) ;
pmb. AddPanel( b, - a, 0 , a, 0 , b, a, 0 , - b) ;
pmb. AddPanel( 0 , b, a, - a, 0 , b, - b, a, 0 ) ;
pmb. AddPanel( 0 , b, a, b, a, 0 , a, 0 , b) ;
pmb. AddPanel( 0 , b, - a, - b, a, 0 , - a, 0 , - b) ;
pmb. AddPanel( 0 , b, - a, a, 0 , - b, b, a, 0 ) ;
pmb. AddPanel( 0 , - b, - a, - a, 0 , - b, - b, - a, 0 ) ;
pmb. AddPanel( 0 , - b, - a, b, - a, 0 , a, 0 , - b) ;
pmb. AddPanel( 0 , - b, a, - b, - a, 0 , - a, 0 , b) ;
pmb. AddPanel( 0 , - b, a, a, 0 , b, b, - a, 0 ) ;
end ;
DodecahedronType:
begin
var phi : = ( 1 + Sqrt( 5 ) ) / 2 ;
a / = 2 * ( 2 - phi) ;
var b : = 1 / phi * a;
var c : = ( 2 - phi) * a;
pmb. AddPanel( c, 0 , a, - c, 0 , a, - b, b, b, 0 , a, c, b, b, b) ;
pmb. AddPanel( - c, 0 , a, c, 0 , a, b, - b, b, 0 , - a, c, - b, - b, b) ;
pmb. AddPanel( c, 0 , - a, - c, 0 , - a, - b, - b, - b, 0 , - a, - c, b, - b, - b) ;
pmb. AddPanel( - c, 0 , - a, c, 0 , - a, b, b, - b, 0 , a, - c, - b, b, - b) ;
pmb. AddPanel( b, b, - b, a, c, 0 , b, b, b, 0 , a, c, 0 , a, - c) ;
pmb. AddPanel( - b, b, b, - a, c, 0 , - b, b, - b, 0 , a, - c, 0 , a, c) ;
pmb. AddPanel( - b, - b, - b, - a, - c, 0 , - b, - b, b, 0 , - a, c, 0 , - a, - c) ;
pmb. AddPanel( b, - b, b, a, - c, 0 , b, - b, - b, 0 , - a, - c, 0 , - a, c) ;
pmb. AddPanel( a, c, 0 , a, - c, 0 , b, - b, b, c, 0 , a, b, b, b) ;
pmb. AddPanel( a, - c, 0 , a, c, 0 , b, b, - b, c, 0 , - a, b, - b, - b) ;
pmb. AddPanel( - a, c, 0 , - a, - c, 0 , - b, - b, - b, - c, 0 , - a, - b, b, - b) ;
pmb. AddPanel( - a, - c, 0 , - a, c, 0 , - b, b, b, - c, 0 , a, - b, - b, b) ;
end ;
StellatedOctahedronType:
begin
pmb. AddPanel( a, a, a, - a, a, - a, a, - a, - a) ;
pmb. AddPanel( - a, a, - a, - a, - a, a, a, - a, - a) ;
pmb. AddPanel( a, a, a, a, - a, - a, - a, - a, a) ;
pmb. AddPanel( a, a, a, - a, - a, a, - a, a, - a) ;
pmb. AddPanel( - a, a, a, a, a, - a, - a, - a, - a) ;
pmb. AddPanel( a, a, - a, a, - a, a, - a, - a, - a) ;
pmb. AddPanel( - a, a, a, - a, - a, - a, a, - a, a) ;
pmb. AddPanel( - a, a, a, a, - a, a, a, a, - a) ;
end ;
MyAny:
begin
pmb. AddPanel( 0 , 0 , 0 , - a, 0 , 0 , - a, 0 , a, 0 , 0 , a) ;
pmb. AddPanel( - a, 0 , 0 , 0 , a, 0 , 0 , a, a, - a, 0 , a) ;
pmb. AddPanel( 0 , a, 0 , 0 , 0 , 0 , 0 , 0 , a, 0 , a, a) ;
pmb. AddPanel( 0 , 0 , 0 , 0 , a, 0 , - a, 0 , 0 ) ;
pmb. AddPanel( 0 , 0 , a, - a, 0 , a, 0 , a, a) ;
end ;
end ;
Result : = pmb. ToMeshGeometry3D;
end ;
type
PlatonicAbstractVisual3D = abstract class( MeshElement3D)
private
fa: real ;
procedure SetA( value: real ) ; begin fa : = value; OnGeometryChanged; end ;
public
constructor( Length : real ) ;
begin
inherited Create;
Self. Length : = Length ;
end ;
property Length : real read fa write SetA;
end ;
IcosahedronVisual3D = class( PlatonicAbstractVisual3D)
public function Tessellate( ) : MeshGeometry3D; override : = CreateModel( ModelTypes. IcosahedronType, Length ) ;
end ;
DodecahedronVisual3D = class( PlatonicAbstractVisual3D)
public function Tessellate( ) : MeshGeometry3D; override : = CreateModel( ModelTypes. DodecahedronType, Length ) ;
end ;
TetrahedronVisual3D = class( PlatonicAbstractVisual3D)
public function Tessellate( ) : MeshGeometry3D; override : = CreateModel( ModelTypes. TetrahedronType, Length ) ;
end ;
OctahedronVisual3D = class( PlatonicAbstractVisual3D)
public function Tessellate( ) : MeshGeometry3D; override : = CreateModel( ModelTypes. OctahedronType, Length ) ;
end ;
MyAnyVisual3D = class( PlatonicAbstractVisual3D)
public function Tessellate( ) : MeshGeometry3D; override : = CreateModel( ModelTypes. MyAny, Length ) ;
end ;
function PlatonicAbstractT. GetLength: real : = InvokeReal( ( ) - > ( model as PlatonicAbstractVisual3D) . Length ) ;
procedure PlatonicAbstractT. SetLengthP( r: real ) : = ( model as PlatonicAbstractVisual3D) . Length : = r;
constructor IcosahedronT. Create( x, y, z, Length : real ; m: GMaterial) : = CreateBase( new IcosahedronVisual3D( Length ) , x, y, z, m) ;
constructor DodecahedronT. Create( x, y, z, Length : real ; m: GMaterial) : = CreateBase( new DodecahedronVisual3D( Length ) , x, y, z, m) ;
constructor TetrahedronT. Create( x, y, z, Length : real ; m: GMaterial) : = CreateBase( new TetrahedronVisual3D( Length ) , x, y, z, m) ;
constructor OctahedronT. Create( x, y, z, Length : real ; m: GMaterial) : = CreateBase( new OctahedronVisual3D( Length ) , x, y, z, m) ;
type
PrismVisual3D = class( MeshElement3D)
private
fn: integer ;
fh, fr: real ;
procedure SetR( value: real ) ; begin fr : = value; OnGeometryChanged; end ;
procedure SetH( value: real ) ; begin fh : = value; OnGeometryChanged; end ;
procedure SetN( value: integer ) ; begin fn : = value; OnGeometryChanged; end ;
public
constructor( N: integer ; Radius, Height: real ) ;
begin
( fn, fr, fh) : = ( n, Radius, Height) ;
OnGeometryChanged;
end ;
property Height: real read fh write SetH;
property Radius: real read fr write SetR;
property N: integer read fn write SetN;
protected
function Tessellate( ) : MeshGeometry3D; override ;
begin
var pmb : = new PanelModelBuilder( ) ;
if N > 0 then
begin
2018-11-19 02:48:19 +03:00
var a : = PartitionPoints( 0 , 2 * Pi, N) . Select( x - > P3D( fr * cos( x) , fr * sin( x) , 0 ) ) . ToArray;
var b : = PartitionPoints( 0 , 2 * Pi, N) . Select( x - > P3D( fr * cos( x) , fr * sin( x) , fh) ) . ToArray;
2018-11-08 00:24:28 +03:00
for var i : = 0 to fn - 1 do
pmb. AddPanel( a[ i + 1 ] . X, a[ i + 1 ] . Y, a[ i + 1 ] . Z, a[ i] . X, a[ i] . Y, a[ i] . Z, b[ i] . X, b[ i] . Y, b[ i] . Z, b[ i + 1 ] . X, b[ i + 1 ] . Y, b[ i + 1 ] . Z) ;
pmb. AddPanel( a. Reverse. ToArray) ;
pmb. AddPanel( b) ;
end ;
Result : = pmb. ToMeshGeometry3D
end ;
end ;
PyramidVisual3D = class( PrismVisual3D)
protected
function Tessellate( ) : MeshGeometry3D; override ;
begin
var pmb : = new PanelModelBuilder( ) ;
if N > 0 then
begin
2018-11-19 02:48:19 +03:00
var a : = PartitionPoints( 0 , 2 * Pi, N) . Select( x - > P3D( fr * cos( x) , fr * sin( x) , 0 ) ) . ToArray;
2018-11-08 00:24:28 +03:00
var top : = P3D( 0 , 0 , fh) ;
for var i : = 0 to fn - 1 do
pmb. AddPanel( a[ i + 1 ] . X, a[ i + 1 ] . Y, a[ i + 1 ] . Z, a[ i] . X, a[ i] . Y, a[ i] . Z, top. X, top. Y, top. Z) ;
pmb. AddPanel( a. Reverse. ToArray) ;
end ;
Result : = pmb. ToMeshGeometry3D
end ;
end ;
TriangleVisual3D = class( MeshElement3D)
private
pp1, pp2, pp3: Point3D;
protected
function Tessellate( ) : MeshGeometry3D; override ;
begin
var m : = new MeshBuilder( true ) ;
m. AddTriangle( p1, p2, p3) ;
Result : = m. ToMesh;
end ;
procedure SetP1( p1: Point3D) ;
begin
pp1 : = p1;
OnGeometryChanged;
end ;
procedure SetP2( p1: Point3D) ;
begin
pp2 : = p2;
OnGeometryChanged;
end ;
procedure SetP3( p3: Point3D) ;
begin
pp3 : = p3;
OnGeometryChanged;
end ;
public
constructor( ppp1, ppp2, ppp3: Point3D) ;
begin
( pp1, pp2, pp3) : = ( ppp1, ppp2, ppp3) ;
Material : = Materialhelper. CreateMaterial( Colors. Red) ;
OnGeometryChanged;
end ;
property P1: Point3D read pp1 write SetP1;
property P2: Point3D read pp2 write SetP2;
property P3: Point3D read pp3 write SetP3;
procedure SetPoints( p1, p2, p3: Point3D) ;
begin
pp1 : = p1;
pp2 : = p2;
pp3 : = p3;
OnGeometryChanged;
end ;
end ;
procedure TriangleT. SetP1( p: Point3D) : = Invoke( procedure( p: Point3D) - > ( model as TriangleVisual3D) . P1 : = p, p) ;
function TriangleT. GetP1: Point3D : = Invoke& < Point3D> ( ( ) - > ( model as TriangleVisual3D) . P1) ;
procedure TriangleT. SetP2( p: Point3D) : = Invoke( procedure( p: Point3D) - > ( model as TriangleVisual3D) . P2 : = p, p) ;
function TriangleT. GetP2: Point3D : = Invoke& < Point3D> ( ( ) - > ( model as TriangleVisual3D) . P2) ;
procedure TriangleT. SetP3( p: Point3D) : = Invoke( procedure( p: Point3D) - > ( model as TriangleVisual3D) . P3 : = p, p) ;
function TriangleT. GetP3: Point3D : = Invoke& < Point3D> ( ( ) - > ( model as TriangleVisual3D) . P3) ;
procedure TriangleT. SetPoints( p1, p2, p3: Point3D) : = Invoke( procedure( p1, p2, p3: Point3D) - > begin ( model as TriangleVisual3D) . SetPoints( p1, p2, p3) ; end , p1, p2, p3) ;
function TriangleT. CreateObject: Object3D : = new TriangleT( ( model as TriangleVisual3D) . p1, ( model as TriangleVisual3D) . p2, ( model as TriangleVisual3D) . p3, Material. Clone) ;
constructor TriangleT. Create( p1, p2, p3: Point3D; m: Gmaterial) ;
begin
CreateBase( new TriangleVisual3D( p1, p2, p3) , 0 , 0 , 0 , m) ;
( model as TriangleVisual3D) . BackMaterial : = ( model as TriangleVisual3D) . Material;
end ;
procedure PrismT. SetR( r: real ) : = Invoke( procedure( r: real ) - > ( model as PrismVisual3D) . Radius : = r, r) ;
function PrismT. GetR: real : = InvokeReal( ( ) - > ( model as PrismVisual3D) . Radius) ;
procedure PrismT. SetH( r: real ) : = Invoke( procedure( r: real ) - > ( model as PrismVisual3D) . Height : = r, r) ;
function PrismT. GetH: real : = InvokeReal( ( ) - > ( model as PrismVisual3D) . Height) ;
procedure PrismT. SetN( n: integer ) : = Invoke( procedure( n: integer ) - > ( model as PrismVisual3D) . N : = n, n) ;
function PrismT. GetN: integer : = InvokeInteger( ( ) - > ( model as PrismVisual3D) . N) ;
constructor PrismT. Create( x, y, z: real ; N: integer ; r, h: real ; m: Gmaterial) : = CreateBase( new PrismVisual3D( N, r, h) , x, y, z, m) ;
constructor PyramidT. Create( x, y, z: real ; N: integer ; r, h: real ; m: GMaterial) : = CreateBase( new PyramidVisual3D( N, r, h) , x, y, z, m) ;
function DefaultMaterialColor : = RandomColor;
function DefaultMaterial: Material : = MaterialHelper. CreateMaterial( DefaultMaterialColor) ;
function Group( x, y, z: integer ) : Group3D : = Inv( ( ) - > Group3D. Create( x, y, z) ) ;
function Group( p: Point3D) : Group3D : = Inv( ( ) - > Group3D. Create( p. x, p. y, p. z) ) ;
function Group: Group3D : = Inv( ( ) - > Group3D. Create( 0 , 0 , 0 ) ) ;
function Group( params lst: array of Object3D) : Group3D : = Inv( ( ) - > Group3D. Create( 0 , 0 , 0 , lst) ) ;
function Group( en: sequence of Object3D) : Group3D : = Inv( ( ) - > Group3D. Create( 0 , 0 , 0 , en) ) ;
function Sphere( x, y, z, Radius: real ; m: Material) : SphereT : = Inv( ( ) - > SphereT. Create( x, y, z, Radius, m) ) ;
function Sphere( center: Point3D; Radius: real ; m: Material) : = Sphere( center. x, center. y, center. z, Radius, m) ;
function Ellipsoid( x, y, z, RadiusX, RadiusY, RadiusZ: real ; m: Material) : EllipsoidT : = Inv( ( ) - > EllipsoidT. Create( x, y, z, RadiusX, RadiusY, RadiusZ, m) ) ;
function Ellipsoid( center: Point3D; RadiusX, RadiusY, RadiusZ: real ; m: Material) : = Ellipsoid( center. x, center. y, center. z, RadiusX, RadiusY, RadiusZ, m) ;
function Cube( x, y, z, SideLength: real ; m: Material) : CubeT : = Inv( ( ) - > CubeT. Create( x, y, z, SideLength, m) ) ;
function Cube( center: Point3D; SideLength: real ; m: Material) : CubeT : = Cube( center. x, center. y, center. z, SideLength, m) ;
function Box( x, y, z, SizeX, SizeY, SizeZ: real ; m: Material) : BoxT : = Inv( ( ) - > BoxT. Create( x, y, z, SizeX, SizeY, SizeZ, m) ) ;
function Box( center: Point3D; sz: Size3D; m: Material) : BoxT : = Inv( ( ) - > BoxT. Create( center. x, center. y, center. z, sz. X, sz. Y, sz. z, m) ) ;
const
arhl = 3 ; ard = 0.2 ;
function Arrow( x, y, z, vx, vy, vz, diameter, HeadLength: real ; m: Material) : ArrowT : = Inv( ( ) - > ArrowT. Create( x, y, z, vx, vy, vz, diameter, HeadLength, m) ) ;
function Arrow( x, y, z, vx, vy, vz, diameter: real ; m: Material) : = Arrow( x, y, z, vx, vy, vz, diameter, arhl, m) ;
function Arrow( x, y, z, vx, vy, vz: real ; m: Material) : = Arrow( x, y, z, vx, vy, vz, ard, arhl, m) ;
function Arrow( p: Point3D; v: Vector3D; diameter, HeadLength: real ; m: Material) : = Arrow( p. x, p. y, p. z, v. X, v. Y, v. Z, diameter, HeadLength, m) ;
function Arrow( p: Point3D; v: Vector3D; diameter: real ; m: Material) : = Arrow( p. x, p. y, p. z, v. X, v. Y, v. Z, diameter, arhl, m) ;
function Arrow( p: Point3D; v: Vector3D; m: Material) : = Arrow( p. x, p. y, p. z, v. X, v. Y, v. Z, ard, arhl, m) ;
function TruncatedConeAux( x, y, z, Height, Radius, TopRadius: real ; sides: integer ; topcap: boolean ; c: Material) : = Inv( ( ) - > TruncatedConeT. Create( x, y, z, Height, Radius, TopRadius, sides, topcap, c) ) ;
const
maxsides = 3 7 ;
///--
function TruncatedCone( x, y, z, Height, Radius, TopRadius: real ; topcap: boolean ; m: Material) : TruncatedConeT : = TruncatedConeAux( x, y, z, Height, Radius, TopRadius, maxsides, topcap, m) ;
function TruncatedCone( x, y, z, Height, Radius, TopRadius: real ; m: Material) : = TruncatedCone( x, y, z, Height, Radius, TopRadius, True , m) ;
///--
function TruncatedCone( p: Point3D; Height, Radius, TopRadius: real ; topcap: boolean ; m: Material) : = TruncatedCone( p. x, p. y, p. z, Height, Radius, TopRadius, topcap, m) ;
function TruncatedCone( p: Point3D; Height, Radius, TopRadius: real ; m: Material) : = TruncatedCone( p. x, p. y, p. z, Height, Radius, TopRadius, True , m) ;
///--
function Cylinder( x, y, z, Height, Radius: real ; topcap: boolean ; m: Material) : CylinderT : = Inv( ( ) - > CylinderT. Create( x, y, z, Height, Radius, maxsides, topcap, m) ) ;
function Cylinder( x, y, z, Height, Radius: real ; m: Material) : = Cylinder( x, y, z, Height, Radius, True , m) ;
///--
function Cylinder( p: Point3D; Height, Radius: real ; topcap: boolean ; m: Material) : = Cylinder( p. x, p. y, p. z, Height, Radius, topcap, m) ;
function Cylinder( p: Point3D; Height, Radius: real ; m: Material) : = Cylinder( p. x, p. y, p. z, Height, Radius, True , m) ;
function Tube( x, y, z, Height, Radius, InnerRadius: real ; m: Material) : PipeT : = Inv( ( ) - > PipeT. Create( x, y, z, Height, Radius, InnerRadius, m) ) ;
function Tube( p: Point3D; Height, Radius, InnerRadius: real ; m: Material) : = Tube( p. x, p. y, p. z, Height, Radius, InnerRadius, m) ;
function Cone( x, y, z, Height, Radius: real ; m: Material) : TruncatedConeT : = TruncatedCone( x, y, z, Height, Radius, 0 , True , m) ;
function Cone( p: Point3D; Height, Radius: real ; m: Material) : = TruncatedCone( p. x, p. y, p. z, Height, Radius, 0 , True , m) ;
function Teapot( x, y, z: real ; c: Material) : TeapotT : = Inv( ( ) - > TeapotT. Create( x, y, z, c) ) ;
function Teapot( p: Point3D; c: Material) : = Teapot( p. x, p. y, p. z, c) ;
function BillboardText( x, y, z: real ; Text : string ; Fontsize: real ) : BillboardTextT : = Inv( ( ) - > BillboardTextT. Create( x, y, z, text , fontsize) ) ;
function BillboardText( p: Point3D; Text : string ; Fontsize: real ) : = BillboardText( P. x, p. y, p. z, text , fontsize) ;
function CoordinateSystem( ArrowsLength, Diameter: real ) : CoordinateSystemT : = Inv( ( ) - > CoordinateSystemT. Create( 0 , 0 , 0 , arrowslength, diameter) ) ;
function CoordinateSystem( ArrowsLength: real ) : = CoordinateSystem( arrowslength, arrowslength / 1 0 ) ;
function Text3D( x, y, z: real ; Text : string ; Height: real ; fontname: string ; c: Color) : TextT : = Inv( ( ) - > TextT. Create( x, y, z, text , height, fontname, c) ) ;
function Text3D( p: Point3D; Text : string ; Height: real ; fontname: string ; c: Color) : = Text3D( P. x, p. y, p. z, text , height, fontname, c) ;
function Text3D( x, y, z: real ; Text : string ; Height: real ; c: Color) : = Text3D( x, y, z, text , height, 'Arial' , c) ;
function Text3D( p: Point3D; Text : string ; Height: real ; c: Color) : = Text3D( p. x, p. y, p. z, text , height, 'Arial' , c) ;
function Rectangle3D( x, y, z, Length , Width: real ; Normal, LengthDirection: Vector3D; m: Material) : RectangleT : = Inv( ( ) - > RectangleT. Create( x, y, z, Length , Width, normal, LengthDirection, m) ) ;
function Rectangle3D( p: Point3D; Length , Width: real ; Normal, LengthDirection: Vector3D; m: Material) : RectangleT : = Rectangle3D( p. x, p. y, p. z, Length , Width, Normal, LengthDirection, m) ;
function Rectangle3D( x, y, z, Length , Width: real ; Normal: Vector3D; m: Material) : RectangleT : = Rectangle3D( x, y, z, Length , Width, Normal, OrtX, m) ;
function Rectangle3D( x, y, z, Length , Width: real ; m: Material) : RectangleT : = Rectangle3D( x, y, z, Length , Width, OrtZ, OrtX, m) ;
function Rectangle3D( p: Point3D; Length , Width: real ; Normal: Vector3D; m: Material) : RectangleT : = Rectangle3D( p. x, p. y, p. z, Length , Width, Normal, OrtX, m) ;
function Rectangle3D( p: Point3D; Length , Width: real ; m: Material) : RectangleT : = Rectangle3D( p. x, p. y, p. z, Length , Width, OrtZ, OrtX, m) ;
/// Загружает модель из файла .obj, .3ds, .lwo, .objz, .stl, .off
function FileModel3D( x, y, z: real ; fname: string ; m: Material) : FileModelT : = Inv( ( ) - > FileModelT. Create( x, y, z, fname, m) ) ;
function FileModel3D( p: Point3D; fname: string ; m: Material) : FileModelT : = FileModel3D( p. x, p. y, p. z, fname, m) ;
function Prism( x, y, z: real ; Sides: integer ; Height, Radius: real ; m: Material) : PrismT : = Inv( ( ) - > PrismT. Create( x, y, z, Sides, Radius, Height, m) ) ;
function Prism( p: Point3D; Sides: integer ; Height, Radius: real ; m: Material) : PrismT : = Prism( p. X, p. Y, p. Z, Sides, Radius, Height, m) ;
function PrismWireFrame( x, y, z: real ; Sides: integer ; Height, Radius: real ; Thickness: real ; c: Color) : PrismTWireFrame : = Inv( ( ) - > PrismTWireFrame. Create( x, y, z, Sides, Radius, Height, thickness, c) ) ;
function PrismWireFrame( p: Point3D; Sides: integer ; Height, Radius: real ; Thickness: real ; c: Color) : PrismTWireFrame : = PrismWireFrame( p. x, p. y, p. z, Sides, Radius, Height, thickness, c) ;
function Pyramid( x, y, z: real ; Sides: integer ; Height, Radius: real ; m: Material) : PyramidT : = Inv( ( ) - > PyramidT. Create( x, y, z, Sides, Radius, Height, m) ) ;
function Pyramid( p: Point3D; Sides: integer ; Height, Radius: real ; m: Material) : PyramidT : = Pyramid( p. X, p. Y, p. Z, Sides, Radius, Height, m) ;
function PyramidWireFrame( x, y, z: real ; Sides: integer ; Height, Radius: real ; Thickness: real ; c: Color) : PyramidTWireFrame : = Inv( ( ) - > PyramidTWireFrame. Create( x, y, z, Sides, Radius, Height, thickness, c) ) ;
function PyramidWireFrame( p: Point3D; Sides: integer ; Height, Radius: real ; Thickness: real ; c: Color) : PyramidTWireFrame : = PyramidWireFrame( p. x, p. y, p. z, Sides, Radius, Height, thickness, c) ;
function Lego( x, y, z: real ; Rows, Columns, Height: integer ; m: Material) : LegoT : = Inv( ( ) - > LegoT. Create( x, y, z, Rows, Columns, Height, m) ) ;
function Icosahedron( x, y, z, Radius: real ; m: Material) : IcosahedronT : = Inv( ( ) - > IcosahedronT. Create( x, y, z, 4 * Radius / Sqrt( 2 ) / Sqrt( 5 + Sqrt( 5 ) ) , m) ) ;
function Dodecahedron( x, y, z, Radius: real ; m: Material) : DodecahedronT : = Inv( ( ) - > DodecahedronT. Create( x, y, z, Radius * 4 / Sqrt( 3 ) / ( 1 + Sqrt( 5 ) ) , m) ) ;
function Tetrahedron( x, y, z, Radius: real ; m: Material) : TetrahedronT : = Inv( ( ) - > TetrahedronT. Create( x, y, z, 4 * Radius / Sqrt( 6 ) , m) ) ;
function Octahedron( x, y, z, Radius: real ; m: Material) : OctahedronT : = Inv( ( ) - > OctahedronT. Create( x, y, z, Radius * Sqrt( 2 ) , m) ) ;
function Icosahedron( p: Point3D; Radius: real ; m: Material) : IcosahedronT : = Icosahedron( p. X, p. Y, p. Z, Radius, m) ;
function Dodecahedron( p: Point3D; Radius: real ; m: Material) : DodecahedronT : = Dodecahedron( p. X, p. Y, p. Z, Radius, m) ;
function Tetrahedron( p: Point3D; Radius: real ; m: Material) : TetrahedronT : = Tetrahedron( p. X, p. Y, p. Z, Radius, m) ;
function Octahedron( p: Point3D; Radius: real ; m: Material) : OctahedronT : = Octahedron( p. X, p. Y, p. Z, Radius, m) ;
function Segments3D( points: sequence of Point3D; thickness: real ; c: Color) : SegmentsT : = Inv( ( ) - > SegmentsT. Create( points, thickness, c) ) ;
function Polyline3D( points: sequence of Point3D; thickness: real ; c: Color) : SegmentsT : = Inv( ( ) - > SegmentsT. Create( points. Pairwise. SelectMany( x - > Seq( x[ 0 ] , x[ 1 ] ) ) , thickness, c) ) ;
function Polygon3D( points: sequence of Point3D; thickness: real ; c: Color) : SegmentsT : = Inv( ( ) - > SegmentsT. Create( ( points + points. First) . Pairwise. SelectMany( x - > Seq( x[ 0 ] , x[ 1 ] ) ) , thickness, c) ) ;
function Segment3D( p1, p2: Point3D; thickness: real ; c: Color) : SegmentsT : = Inv( ( ) - > SegmentsT. Create( Seq( p1, p2) , thickness, c) ) ;
function Torus( x, y, z, Diameter, TubeDiameter: real ; m: Material) : TorusT : = Inv( ( ) - > TorusT. Create( x, y, z, Diameter, TubeDiameter, m) ) ;
function Torus( p: Point3D; Diameter, TubeDiameter: real ; m: Material) : TorusT : = Torus( p. x, p. y, p. z, Diameter, TubeDiameter, m) ;
function Triangle( p1, p2, p3: Point3D; m: Material) : TriangleT : = Inv( ( ) - > TriangleT. Create( p1, p2, p3, m) ) ;
// Конец примитивов
//------------------------------------------------------------------------------------
// Функции для точек, лучей, прямых, плоскостей
function FindNearestObject( x, y: real ) : Object3D;
begin
Result : = nil ;
var v : = hvp. FindNearestVisual( new Point( x, y) ) ;
foreach var obj in Object3DList do
if obj. model = v then
Result : = obj
end ;
function FindNearestObjectPoint( x, y: real ) : Point3D;
begin
var p1 : = hvp. FindNearestPoint( Pnt( x, y) ) ;
if p1. HasValue then
Result : = p1. Value
else Result : = BadPoint;
end ;
function Plane( p: Point3D; normal: Vector3D) : Plane3D : = new Plane3D( p, normal) ;
function Ray( p: Point3D; v: Vector3D) : Ray3D : = new Ray3D( p, v) ;
function Line( p: Point3D; v: Vector3D) : Line3D : = new Line3D( p, v) ;
function Line( p1, p2: Point3D) : Line3D : = new Line3D( p1, p2 - p1) ;
function GetRay( x, y: real ) : Ray3D : = hvp. Viewport. GetRay( Pnt( x, y) ) ;
function PointOnPlane( Self: Plane3D; x, y: real ) : Point3D; extensionmethod;
begin
var r : = GetRay( x, y) ;
var p1 : = r. PlaneIntersection( Self. Position, Self. Normal) ;
if p1. HasValue then
Result : = p1. Value
else Result : = BadPoint;
end ;
function NearestPointOnLine( Self: Ray3D; x, y: real ) : Point3D; extensionmethod;
begin
var ray : = GetRay( x, y) ;
var a : = Self. Direction;
var b : = ray. Direction;
var ab : = Vector3D. CrossProduct( a, b) ;
var planeNormal : = Vector3D. CrossProduct( b, ab) ;
var p : = Self. PlaneIntersection( ray. Origin, planeNormal) ;
if p. HasValue then
Result : = p. Value
else Result : = BadPoint;
end ;
function PointOnPlane( Plane: Plane3D; x, y: real ) : Point3D : = Plane. PointOnPlane( x, y) ;
function NearestPointOnLine( Line: Ray3D; x, y: real ) : Point3D : = Line. NearestPointOnLine( x, y) ;
// Методы расширения для анимаций
function Sec( Self: integer ) : real ; extensionmethod : = Self;
function Sec( Self: real ) : real ; extensionmethod : = Self;
// А теперь - тадам! - перегрузка + для Animate.Sequence и перегрузка * для Animate.Group
function operator + ( a, b: AnimationBase) : AnimationBase; extensionmethod : = Animate. Sequence( a, b) ;
function operator * ( a, b: AnimationBase) : AnimationBase; extensionmethod : = Animate. Group( a, b) ;
// Конец методов расширения для анимаций
// Методы расширения для точки
function operator * ( p: Point3D; r: real ) : Point3D; extensionmethod : = p. Multiply( r) ;
function operator * ( r: real ; p: Point3D) : Point3D; extensionmethod : = p. Multiply( r) ;
function operator + ( p1, p2: Point3D) : Point3D; extensionmethod : = p3d( p1. X + p2. X, p1. Y + p2. Y, p1. Z + p2. Z) ;
function operator - ( v: Vector3D) : Vector3D; extensionmethod : = v3d( - v. x, - v. y, - v. z) ;
function MoveX( Self: Point3D; dx: real ) : Point3D; extensionmethod : = P3D( Self. x + dx, Self. y, Self. z) ;
function MoveY( Self: Point3D; dy: real ) : Point3D; extensionmethod : = P3D( Self. x, Self. y + dy, Self. z) ;
function MoveZ( Self: Point3D; dz: real ) : Point3D; extensionmethod : = P3D( Self. x, Self. y, Self. z + dz) ;
function Move( Self: Point3D; dx, dy, dz: real ) : Point3D; extensionmethod : = P3D( Self. x + dx, Self. y + dy, Self. z + dz) ;
// Конец методов расширения для точки
type
TupleInt3 = ( integer , integer , integer ) ;
TupleReal3 = ( real , real , real ) ;
// Разные методы расширения
function ChangeOpacity( Self: GColor; value: integer ) : Color; extensionmethod : = ARGB( value, Self. R, Self. G, Self. B) ;
function operator implicit( t: TupleInt3) : Point3D; extensionmethod : = new Point3D( t[ 0 ] , t[ 1 ] , t[ 2 ] ) ;
function operator implicit( t: TupleReal3) : Point3D; extensionmethod : = new Point3D( t[ 0 ] , t[ 1 ] , t[ 2 ] ) ;
function operator implicit( ar: array of TupleInt3) : Point3DCollection; extensionmethod : = new Point3DCollection( ar. Select( t - > new Point3D( t[ 0 ] , t[ 1 ] , t[ 2 ] ) ) ) ;
function operator implicit( ar: array of Point3D) : Point3DCollection; extensionmethod : = new Point3DCollection( ar) ;
function operator implicit( ar: List< Point3D> ) : Point3DCollection; extensionmethod : = new Point3DCollection( ar) ;
// Конец разных методов расширения
type
GMHelper = auto class
a, b: Material;
function GroupMaterial: Material;
begin
var g : = new MaterialGroup( ) ;
g. Children. Add( a) ;
g. Children. Add( b) ;
Result : = g;
end ;
end ;
// Методы расширения для Material
function operator + ( a, b: Material) : Material; extensionmethod : = Invoke& < Material> ( GMHelper. Create( a, b) . GroupMaterial) ;
function operator implicit( c: GColor) : GMaterial; extensionmethod : = Materialhelper. CreateMaterial( c) ;
// Конец методов расширения для Material
//=============================================================================
// Экспериментальные функции и классы
type
MyAnyT = class( PlatonicAbstractT)
protected
function CreateObject: Object3D; override : = new MyAnyT( X, Y, Z, Length , Material) ;
public
constructor( x, y, z, Length : real ; m: GMaterial) ;
begin
CreateBase( new MyAnyVisual3D( Length ) , x, y, z, m) ;
end ;
function Clone : = ( inherited Clone) as MyAnyT;
end ;
procedure ProbaP;
begin
//var m := MaterialHelper.CreateMaterial(Brushes.Green,100,100);
//m.AmbientColor := Colors.Red;
//m.Color := Colors.Green;
//var bi := new System.Windows.Media.Imaging.BitmapImage(new System.Uri('dog.png',System.UriKind.Relative));
//var b := new ImageBrush(bi);
//b.ViewportUnits := BrushMappingMode.Absolute;
//b.Viewport := Rect(0,0,0.2,0.3);
//b.TileMode := System.Windows.Media.TileMode.Tile;
//Cube(6,-4,0,4,MaterialHelper.CreateMaterial(b));
Sphere( 2 , - 4 , 0 , 2 , MaterialHelper. CreateMaterial( Brushes. Green, 0.4 , 1 0 0 , 2 5 5 ) ) ;
Sphere( - 2 , - 4 , 0 , 2 , MaterialHelper. CreateMaterial( Brushes. Green, 0.6 , 1 0 0 , 2 5 5 ) ) ;
Sphere( - 6 , - 4 , 0 , 2 , MaterialHelper. CreateMaterial( Brushes. Green, 0.8 , 1 0 0 , 0 ) ) ;
Sphere( 6 , 0 , 0 , 2 , MaterialHelper. CreateMaterial( Brushes. Green, 0.5 , 1 0 0 , 2 5 5 ) ) ;
Sphere( 2 , 0 , 0 , 2 , MaterialHelper. CreateMaterial( Brushes. Green, 0.5 , 7 0 , 2 5 5 ) ) ;
Sphere( - 2 , 0 , 0 , 2 , MaterialHelper. CreateMaterial( Brushes. Green, 0.5 , 4 0 , 2 5 5 ) ) ;
Sphere( - 6 , 0 , 0 , 2 , MaterialHelper. CreateMaterial( Brushes. Green, 0.5 , 2 0 , 2 5 5 ) ) ;
Sphere( 6 , 4 , 0 , 2 , MaterialHelper. CreateMaterial( Brushes. Green, Brushes. Gray, nil , 1 ) ) ;
//Sphere(2,4,0,2,MaterialHelper.CreateMaterial((Brushes.Green,new SolidColorBrush(RGB(0,64,0)),new SolidColorBrush(Rgb(128, 128, 128)), 100));
Sphere( - 2 , 4 , 0 , 2 , MaterialHelper. CreateMaterial( Brushes. Green, 0.5 , 4 0 , 2 5 5 ) ) ;
//Cube(-6,4,0,4,Materials.Rainbow);
//var g := hvp.Children[1] as DefaultLights;
end ;
procedure Proba : = Invoke( ProbaP) ;
procedure ProbaP2;
begin
//var c := new CubeVisual3D();
//var c := new IcosahedronVisual3D();
//c.Length := 1;
//c.Material := Colors.Green;
//hvp.Children.Add(c);
//var ex := new HelixToolkit.Wpf.XamlExporter();
//ex.Export(c,new System.IO.FileStream('cube.xaml',System.IO.FileMode.Create));
//XamlWriter.Save(c,new System.IO.StreamWriter('www1.xaml'));
//var c1 := XamlReader.Load(new System.IO.FileStream('cube.xaml',System.IO.FileMode.Open)) as CubeVisual3D;
//hvp.Children.Add(c1);
{ var off : = new offreader( nil ) ;
var s : = System. IO. File . OpenRead( 'boxcube.off' ) ;
off. Load( s) ;
var m1 : = new MeshVisual3D( ) ;
m1. FaceMaterial : = Colors. Green;
m1. EdgeDiameter : = 0 ;
m1. VertexRadius : = 0 ;
m1. Mesh : = off. CreateMesh;
hvp. Children. Add( m1) ; }
{ var ex : = new ExtrudedVisual3D( ) ;
ex. BackMaterial : = Colors. Green;
ex. Diameters : = new DoubleCollection( Arr( 1.0 , 1.5 , 1.2 ) ) ;
ex. Path : = new Point3DCollection( Arr( P3D( 0 , 0 , 0 ) , P3D( 0 , 1 , 0 ) , P3D( 0 , 1 , 1 ) , P3D( 1 , 1 , 1 ) ) ) ;
hvp. Children. Add( ex) ; }
var m : = new SphereVisual3D( ) ;
m. Radius : = 0.5 ;
hvp. Children. Add( m) ;
var t : = new TranslateManipulator( ) ;
t. Color : = Colors. Green;
//t.Offset := v3D(2,3,4);
t. Length : = 2 ;
t. Diameter : = 0.15 ;
t. Direction : = V3D( 1 , 2 , 0 ) ;
t. Value : = 5 ;
var b : = new System. Windows. Data. Binding( 'Transform' ) ;
b. Source : = m;
var b1 : = new System. Windows. Data. Binding( 'Transform' ) ;
b1. Source : = m;
System. Windows. Data. BindingOperations. SetBinding( t, Manipulator. TargetTransformProperty, b) ;
System. Windows. Data. BindingOperations. SetBinding( t, Manipulator. TransformProperty, b) ;
//t.Bind(m);
hvp. Children. Add( t) ;
{ var l : = Lst( P3D( 0 , 1 , 0 ) , P3D( 1 , 0 , 0 ) , P3D( 0 , - 1 , 0 ) , P3D( - 1 , 0 , 0 ) , P3D( 0 , 1 , 0 ) ) ;
var l1 : = CanonicalSplineHelper. CreateSpline( l, 0.5 ) ;
Polyline3D( l1) ; }
end ;
procedure Proba2 : = Invoke( ProbaP2) ;
procedure ProbaP3( x, y, z: real ) ;
begin
hvp. CameraController. AddMoveForce( x, y, z) ;
end ;
procedure Proba3( x, y, z: real ) : = Invoke( ProbaP3, x, y, z) ;
type
My = class( ParametricSurface3D)
public
function Evaluate( u: real ; v: real ; var textureCoord: System. Windows. Point) : Point3D; override ;
begin
u - = 0.5 ;
v - = 0.5 ;
u * = 3 ;
v * = 3 ;
textureCoord : = new Point( u, 2 * v) ;
Result : = P3D( u, v, 0.2 * u * u + sin( u * v) + 2 ) ;
end ;
end ;
My13D = class( MeshElement3D)
public function Tessellate( ) : MeshGeometry3D; override ;
begin
var tm : = new MeshBuilder( false , false ) ;
tm. AddRevolvedGeometry( Arr( Pnt( 0 , 0 ) , Pnt( 0 , 1 ) , Pnt( 0.3 , 1 ) , Pnt( 0.5 , 0.3 ) , Pnt( 2 , 1 ) , Pnt( 3 , 0 ) ) , nil , Origin, OrtZ, 8 0 ) ;
Result : = tm. ToMesh( false ) ;
end ;
end ;
type
AnyT = class( ObjectWithMaterial3D)
constructor( x, y, z: real ; c: GColor) ;
begin
{ var a : = new ExtrudedVisual3D;
a. Path : = new Point3DCollection( Arr( P3D( 1 , 0 , - 0.5 ) , P3D( 1 , 0 , 0.5 ) ) ) ;
a. Section : = new PointCollection( Arr( Pnt( 0 , 0 ) , Pnt( 0.5 , 0 ) , Pnt( 0 , 0.5 ) ) ) ;
a. IsSectionClosed : = True ; }
//var a := new TerrainVisual3D;
//a.Content := (new SphereVisual3D()).Model;
//a.Text := 'PascalABC';
//var a := new LinesVisual3D;
{ a. Thickness : = 1.99 ;
a. Points : = Arr( P3D( 0 , 0 , 0 ) , P3D( 3 , 0 , 0 ) , P3D( 3 , 0 , 0 ) , P3D( 3 , 3 , 0 ) , P3D( 3 , 3 , 0 ) , P3D( 3 , 3 , 3 ) ) ;
a. Color : = c; }
var a : = new My13D;
a. Material : = c;
{ var aa : = 1 ;
var b : = 8 0 ;
var q : = Partition( 0 , 2 * Pi* 2 0 , 3 6 0 * 2 0 * 1 0 ) . Select( t- > P3D( 5 * cos( 1 * t) , 5 * sin( 1 * t) , t/ 5 ) ) ;
var q1 : = q. Interleave( q. Skip( 1 ) ) ;
//a.Points := Lst(P3D(0,0,0),P3D(4,4,2),p3D(4,4,2),p3D(2,8,-1));
a. Points : = Lst( q1) ;
a. Color : = Colors. Blue;
a. Thickness : = 1.5 ; }
{ var a : = new HelixToolkit. Wpf. PieSliceVisual3D;
a. StartAngle : = 0 ;
a. EndAngle : = 3 6 0 ;
a. ThetaDiv : = 6 0 ; }
{ var a : = new HelixToolkit. Wpf. TubeVisual3D;
var p : = new Point3DCollection( Arr( P3D( 1 , 2 , 0 ) , P3D( 2 , 1 , 0 ) , P3D( 3 , 1 , 0 ) ) ) ;
a. Diameter : = 0.05 ;
a. Path : = p; }
{ var a : = new LegoVisual3D( ) ;
a. Rows : = 1 ;
a. Columns : = 2 ;
a. Height : = 3 ;
//a.Divisions := 100;
a. Fill : = Brushes. Blue; }
CreateBase0( a, x, y, z) ;
end ;
end ;
function MyH( x, y, z, Length : real ; c: Color) : MyAnyT : = Inv( ( ) - > MyAnyT. Create( x, y, z, Length , c) ) ;
function MyH( x, y, z, Length : real ; c: Material) : MyAnyT : = Inv( ( ) - > MyAnyT. Create( x, y, z, Length , c) ) ;
function Any( x, y, z: real ; c: Color) : AnyT : = Inv( ( ) - > AnyT. Create( x, y, z, c) ) ;
// Сервисные функции и классы
type
Graph3DWindow = class( GMainWindow)
public
procedure InitMainGraphControl; override ;
begin
var g : = Content as DockPanel;
hvp : = new HelixViewport3D( ) ;
g. Children. Add( hvp) ;
hvp. ZoomExtentsWhenLoaded : = True ;
hvp. ShowCoordinateSystem : = True ;
hvp. Children. Add( new DefaultLights) ;
var mv : = new ModelVisual3D;
LightsGroup : = new Model3DGroup;
mv. Content : = LightsGroup;
hvp. Children. Add( mv) ;
gvl : = new GridLinesVisual3D( ) ;
gvl. Width : = 1 2 ;
gvl. Length : = 1 2 ;
gvl. Normal : = OrtZ;
gvl. MinorDistance : = 1 ;
gvl. MajorDistance : = 1 ;
gvl. Thickness : = 0.02 ;
hvp. Children. Add( gvl) ;
end ;
procedure InitWindowProperties; override ;
begin
( Width, Height) : = ( 8 0 0 , 6 0 0 ) ;
Title : = '3D графика' ;
WindowStartupLocation : = System. Windows. WindowStartupLocation. CenterScreen;
end ;
procedure InitGlobals; override ;
begin
Window : = new WindowType;
Camera : = new CameraType;
Lights : = new LightsType;
GridLines : = new GridLinesType;
View3D : = new View3DType;
NameScope. SetNameScope( Self, new NameScope( ) ) ;
end ;
/// --- SystemKeyEvents
procedure SystemOnKeyDown( sender: Object ; e: System. Windows. Input. KeyEventArgs) ;
begin
if Graph3D. OnKeyDown < > nil then
Graph3D. OnKeyDown( e. Key) ;
e. Handled : = True ;
end ;
2018-12-22 12:56:57 +03:00
procedure SystemOnKeyUp( sender: Object ; e: System. Windows. Input. KeyEventArgs) ;
2018-11-08 00:24:28 +03:00
begin
if Graph3D. OnKeyUp < > nil then
Graph3D. OnKeyUp( e. Key) ;
e. Handled : = True ;
end ;
2018-12-22 12:56:57 +03:00
procedure SystemOnKeyPress( sender: Object ; e: TextCompositionEventArgs) ;
begin
if ( OnKeyPress< > nil ) and ( e. Text< > nil ) and ( e. Text . Length > 0 ) then
OnKeyPress( e. Text [ 1 ] ) ;
e. Handled : = True ;
end ;
2018-11-08 00:24:28 +03:00
/// --- SystemMouseEvents
procedure SystemOnMouseDown( sender: Object ; e: System. Windows. Input. MouseButtonEventArgs) ;
begin
var mb : = 0 ;
var p : = e. GetPosition( hvp) ;
if e. LeftButton = MouseButtonState. Pressed then
mb : = 1
else if e. RightButton = MouseButtonState. Pressed then
mb : = 2 ;
if Graph3D. OnMouseDown < > nil then
Graph3D. OnMouseDown( p. x, p. y, mb) ;
end ;
procedure SystemOnMouseUp( sender: Object ; e: MouseButtonEventArgs) ;
begin
var mb : = 0 ;
var p : = e. GetPosition( hvp) ;
if e. LeftButton = MouseButtonState. Pressed then
mb : = 1
else if e. RightButton = MouseButtonState. Pressed then
mb : = 2 ;
if Graph3D. OnMouseUp < > nil then
Graph3D. OnMouseUp( p. x, p. y, mb) ;
end ;
procedure SystemOnMouseMove( sender: Object ; e: MouseEventArgs) ;
begin
var mb : = 0 ;
var p : = e. GetPosition( hvp) ;
if e. LeftButton = MouseButtonState. Pressed then
mb : = 1
else if e. RightButton = MouseButtonState. Pressed then
mb : = 2 ;
if Graph3D. OnMouseMove < > nil then
Graph3D. OnMouseMove( p. x, p. y, mb) ;
end ;
procedure InitHandlers; override ;
begin
hvp. PreviewMouseDown + = ( o, e) - > SystemOnMouseDown( o, e) ;
hvp. PreviewMouseUp + = ( o, e) - > SystemOnMouseUp( o, e) ;
hvp. PreviewMouseMove + = ( o, e) - > SystemOnMouseMove( o, e) ;
hvp. PreviewKeyDown + = ( o, e) - > SystemOnKeyDown( o, e) ;
hvp. PreviewKeyUp + = ( o, e) - > SystemOnKeyUp( o, e) ;
2018-12-22 12:56:57 +03:00
hvp. PreviewTextInput + = SystemOnKeyPress; // не работает
2018-11-08 00:24:28 +03:00
hvp. Focus( ) ;
Closed + = procedure( sender, e) - > begin Halt; end ;
end ;
end ;
var
mre : = new ManualResetEvent( false ) ;
procedure InitApp;
begin
app : = new Application;
app. Dispatcher. UnhandledException + = ( o, e) - > begin
Println( e. Exception. Message ) ;
if e. Exception. InnerException < > nil then
Println( e. Exception. InnerException. Message ) ;
halt;
end ;
MainWindow : = new Graph3DWindow;
//MainWindow.MainPanel;
mre. Set( ) ;
app. Run( MainWindow) ;
end ;
procedure InitMainThread;
begin
var MainFormThread : = new System. Threading. Thread( InitApp) ;
MainFormThread. SetApartmentState( ApartmentState. STA) ;
MainFormThread. Start;
mre. WaitOne; // Основная программа не начнется пока не будут инициализированы все компоненты приложения
end ;
var
///--
__initialized : = false ;
var
///--
__finalized : = false ;
procedure __InitModule;
begin
InitMainThread;
end ;
///--
procedure __InitModule__;
begin
if not __initialized then
begin
__initialized : = true ;
__InitModule;
end ;
end ;
///--
procedure __FinalizeModule__;
begin
if not __finalized then
begin
__finalized : = true ;
end ;
end ;
initialization
__InitModule;
finalization
end .