diff --git a/CodeCompletion/CodeFormatter.cs b/CodeCompletion/CodeFormatter.cs index 819ab4680..4750c0708 100644 --- a/CodeCompletion/CodeFormatter.cs +++ b/CodeCompletion/CodeFormatter.cs @@ -771,7 +771,10 @@ namespace CodeFormatters continue; } } + if (!(stmt is empty_statement)) + add_space_after = true; visit_node(stmt); + } DecOffset(); if (!tmp_init_part) diff --git a/ParserTools/SyntaxTreeVisitors/SyntaxTreeComparer.cs b/ParserTools/SyntaxTreeVisitors/SyntaxTreeComparer.cs index e5f1f21e1..4ab3f6d09 100644 --- a/ParserTools/SyntaxTreeVisitors/SyntaxTreeComparer.cs +++ b/ParserTools/SyntaxTreeVisitors/SyntaxTreeComparer.cs @@ -143,7 +143,18 @@ namespace PascalABCCompiler.SyntaxTree CompareInternal(left.expr, right.expr); } } - + + public void CompareInternal(assign_var_tuple left, assign_var_tuple right) + { + if (left == null && right != null || left != null && right == null) + throw_not_equal(left, right); + if (left != null && right != null) + { + CompareInternal(left.idents, right.idents); + CompareInternal(left.expr, right.expr); + } + } + public void CompareInternal(loop_stmt left, loop_stmt right) { if (left == null && right != null || left != null && right == null) @@ -1692,6 +1703,8 @@ namespace PascalABCCompiler.SyntaxTree CompareInternal(left as loop_stmt, right as loop_stmt); else if (left is assign_tuple) CompareInternal(left as assign_tuple, right as assign_tuple); + else if (left is assign_var_tuple) + CompareInternal(left as assign_var_tuple, right as assign_var_tuple); //else if (left is expression) // SSM 12/06/15 // CompareInternal(left as expression, right as expression); diff --git a/TestSuite/formatter_tests/input/GraphWPF.pas b/TestSuite/formatter_tests/input/GraphWPF.pas new file mode 100644 index 000000000..256e7f17f --- /dev/null +++ b/TestSuite/formatter_tests/input/GraphWPF.pas @@ -0,0 +1,1638 @@ +// 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 GraphWPF; + +interface + +uses GraphWPFBase; + +uses System.Windows; +uses System.Windows.Controls; +uses System.Windows.Controls.Primitives; +uses System.Windows.Input; +uses System.Windows.Media; +uses System.Windows.Media.Animation; +uses System.Windows.Media.Imaging; +uses System.Windows.Data; +uses System.Reflection; +uses System.Collections.ObjectModel; +uses System.Threading; +uses System.Windows.Shapes; +uses System.Windows.Threading; + +var CountVisuals := 0; + +{procedure Invoke(d: System.Delegate; params args: array of object); +procedure Invoke(d: ()->()); +function Invoke(d: Func0): T; +function InvokeReal(f: ()->real): real; +function InvokeString(f: ()->string): string;} + +type + /// Тип клавиши + Key = System.Windows.Input.Key; + /// Цветовые константы + Colors = System.Windows.Media.Colors; + /// Тип цвета + Color = System.Windows.Media.Color; + /// Тип цвета + GColor = System.Windows.Media.Color; + /// Тип прямоугольника + GRect = System.Windows.Rect; + GWindow = System.Windows.Window; + GPen = System.Windows.Media.Pen; + GPoint = System.Windows.Point; + GBrush = System.Windows.Media.Brush; + /// Тип стиля шрифта + FontStyle = (Normal,Bold,Italic,BoldItalic); + + ///!# + BrushType = class + private + c := Colors.White; + function BrushConstruct := new SolidColorBrush(c); + public + /// Цвет кисти + property Color: GColor read c write c; + end; + + ///!# + PenType = class + private + c: Color := Colors.Black; + th: real := 1; + fx,fy: real; + function PenConstruct: GPen; + begin + Result := new GPen(new SolidColorBrush(c),th); + Result.LineJoin := PenLineJoin.Round; + end; + public + /// Цвет пера + property Color: GColor read c write c; + /// Ширина пера + property Width: real read th write th; + /// Текущая координата X пера + property X: real read fx; + /// Текущая координата Y пера + property Y: real read fy; + end; + + ///!# + FontType = class + private + tf := new Typeface('Arial'); + sz: real := 12; + c: GColor := Colors.Black; + procedure SetNameP(s: string) := tf := new Typeface(new FontFamily(s),FontStyles.Normal,FontWeights.Normal,FontStretches.Normal); + function GetName := tf.FontFamily.ToString; + procedure SetName(s: string) := Invoke(SetNameP,s); + procedure SetFSP(fs: FontStyle); + begin + var s := FontStyles.Normal; + var w := FontWeights.Normal; + case fs of + FontStyle.Bold: w := FontWeights.Bold; + FontStyle.Italic: s := FontStyles.Italic; + FontStyle.BoldItalic: begin s := FontStyles.Italic; w := FontWeights.Bold; end; + end; + tf := new Typeface(new FontFamily(Name),s,w,FontStretches.Normal); + end; + procedure SetFS(fs: FontStyle) := Invoke(SetFSP,fs); + function TypefaceClone := tf; + function BrushConstruct := new SolidColorBrush(c); + public + /// Цвет шрифта + property Color: GColor read c write c; + /// Имя шрифта + property Name: string read GetName write SetName; + /// Размер шрифта в единицах по 1/96 дюйма + property Size: real read sz write sz; + /// Стиль шрифта + property Style: FontStyle write SetFS; + end; + + GraphWindowType = class + private + function GetTop: real; + function GetLeft: real; + function GetWidth: real; + function GetHeight: real; + public + /// Отступ графического окна от левого края главного окна + property Left: real read GetLeft; + /// Отступ графического окна от верхнего края главного окна + property Top: real read GetTop; + /// Ширина графического окна + property Width: real read GetWidth; + /// Высота графического окна + property Height: real read GetHeight; + /// Сохраняет содержимое графического окна в файл с именем fname + procedure Save(fname: string); + /// Восстанавливает содержимое графического окна из файла с именем fname + procedure Load(fname: string); + /// Заполняет содержимое графического окна обоями из файла с именем fname + procedure Fill(fname: string); + end; + + // Специфический тип окна для модуля GraphWPF + WindowTypeWPF = class(WindowType) + public + /// Сохраняет содержимое графического окна в файл с именем fname + procedure Save(fname: string); + /// Восстанавливает содержимое графического окна из файла с именем fname + procedure Load(fname: string); + /// Очищает графическое окно белым цветом + procedure Clear; override; + end; + + + /// Виды системы координат + CoordType = (MathematicalCoords,StandardCoords); + /// Константы выравнивания текста относительно точки + Alignment = (LeftTop,CenterTop,RightTop,LeftCenter,Center,RightCenter,LeftBottom,CenterBottom,RightBottom); + +/// Рисует эллипс с центром в точке (x,y) и радиусами rx и ry +procedure Ellipse(x,y,rx,ry: real); +/// Рисует контур эллипса с центром в точке (x,y) и радиусами rx и ry +procedure DrawEllipse(x,y,rx,ry: real); +/// Рисует внутренность эллипса с центром в точке (x,y) и радиусами rx и ry +procedure FillEllipse(x,y,rx,ry: real); +/// Рисует эллипс с центром в точке (x,y), радиусами rx и ry и цветом внутренности c +procedure Ellipse(x,y,rx,ry: real; c: Color); +/// Рисует контур эллипса с центром в точке (x,y), радиусами rx и ry и цветом c +procedure DrawEllipse(x,y,rx,ry: real; c: Color); +/// Рисует внутренность эллипса с центром в точке (x,y), радиусами rx и ry и цветом c +procedure FillEllipse(x,y,rx,ry: real; c: Color); + +/// Рисует окружность с центром в точке (x,y) и радиусом r +procedure Circle(x,y,r: real); +/// Рисует контур окружности с центром в точке (x,y) и радиусом r +procedure DrawCircle(x,y,r: real); +/// Рисует внутренность окружности с центром в точке (x,y) и радиусом r +procedure FillCircle(x,y,r: real); +/// Рисует окружность с центром в точке (x,y), радиусом r и цветом c +procedure Circle(x,y,r: real; c: Color); +/// Рисует контур окружности с центром в точке (x,y), радиусом r и цветом c +procedure DrawCircle(x,y,r: real; c: Color); +/// Рисует внутренность окружности с центром в точке (x,y), радиусом r и цветом c +procedure FillCircle(x,y,r: real; c: Color); + +/// Рисует прямоугольник с координатами вершин (x,y) и (x+w,y+h) +procedure Rectangle(x,y,w,h: real); +/// Рисует контур прямоугольника с координатами вершин (x,y) и (x+w,y+h) +procedure DrawRectangle(x,y,w,h: real); +/// Рисует внутренность прямоугольника с координатами вершин (x,y) и (x+w,y+h) +procedure FillRectangle(x,y,w,h: real); +/// Рисует прямоугольник с координатами вершин (x,y) и (x+w,y+h) цветом c +procedure Rectangle(x,y,w,h: real; c: Color); +/// Рисует контур прямоугольника с координатами вершин (x,y) и (x+w,y+h) цветом c +procedure DrawRectangle(x,y,w,h: real; c: Color); +/// Рисует внутренность прямоугольника с координатами вершин (x,y) и (x+w,y+h) цветом c +procedure FillRectangle(x,y,w,h: real; c: Color); + +/// Рисует дугу окружности с центром в точке (x,y) и радиусом r, заключенную между двумя лучами, образующими углы angle1 и angle2 с осью OX +procedure Arc(x, y, r, angle1, angle2: real); +/// Рисует дугу окружности с центром в точке (x,y) и радиусом r, заключенную между двумя лучами, образующими углы angle1 и angle2 с осью OX, цветом c +procedure Arc(x, y, r, angle1, angle2: real; c: Color); + +/// Рисует сектор окружности с центром в точке (x,y) и радиусом r, заключенный между двумя лучами, образующими углы angle1 и angle2 с осью OX +procedure Sector(x, y, r, angle1, angle2: real); +/// Рисует сектор окружности с центром в точке (x,y) и радиусом r, заключенный между двумя лучами, образующими углы angle1 и angle2 с осью OX +procedure Pie(x, y, r, angle1, angle2: real); +/// Рисует контур сектора окружности с центром в точке (x,y) и радиусом r, заключенного между двумя лучами, образующими углы angle1 и angle2 с осью OX +procedure DrawSector(x, y, r, angle1, angle2: real); +/// Рисует внутренность сектора окружности с центром в точке (x,y) и радиусом r, заключенного между двумя лучами, образующими углы angle1 и angle2 с осью OX +procedure FillSector(x, y, r, angle1, angle2: real); +/// Рисует сектор окружности с центром в точке (x,y) и радиусом r, заключенный между двумя лучами, образующими углы angle1 и angle2 с осью OX, цветом c +procedure Sector(x, y, r, angle1, angle2: real; c: Color); +/// Рисует контур сектора окружности с центром в точке (x,y) и радиусом r, заключенного между двумя лучами, образующими углы angle1 и angle2 с осью OX, цветом c +procedure DrawSector(x, y, r, angle1, angle2: real; c: Color); +/// Рисует внутренность сектора окружности с центром в точке (x,y) и радиусом r, заключенного между двумя лучами, образующими углы angle1 и angle2 с осью OX, цветом c +procedure FillSector(x, y, r, angle1, angle2: real; c: Color); + +/// Рисует отрезок прямой от точки (x,y) до точки (x1,y1) +procedure Line(x,y,x1,y1: real); +/// Рисует отрезок прямой от точки (x,y) до точки (x1,y1) цветом c +procedure Line(x,y,x1,y1: real; c: Color); +/// Устанавливает текущую позицию рисования в точку (x,y) +procedure MoveTo(x,y: real); +/// Рисует отрезок от текущей позиции до точки (x,y). Текущая позиция переносится в точку (x,y) +procedure LineTo(x,y: real); +/// Перемещает текущую позицию рисования на вектор (dx,dy) +procedure MoveRel(dx,dy: real); +/// Рисует отрезок от текущей позиции до точки, смещённой на вектор (dx,dy). Текущая позиция переносится в новую точку +procedure LineRel(dx,dy: real); +/// Перемещает текущую позицию рисования на вектор (dx,dy) +procedure MoveOn(dx,dy: real); +/// Рисует отрезок от текущей позиции до точки, смещённой на вектор (dx,dy). Текущая позиция переносится в новую точку +procedure LineOn(dx,dy: real); + +/// Рисует ломаную, заданную массивом точек +procedure PolyLine(points: array of Point); +/// Рисует ломаную заданную массивом точек и цветом +procedure PolyLine(points: array of Point; c: Color); + +/// Рисует многоугольник, заданный массивом точек +procedure Polygon(points: array of Point); +/// Рисует контур многоугольника, заданного массивом точек +procedure DrawPolygon(points: array of Point); +/// Рисует внутренность многоугольника, заданного массивом точек +procedure FillPolygon(points: array of Point); +/// Рисует многоугольник, заданный массивом точек и цветом +procedure Polygon(points: array of Point; c: Color); +/// Рисует контур многоугольника, заданного массивом точек и цветом +procedure DrawPolygon(points: array of Point; c: GColor); +/// Рисует внутренность многоугольника, заданного массивом точек и цветом +procedure FillPolygon(points: array of Point; c: GColor); + +/// Рисует изображение из файла fname в позиции (x,y) +procedure DrawImage(x,y: real; fname: string); +/// Рисует изображение из файла fname в позиции (x,y) размера w на h +procedure DrawImage(x,y,w,h: real; fname: string); +/// Рисует немасштабированное изображение из файла fname в позиции (x,y) +procedure DrawImageUnscaled(x,y: real; fname: string); +/// Выводит видеоиз файла fname в позицию (x,y) +procedure DrawVideo(x,y: real; fname: string); + +/// Ширина изображения в пикселах +function ImageWidth(fname: string): integer; +/// Высота изображения в пикселах +function ImageHeight(fname: string): integer; +/// Размер изображения в пикселах +function ImageSize(fname: string): (integer,integer); + +/// Ширина текста при выводе +function TextWidth(text: string): real; +/// Высота текста при выводе +function TextHeight(text: string): real; +/// Размер текста при выводе +function TextSize(text: string): Size; + +/// Текущая кисть +var Brush: BrushType; +/// Текущее перо +var Pen: PenType; +/// Текущий шрифт +var Font: FontType; +/// Главное окно +var Window: WindowTypeWPF; +/// Графическое окно +var GraphWindow: GraphWindowType; + +var + /// Событие нажатия на кнопку мыши. (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); + /// Событие нажатия символьной клавиши + OnKeyPress: procedure(ch: char); + /// Событие изменения размера графического окна + OnResize: procedure; + +/// Возвращает цвет по красной, зеленой и синей составляющей (в диапазоне 0..255) +function RGB(r,g,b: byte): Color; +/// Возвращает цвет по красной, зеленой и синей составляющей и параметру прозрачности (в диапазоне 0..255) +function ARGB(a,r,g,b: byte): Color; +/// Возвращает случайный цвет +function RandomColor: Color; +/// Возвращает случайный цвет +function clRandom: Color; +/// Возвращает точку с координатами (x,y) +function Pnt(x,y: real): GPoint; +/// Возвращает прямоугольник с координатами угла (x,y), шириной w и высотой h +function Rect(x,y,w,h: real): GRect; +/// Возвращает однотонную цветную кисть, заданную цветом +function ColorBrush(c: Color): GBrush; +/// Возвращает однотонное цветное перо, заданное цветом +function ColorPen(c: Color): GPen; + +/// Начать анимацию, основанную на кадре +procedure BeginFrameBasedAnimation(Draw: procedure; frate: integer := 60); +/// Начать анимацию, основанную на кадре +procedure BeginFrameBasedAnimation(Draw: procedure(frame: integer); frate: integer := 60); +/// Завершить анимацию, основанную на кадре +procedure EndFrameBasedAnimation; + +/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; text: string; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; text: string; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит целое в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; number: integer; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит вещественное в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; number: real; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит строку в прямоугольник +procedure DrawText(r: GRect; text: string; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит целое в прямоугольник +procedure DrawText(r: GRect; number: integer; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит вещественное в прямоугольник +procedure DrawText(r: GRect; number: real; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит целое в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; number: integer; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит вещественное в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; number: real; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит строку в прямоугольник +procedure DrawText(r: GRect; text: string; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит целое в прямоугольник +procedure DrawText(r: GRect; number: integer; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит вещественное в прямоугольник +procedure DrawText(r: GRect; number: real; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); + +/// Выводит строку в позицию (x,y) +procedure TextOut(x, y: real; text: string; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +/// Выводит строку в позицию (x,y) цветом c +procedure TextOut(x, y: real; text: string; c: GColor; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +/// Выводит целое в позицию (x,y) +procedure TextOut(x, y: real; text: integer; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +/// Выводит целое в позицию (x,y) цветом c +procedure TextOut(x, y: real; text: integer; c: GColor; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +/// Выводит вещественное в позицию (x,y) +procedure TextOut(x, y: real; text: real; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +/// Выводит вещественное в позицию (x,y) цветом c +procedure TextOut(x, y: real; text: real; c: GColor; align: Alignment := Alignment.LeftTop; angle: real := 0.0); + +/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом координатами x1,y1,x2,y2, +procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real); +/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике r +procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect); +/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, на полное графическое окно +procedure DrawGraph(f: real -> real; a, b, min, max: real); +/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике, задаваемом координатами x1,y1,x2,y2, +procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real); +/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике r +procedure DrawGraph(f: real -> real; a, b: real; r: GRect); +/// Рисует график функции f, заданной на отрезке [-5,5], в прямоугольнике r +procedure DrawGraph(f: real -> real; r: GRect); +/// Рисует график функции f, заданной на отрезке [a,b], на полное графическое окно +procedure DrawGraph(f: real -> real; a, b: real); +/// Рисует график функции f, заданной на отрезке [-5,5], на полное графическое окно +procedure DrawGraph(f: real -> real); + +procedure SetMathematicCoords(x1: real := -10; x2: real := 10; drawcoords: boolean := true); +procedure SetMathematicCoords(x1,x2,ymin: real; drawcoords: boolean := true); +procedure SetStandardCoords(scale: real := 1.0; x0: real := 0; y0: real := 0); +procedure SetStandardCoordsSharpLines(x0: real := 0; y0: real := 0); +procedure DrawGrid; + +function XMin: real; +function XMax: real; +function YMin: real; +function YMax: real; + +{procedure AddRightPanel(Width: real := 200; c: Color := Colors.LightGray); +procedure AddLeftPanel(Width: real := 200; c: Color := Colors.LightGray); +procedure AddTopPanel(Height: real := 100; c: Color := Colors.LightGray); +procedure AddBottomPanel(Height: real := 100; c: Color := Colors.LightGray); + +procedure AddStatusBar(Height: real := 24);} + +implementation + +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 RandomColor := RGB(PABCSystem.Random(256), PABCSystem.Random(256), PABCSystem.Random(256)); +function clRandom := RandomColor(); +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 ColorBrush(c: Color) := new SolidColorBrush(c); +function ColorPen(c: Color) := new GPen(ColorBrush(c),Pen.Width); + +procedure InvokeVisual(d: System.Delegate; params args: array of object); +begin + if CountVisuals <= 1000000 then + app.Dispatcher.Invoke(d,args) + else + begin + //Print(CountVisuals); + app.Dispatcher.Invoke(d,DispatcherPriority.Background,args); + Sleep(10); + end; +end; + +function operator implicit(Self: (integer, integer)): Point; extensionmethod := new Point(Self[0], Self[1]); +function operator implicit(Self: (integer, real)): Point; extensionmethod := new Point(Self[0], Self[1]); +function operator implicit(Self: (real, integer)): Point; extensionmethod := new Point(Self[0], Self[1]); +function operator implicit(Self: (real, real)): Point; extensionmethod := new Point(Self[0], Self[1]); + +function operator implicit(Self: array of (real, real)): array of Point; extensionmethod := + Self.Select(t->new Point(t[0],t[1])).ToArray; +function operator implicit(Self: array of (integer, integer)): array of Point; extensionmethod := + Self.Select(t->new Point(t[0],t[1])).ToArray; + + +///---- Helpers +procedure SetLeft(Self: UIElement; l: integer); extensionmethod := Canvas.SetLeft(Self,l); + +procedure SetTop(Self: UIElement; t: integer); extensionmethod := Canvas.SetTop(Self,t); + +{procedure MoveTo(Self: UIElement; l,t: integer); extensionmethod; +begin + Canvas.SetLeft(Self,l); + Canvas.SetTop(Self,t); +end;} +type + MyVisualHost = class(Canvas) // мб Canvas - тогда можно размещать другие элементы! + public + children: VisualCollection; + protected + function GetVisualChild(index: integer): Visual; override; + begin + if (index < 0) or (index >= children.Count) then + raise new System.ArgumentOutOfRangeException(); + Result := children[index]; + end; + function get_VisualChildrenCount := children.Count; + public + constructor; + begin + children := new VisualCollection(Self); + end; + property VisualChildrenCount: integer read get_VisualChildrenCount; override; + end; + +var Host: MyVisualHost; + +var + XOrigin := 0.0; + YOrigin := 0.0; + GlobalScale := 1.0; + CurrentCoordType: CoordType := StandardCoords; + +{procedure ProbaAnimP; +begin + var dv := Host.children[0] as DrawingVisual; + + var animation := new VectorAnimation(); + animation.From := new Vector(20,20); + animation.To := new Vector(100,200); + animation.Duration := System.TimeSpan.FromSeconds(5); + dv.BeginAnimation(OffsetProperty, animation); + + var geo := dv.Drawing.Children[0] as GeometryDrawing; + geo.Pen := ColorPen(Colors.Green); + var rg := geo.Geometry as RectangleGeometry; + + //Print(geo.Geometry.); + //geo.Brush := Brushes.Blue; + dv.Offset := new Vector(200,40); +end; + +procedure ProbaAnim := Invoke(ProbaAnimP);} + +function GetDC: DrawingContext; +begin + var visual := new DrawingVisual(); + Host.children.Add(visual); + CountVisuals += 1; + Result := visual.RenderOpen(); +end; + +function GetDC(t: Transform): DrawingContext; +begin + var visual := new DrawingVisual(); + visual.Transform := t; + Host.children.Add(visual); + CountVisuals += 1; + Result := visual.RenderOpen(); +end; + +function ScaleToDevice: (real,real); +begin + var pSource := PresentationSource.FromVisual(MainWindow); + if pSource = nil then // не знаю, почему + begin + Result := (1.0,1.0); + exit + end; + var m := pSource.CompositionTarget.TransformToDevice; + Result := (m.M11,m.M22); +end; + + +//procedure SetBrushColorP(c: Color) := Brush.br := new SolidColorBrush(c); // hook + +///---- P - primitives + +procedure EllipsePFull(x,y,r1,r2: real; b: GBrush; p: GPen); +begin + var dc := GetDC(); + dc.DrawEllipse(b, p, Pnt(x, y), r1, r2); + dc.Close(); +end; + +type VE = auto class + g: ()->Geometry; +end; + +procedure DrawGeometryP(g: VE); +begin + var dc := GetDC(); + dc.DrawGeometry(Brush.BrushConstruct,Pen.PenConstruct,g.g()); + dc.Close(); +end; + +procedure RectanglePFull(x,y,w,h: real; b: GBrush; p: GPen); +begin + if h<0 then + begin + h := -h; + y -= h; + end; + if w<0 then + begin + w := -w; + x -= w; + end; + var dc := GetDC(); + dc.DrawRectangle(b, p, Rect(x,y,w,h)); + dc.Close(); + //var f := Host.children[0] as DrawingVisual; + {var geo := f.Drawing.Children[0] as GeometryDrawing; + geo.Brush := Brushes.Blue;} +end; + +procedure LinePFull(x,y,x1,y1: real; p: GPen); +begin + var dc := GetDC(); + dc.DrawLine(p, Pnt(x,y), Pnt(x1,y1)); + dc.Close(); +end; + +function FormText(text: string) := + new FormattedText(text,new System.Globalization.CultureInfo('ru-ru'), FlowDirection.LeftToRight, + Font.TypefaceClone, Font.Size, Font.BrushConstruct); + +function FormTextC(text: string; c: GColor): FormattedText := + new FormattedText(text,new System.Globalization.CultureInfo('ru-ru'), FlowDirection.LeftToRight, + Font.TypefaceClone, Font.Size, ColorBrush(c)); + +function TextWidthP(text: string) := FormText(text).Width; +function TextHeightP(text: string) := FormText(text).Height; + +type TextV = auto class + text: string; + function TextWidth := TextWidthP(text); + function TextHeight := TextHeightP(text); + function TextSize: Size; + begin + var ft := FormText(text); + Result := new Size(ft.Width,ft.Height); + end; +end; + +procedure TextPFull(x,y: real; text: string; angle,x0,y0: real); +begin + var dc: DrawingContext; + if CurrentCoordType = StandardCoords then + begin + dc := GetDC(); + var RT := new RotateTransform(angle,x0,y0); + dc.PushTransform(RT); + dc.DrawText(FormText(text),new Point(x,y)); + dc.Pop(); + end + else + begin + var m := Host.RenderTransform.Value; + var mt := new MatrixTransform(1/m.M11,0,0,1/m.M22,x,y); + dc := GetDC(); + var RT := new RotateTransform(angle,x0,y0); + dc.PushTransform(RT); + dc.PushTransform(mt); + dc.DrawText(FormText(text),new Point(0,0)); + dc.Pop(); + dc.Pop(); + end; + //dc.DrawRectangle(Brushes.White,nil,new GRect(new Point(x,y),TextV.Create(text).TextSize)); + dc.Close(); +end; + +procedure TextPFull(x,y: real; text: string; angle,x0,y0: real; c: Color); +begin + var dc: DrawingContext; + if CurrentCoordType = StandardCoords then + begin + dc := GetDC(); + var RT := new RotateTransform(angle,x0,y0); + dc.PushTransform(RT); + dc.DrawText(FormTextC(text,c),new Point(x,y)); + dc.Pop(); + end + else + begin + var m := Host.RenderTransform.Value; + var mt := new MatrixTransform(1/m.M11,0,0,1/m.M22,x,y); + dc := GetDC(); + var RT := new RotateTransform(angle,x0,y0); + dc.PushTransform(RT); + dc.PushTransform(mt); + dc.DrawText(FormTextC(text,c),new Point(0,0)); + dc.Pop(); + dc.Pop(); + end; + //dc.DrawRectangle(Brushes.White,nil,new GRect(new Point(x,y),TextV.Create(text).TextSize)); + dc.Close(); +end; + +var dpic := new Dictionary; + +function GetBitmapImage(fname: string): BitmapImage; +begin + if not dpic.ContainsKey(fname) then + dpic[fname] := new BitmapImage(new System.Uri(fname,System.UriKind.Relative)); + Result := dpic[fname]; +end; + +procedure DrawImageP(x,y: real; fname: string); +begin + var dc := GetDC(); + var img := GetBitmapImage(fname); + dc.DrawImage(img, Rect(x, y, img.PixelWidth, img.PixelHeight)); + dc.Close(); +end; + +procedure DrawImageWHP(x,y,w,h: real; fname: string); +begin + var dc := GetDC(); + var img := GetBitmapImage(fname); + dc.DrawImage(img, Rect(x, y, w, h)); + dc.Close(); +end; + +procedure DrawImageUnscaledP(x,y: real; fname: string); +begin + var dc := GetDC(); + var (scalex,scaley) := ScaleToDevice; + var img := GetBitmapImage(fname); + dc.DrawImage(img, Rect(x, y, img.PixelWidth/scalex, img.PixelHeight/scaley)); + dc.Close(); +end; + +function ImageWidthP(fname: string) := GetBitmapImage(fname).PixelWidth; +function ImageHeightP(fname: string) := GetBitmapImage(fname).PixelHeight; +function ImageSizeP(fname: string) := (GetBitmapImage(fname).PixelWidth,GetBitmapImage(fname).PixelHeight); + +type ImHelper = auto class + fname: string; + function IW := ImageWidthP(fname); + function IH := ImageHeightP(fname); + function ISz := ImageSizeP(fname); +end; + +function ImageWidth(fname: string) := Invoke&(ImHelper.Create(fname).IW); +function ImageHeight(fname: string) := Invoke&(ImHelper.Create(fname).IH); +function ImageSize(fname: string) := Invoke&<(integer,integer)>(ImHelper.Create(fname).ISz); + + +// Нет свойств посмотреть размеры видео! +procedure DrawVideoP(x,y,w,h: real; fname: string); +begin + var dc := GetDC(); + var pl := new MediaPlayer(); + pl.Open(new System.Uri(fname, System.UriKind.Relative)); + pl.Play(); + dc.DrawVideo(pl, Rect(x, y, w, h)); + dc.Close(); +end; + +// А теперь займёмся полигонами... +procedure DrawPolygonOrPolyline(Self: DrawingContext; + b: GBrush; p: GPen; points: array of Point; draw_polygon: boolean); extensionmethod; +begin + var geo := new StreamGeometry(); + geo.FillRule := FillRule.EvenOdd; + + var context: StreamGeometryContext := geo.Open(); + context.BeginFigure(Pnt(points[0].X,points[0].Y), true, draw_polygon); + context.PolyLineTo(points.Select(p->Pnt(p.x,p.y)).Skip(1).ToArray(), true, false); + context.Close; + + Self.DrawGeometry(b, p, geo); +end; + +procedure DrawPolygon(Self: DrawingContext; b: GBrush; p: GPen; points: array of Point); extensionmethod + := Self.DrawPolygonOrPolyline(b,p,points,true); + +procedure DrawPolyline(Self: DrawingContext; p: GPen; points: array of Point); extensionmethod + := Self.DrawPolygonOrPolyline(nil,p,points,false); + +procedure PolyLinePFull(points: array of Point; p: GPen); +begin + var dc := GetDC(); + dc.DrawPolyline(p, points); + dc.Close(); +end; + +procedure PolygonPFull(points: array of Point; b: GBrush; p: GPen); +begin + var dc := GetDC(); + dc.DrawPolygon(b, p, points); + dc.Close(); +end; + +procedure ArcSectorPFull(x, y, r, angle1, angle2: real; b: GBrush; p: GPen; issector: boolean); +begin + if angle1>angle2 then Swap(angle1,angle2); + if angle2-angle1 >= 360 then + (angle1,angle2) := (0,360-0.0001); + var dc := GetDC(); + var geo := new PathGeometry(); + var f := new PathFigure(); + geo.Figures.Add(f); + var sgn := CurrentCoordType = MathematicalCoords ? 1 : -1; + var p1 := Pnt(x + r * cos(angle1*Pi/180), y + sgn * r * sin(angle1*Pi/180)); + var p2 := Pnt(x + r * cos(angle2*Pi/180), y + sgn * r * sin(angle2*Pi/180)); + if CurrentCoordType = MathematicalCoords then + Swap(p1,p2); + f.StartPoint := p1; + var a := new ArcSegment(p2, new Size(r,r), 0, abs(angle2-angle1)>180, SweepDirection.Counterclockwise, true); + f.Segments.Add(a); + if IsSector then + begin + f.Segments.Add(new LineSegment(Pnt(x,y),true)); + f.Segments.Add(new LineSegment(p1,true)); + end; + + dc.DrawGeometry(b,p,geo); + dc.Close; +end; + +procedure ArcPFull(x, y, r, angle1, angle2: real; p: GPen) := ArcSectorPFull(x, y, r, angle1, angle2, nil, p, false); + +procedure SectorPFull(x, y, r, angle1, angle2: real; b: GBrush; p: GPen) := ArcSectorPFull(x, y, r, angle1, angle2, b, p, true); + +procedure EllipseP(x,y,r1,r2: real) := EllipsePFull(x,y,r1,r2,Brush.BrushConstruct,Pen.PenConstruct); +procedure DrawEllipseP(x,y,r1,r2: real) := EllipsePFull(x,y,r1,r2,nil,Pen.PenConstruct); +procedure FillEllipseP(x,y,r1,r2: real) := EllipsePFull(x,y,r1,r2,Brush.BrushConstruct,nil); +procedure EllipsePC(x,y,r1,r2: real; c: GColor) := EllipsePFull(x,y,r1,r2,ColorBrush(c),Pen.PenConstruct); +procedure DrawEllipsePC(x,y,r1,r2: real; c: GColor) := EllipsePFull(x,y,r1,r2,nil,ColorPen(c)); +procedure FillEllipsePC(x,y,r1,r2: real; c: GColor) := EllipsePFull(x,y,r1,r2,ColorBrush(c),nil); + +procedure RectangleP(x,y,w,h: real) := RectanglePFull(x,y,w,h,Brush.BrushConstruct,Pen.PenConstruct); +procedure DrawRectangleP(x,y,w,h: real) := RectanglePFull(x,y,w,h,nil,Pen.PenConstruct); +procedure FillRectangleP(x,y,w,h: real) := RectanglePFull(x,y,w,h,Brush.BrushConstruct,nil); +procedure RectanglePC(x,y,r1,r2: real; c: GColor) := RectanglePFull(x,y,r1,r2,ColorBrush(c),Pen.PenConstruct); +procedure DrawRectanglePC(x,y,r1,r2: real; c: GColor) := RectanglePFull(x,y,r1,r2,nil,ColorPen(c)); +procedure FillRectanglePC(x,y,r1,r2: real; c: GColor) := RectanglePFull(x,y,r1,r2,ColorBrush(c),nil); + +procedure ArcP(x, y, r, angle1, angle2: real) := ArcPFull(x, y, r, angle1, angle2, Pen.PenConstruct); +procedure ArcPC(x, y, r, angle1, angle2: real; c: GColor) := ArcPFull(x, y, r, angle1, angle2, ColorPen(c)); + +procedure SectorP(x, y, r, angle1, angle2: real) := SectorPFull(x, y, r, angle1, angle2, Brush.BrushConstruct, Pen.PenConstruct); +procedure DrawSectorP(x, y, r, angle1, angle2: real) := SectorPFull(x, y, r, angle1, angle2, nil, Pen.PenConstruct); +procedure FillSectorP(x, y, r, angle1, angle2: real) := SectorPFull(x, y, r, angle1, angle2, Brush.BrushConstruct, nil); +procedure SectorPC(x, y, r, angle1, angle2: real; c: GColor) := SectorPFull(x, y, r, angle1, angle2, ColorBrush(c), Pen.PenConstruct); +procedure DrawSectorPC(x, y, r, angle1, angle2: real; c: GColor) := SectorPFull(x, y, r, angle1, angle2, nil, ColorPen(c)); +procedure FillSectorPC(x, y, r, angle1, angle2: real; c: GColor) := SectorPFull(x, y, r, angle1, angle2, ColorBrush(c), nil); + +procedure LineP(x,y,x1,y1: real) := LinePFull(x,y,x1,y1,Pen.PenConstruct); +procedure LinePC(x,y,x1,y1: real; c: GColor) := LinePFull(x,y,x1,y1,ColorPen(c)); +procedure PolyLineP(points: array of Point) := PolyLinePFull(points,Pen.PenConstruct); +procedure PolyLinePC(points: array of Point; c: GColor) := PolyLinePFull(points,ColorPen(c)); + +procedure PolygonP(points: array of Point) := PolygonPFull(points,Brush.BrushConstruct,Pen.PenConstruct); +procedure DrawPolygonP(points: array of Point) := PolygonPFull(points,nil,Pen.PenConstruct); +procedure FillPolygonP(points: array of Point) := PolygonPFull(points,Brush.BrushConstruct,nil); +procedure PolygonPC(points: array of Point; c: GColor) := PolygonPFull(points,ColorBrush(c),Pen.PenConstruct); +procedure DrawPolygonPC(points: array of Point; c: GColor) := PolygonPFull(points,nil,ColorPen(c)); +procedure FillPolygonPC(points: array of Point; c: GColor) := PolygonPFull(points,ColorBrush(c),nil); + +procedure DrawTextP(x,y: real; text: string; angle,x0,y0: real) := TextPFull(x,y,text,angle,x0,y0); +procedure DrawTextPC(x,y: real; text: string; angle,x0,y0: real; c: GColor) := TextPFull(x,y,text,angle,x0,y0,c); + +procedure EllipseNew(x,y,r1,r2: real) + := InvokeVisual(DrawGeometryP,VE.Create(()->EllipseGeometry.Create(Pnt(x,y),r1,r2))); + +procedure Ellipse(x,y,rx,ry: real) := InvokeVisual(EllipseP,x,y,rx,ry); +procedure DrawEllipse(x,y,rx,ry: real) := InvokeVisual(DrawEllipseP,x,y,rx,ry); +procedure FillEllipse(x,y,rx,ry: real) := InvokeVisual(FillEllipseP,x,y,rx,ry); +procedure Ellipse(x,y,rx,ry: real; c: GColor) := InvokeVisual(EllipsePC,x,y,rx,ry,c); +procedure DrawEllipse(x,y,rx,ry: real; c: GColor) := InvokeVisual(DrawEllipsePC,x,y,rx,ry,c); +procedure FillEllipse(x,y,rx,ry: real; c: GColor) := InvokeVisual(FillEllipsePC,x,y,rx,ry,c); + +procedure Circle(x,y,r: real) := InvokeVisual(EllipseP,x,y,r,r); +procedure DrawCircle(x,y,r: real) := InvokeVisual(DrawEllipseP,x,y,r,r); +procedure FillCircle(x,y,r: real) := InvokeVisual(FillEllipseP,x,y,r,r); +procedure Circle(x,y,r: real; c: GColor) := InvokeVisual(EllipsePC,x,y,r,r,c); +procedure DrawCircle(x,y,r: real; c: GColor) := InvokeVisual(DrawEllipsePC,x,y,r,r,c); +procedure FillCircle(x,y,r: real; c: GColor) := InvokeVisual(FillEllipsePC,x,y,r,r,c); + +procedure Rectangle(x,y,w,h: real) := InvokeVisual(RectangleP,x,y,w,h); +procedure DrawRectangle(x,y,w,h: real) := InvokeVisual(DrawRectangleP,x,y,w,h); +procedure FillRectangle(x,y,w,h: real) := InvokeVisual(FillRectangleP,x,y,w,h); +procedure Rectangle(x,y,w,h: real; c: GColor) := InvokeVisual(RectanglePC,x,y,w,h,c); +procedure DrawRectangle(x,y,w,h: real; c: GColor) := InvokeVisual(DrawRectanglePC,x,y,w,h,c); +procedure FillRectangle(x,y,w,h: real; c: GColor) := InvokeVisual(FillRectanglePC,x,y,w,h,c); + +/// Рисует дугу окружности с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы angle1 и angle2 с осью OX (angle1 и angle2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки) +procedure Arc(x, y, r, angle1, angle2: real) := InvokeVisual(ArcP,x, y, r, angle1, angle2); +procedure Arc(x, y, r, angle1, angle2: real; c: GColor) := InvokeVisual(ArcPC,x, y, r, angle1, angle2, c); + +/// Рисует сектор окружности с центром в точке (x,y) и радиусом r, заключенной между двумя лучами, образующими углы angle1 и angle2 с осью OX (angle1 и angle2 – вещественные, задаются в градусах и отсчитываются против часовой стрелки) +procedure Sector(x, y, r, angle1, angle2: real) := InvokeVisual(SectorP,x, y, r, angle1, angle2); +procedure Pie(x, y, r, angle1, angle2: real) := InvokeVisual(SectorP,x, y, r, angle1, angle2); +procedure DrawSector(x, y, r, angle1, angle2: real) := InvokeVisual(DrawSectorP,x, y, r, angle1, angle2); +procedure FillSector(x, y, r, angle1, angle2: real) := InvokeVisual(FillSectorP,x, y, r, angle1, angle2); +procedure Sector(x, y, r, angle1, angle2: real; c: GColor) := InvokeVisual(SectorPC,x, y, r, angle1, angle2, c); +procedure DrawSector(x, y, r, angle1, angle2: real; c: GColor) := InvokeVisual(DrawSectorPC,x, y, r, angle1, angle2, c); +procedure FillSector(x, y, r, angle1, angle2: real; c: GColor) := InvokeVisual(FillSectorPC,x, y, r, angle1, angle2, c); + +procedure Line(x,y,x1,y1: real) := InvokeVisual(LineP,x,y,x1,y1); +procedure Line(x,y,x1,y1: real; c: GColor) := InvokeVisual(LinePC,x,y,x1,y1,c); +procedure MoveTo(x,y: real) := (Pen.fx,Pen.fy) := (x,y); +procedure LineTo(x,y: real); +begin + Line(Pen.fx,Pen.fy,x,y); + MoveTo(x,y); +end; +procedure MoveRel(dx,dy: real) := (Pen.fx,Pen.fy) := (Pen.fx + dx, Pen.fy + dy); +procedure LineRel(dx,dy: real) := LineTo(Pen.fx + dx, Pen.fy + dy); +procedure MoveOn(dx,dy: real) := MoveRel(dx,dy); +procedure LineOn(dx,dy: real) := LineRel(dx,dy); + +procedure PolyLine(points: array of Point) := InvokeVisual(PolyLineP,points); +procedure PolyLine(points: array of Point; c: GColor) := InvokeVisual(PolyLinePC,points,c); + +procedure Polygon(points: array of Point) := InvokeVisual(PolygonP,points); +procedure DrawPolygon(points: array of Point) := InvokeVisual(DrawPolygonP,points); +procedure FillPolygon(points: array of Point) := InvokeVisual(FillPolygonP,points); +procedure Polygon(points: array of Point; c: GColor) := InvokeVisual(PolygonPC,points,c); +procedure DrawPolygon(points: array of Point; c: GColor) := InvokeVisual(DrawPolygonPC,points,c); +procedure FillPolygon(points: array of Point; c: GColor) := InvokeVisual(FillPolygonPC,points,c); + + +procedure DrawImage(x,y: real; fname: string) := InvokeVisual(DrawImageP,x,y,fname); +procedure DrawImage(x,y,w,h: real; fname: string) := InvokeVisual(DrawImageWHP,x,y,w,h,fname); +procedure DrawImageUnscaled(x,y: real; fname: string) := InvokeVisual(DrawImageUnscaledP,x,y,fname); +procedure DrawVideo(x,y: real; fname: string) := InvokeVisual(DrawVideoP,x,y,fname); + +/// Ширина текста при выводе +function TextWidth(text: string) := InvokeReal(TextV.Create(text).TextWidth); +/// Высота текста при выводе +function TextHeight(text: string) := InvokeReal(TextV.Create(text).TextHeight); +/// Размер текста при выводе +function TextSize(text: string): Size := Invoke&(TextV.Create(text).TextSize); + +procedure TextOutHelper(x,y: real; text: string; angle: real; x0,y0: real) := InvokeVisual(DrawTextP,x,y,text,angle,x0,y0); +//procedure TextOut(x,y: real; number: integer) := TextOut(x,y,'' + number); +//procedure TextOut(x,y: real; number: real) := TextOut(x,y,'' + number); +procedure TextOutHelper(x,y: real; text: string; angle: real; c: GColor; x0,y0: real) := InvokeVisual(DrawTextPC,x,y,text,angle,x0,y0,c); +//procedure TextOut(x,y: real; number: integer; c: GColor) := TextOut(x,y,'' + number,c); +//procedure TextOut(x,y: real; number: real; c: GColor) := TextOut(x,y,'' + number,c); + +procedure DrawTextHelper(var x, y, x0, y0: real; w, h: real; text: string; align: Alignment := Alignment.Center); +begin + if h<0 then + begin + h := -h; + y -= h; + end; + if w<0 then + begin + w := -w; + x -= w; + end; + var sz := TextSize(text); + var dw,dh: real; + if CurrentCoordType = StandardCoords then + (dw,dh) := ((w-sz.Width)/2,(h-sz.Height)/2) + else + begin + var (szw,szh) := (sz.Width/GlobalScale,sz.Height/GlobalScale); + (dw,dh) := ((w-szw)/2,(h-szh)/2); + dh := h-dh; + end; +// Println(dw,dh); + case align of + Alignment.LeftTop: {ничего}; + Alignment.LeftCenter: begin y += dh; y0+=h/2 end; + Alignment.LeftBottom: begin y += 2*dh; y0+=h end; + Alignment.CenterTop: begin x += dw; x0 += w/2 end; + Alignment.Center: begin x += dw; y += dh; y0 += h/2; x0 += w/2 end; + Alignment.CenterBottom: begin x += dw; y += 2*dh; y0 += h; x0 += w/2 end; + Alignment.RightTop: begin x += 2*dw; x0 += w; end; + Alignment.RightCenter: begin x += 2*dw; y += dh; y0+=h/2; x0 += w; end; + Alignment.RightBottom: begin x += 2*dw; y += 2*dh; y0+=h; x0 += w; end; + end; + if CurrentCoordType = MathematicalCoords then + case align of + Alignment.LeftTop, Alignment.CenterTop, Alignment.RightTop: begin y += h; y0 += h end; + Alignment.LeftBottom, Alignment.CenterBottom, Alignment.RightBottom: begin y -= h; y0 -= h; end; + end; +end; +/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; text: string; align: Alignment; angle: real); +begin + var (x0,y0) := (x,y); + DrawTextHelper(x, y, x0, y0, w, h, text, align); + //FillCircle(x0,y0,0.1,Colors.Blue); + //FillCircle(x,y,0.1,Colors.Red); + TextOutHelper(x,y,text,angle,x0,y0) +end; +/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; text: string; c: GColor; align: Alignment; angle: real); +begin + var (x0,y0) := (x,y); + DrawTextHelper(x, y, x0, y0, w, h, text, align); + //FillCircle(x0,y0,0.1,Colors.Blue); + //FillCircle(x,y,0.1,Colors.Red); + TextOutHelper(x,y,text,angle,c,x0,y0) +end; +/// Выводит целое в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; number: integer; align: Alignment; angle: real) := DrawText(x, y, w, h, '' + number,align,angle); +/// Выводит вещественное в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; number: real; align: Alignment; angle: real) := DrawText(x, y, w, h, '' + number,align,angle); +/// Выводит строку в прямоугольник +procedure DrawText(r: GRect; text: string; align: Alignment; angle: real) := DrawText(r.x,r.y,r.Width,r.Height,text,align,angle); +/// Выводит целое в прямоугольник +procedure DrawText(r: GRect; number: integer; align: Alignment; angle: real) := DrawText(r.x,r.y,r.Width,r.Height,number,align,angle); +/// Выводит вещественное в прямоугольник +procedure DrawText(r: GRect; number: real; align: Alignment; angle: real) := DrawText(r.x,r.y,r.Width,r.Height,number,align,angle); +/// Выводит целое в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; number: integer; c: GColor; align: Alignment; angle: real) := DrawText(x, y, w, h, '' + number,c,align,angle); +/// Выводит вещественное в прямоугольник к координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; number: real; c: GColor; align: Alignment; angle: real) := DrawText(x, y, w, h, '' + number,c,align,angle); +/// Выводит строку в прямоугольник +procedure DrawText(r: GRect; text: string; c: GColor; align: Alignment; angle: real) := DrawText(r.x,r.y,r.Width,r.Height,text,c,align,angle); +/// Выводит целое в прямоугольник +procedure DrawText(r: GRect; number: integer; c: GColor; align: Alignment; angle: real) := DrawText(r.x,r.y,r.Width,r.Height,number,c,align,angle); +/// Выводит вещественное в прямоугольник +procedure DrawText(r: GRect; number: real; c: GColor; align: Alignment; angle: real) := DrawText(r.x,r.y,r.Width,r.Height,number,c,align,angle); + +{function ConvertAlign(align: Alignment): Alignment; +begin + Result := align; + case align of + Alignment.LeftTop: Result := Alignment.RightBottom; + Alignment.LeftCenter: Result := Alignment.RightCenter; + Alignment.LeftBottom: Result := Alignment.RightTop; + Alignment.CenterTop: Result := Alignment.CenterBottom; + Alignment.CenterBottom: Result := Alignment.CenterTop; + Alignment.RightTop: Result := Alignment.LeftBottom; + Alignment.RightCenter: Result := Alignment.LeftCenter; + Alignment.RightBottom: Result := Alignment.LeftTop; + end; +end;} + +procedure TextOut(x, y: real; text: string; align: Alignment; angle: real) := DrawText(x, y, 0, 0, text,{ConvertAlign(}align{)},angle); +procedure TextOut(x, y: real; text: string; c: GColor; align: Alignment; angle: real) := DrawText(x, y, 0, 0, text, c,{ConvertAlign(}align{)},angle); +procedure TextOut(x, y: real; text: integer; align: Alignment; angle: real) := TextOut(x, y, ''+text,align,angle); +procedure TextOut(x, y: real; text: integer; c: GColor; align: Alignment; angle: real) := TextOut(x, y, ''+text, c,align,angle); +procedure TextOut(x, y: real; text: real; align: Alignment; angle: real) := TextOut(x, y, ''+text,align,angle); +procedure TextOut(x, y: real; text: real; c: GColor; align: Alignment; angle: real) := TextOut(x, y, ''+text, c,align,angle); + + +type + FS = auto class + mx, my, a, min, max: real; + x1, y1: real; + f: real-> real; + + function Apply(x: real) := Pnt(x1 + mx * (x - a), y1 + my * (max - f(x))); + function RealToScreenX(x: real) := x1 + mx * (x - a); + function RealToScreenY(y: real) := y1 - my * (y + min); + end; + +/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом параметрами x,y,w,h, +procedure DrawGraph(f: real-> real; a, b, min, max, x, y, w, h: real); +begin + var coefx := w / (b - a); + var coefy := h / (max - min); + + var fso := new FS(coefx, coefy, a, min, max, x, y, f); + + // Линии + {Pen.Color := Color.LightGray; + + var hx := 1.0; + var xx := hx; + while xxa do + begin + var x0 := fso.RealToScreenX(xx); + Line(x0,y1,x0,y2); + xx -= hx + end; + + var hy := 1.0; + var yy := hy; + while yymin do + begin + var y0 := fso.RealToScreenY(yy); + Line(x1,y0,x2,y0); + yy -= hy + end; + + // Оси + Pen.Color := Color.Blue; + + var x0 := fso.RealToScreenX(0); + var y0 := fso.RealToScreenY(0); + + Line(x0,y1,x0,y2); + Line(x1,y0,x2,y0);} + + // График + + Pen.Color := Colors.Black; + Rectangle(x, y, w, h); + + Pen.Color := Colors.Black; + var n := Round(w / 3); + Polyline(Partition(a, b, n).Select(fso.Apply).ToArray); +end; + +procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect) := DrawGraph(f, a, b, min, max, r.X, r.Y, r.Width, r.Height); + +procedure DrawGraph(f: real -> real; a, b, min, max: real) := DrawGraph(f, a, b, min, max, Window.ClientRect); + +procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real); +begin + var n := Round(w / 3); + var q := Partition(a, b, n); + DrawGraph(f, a, b, q.Min(f), q.Max(f), x, y, w, h) +end; + +procedure DrawGraph(f: real -> real; a, b: real; r: GRect) := DrawGraph(f, a, b, r.X, r.Y, r.Width, r.Height); + +procedure DrawGraph(f: real -> real; r: GRect) := DrawGraph(f, -5, 5, r); + +procedure DrawGraph(f: real -> real; a, b: real) := DrawGraph(f, a, b, 0, 0, Window.Width - 1, Window.Height - 1); + +procedure DrawGraph(f: real -> real) := DrawGraph(f, -5, 5); + +function GraphWindowTypeGetLeftP: real; +begin + Result := 0; + foreach var p in MainDockPanel.Children do + if (p is FrameworkElement) and (p<>host) then + begin + var d := DockPanel.GetDock(FrameworkElement(p)); + if d=Dock.Left then + Result += FrameworkElement(p).Width; + end; +end; + +function GraphWindowTypeGetTopP: real; +begin + Result := 0; + foreach var p in MainDockPanel.Children do + if (p is FrameworkElement) and (p<>host) then + begin + var d := DockPanel.GetDock(FrameworkElement(p)); + if d=Dock.Top then + Result += FrameworkElement(p).Height; + end; +end; + +function GraphWindowType.GetLeft := InvokeReal(GraphWindowTypeGetLeftP); +function GraphWindowType.GetTop := InvokeReal(GraphWindowTypeGetTopP); + +function GraphWindowTypeGetWidthP: real; +begin + {if host.DataContext = nil then + Result := 0 + else Result := Size(host.DataContext).Width;} + Result := Window.Width; + foreach var p in MainDockPanel.Children do + if (p is FrameworkElement) and (p<>host) then + begin + var d := DockPanel.GetDock(FrameworkElement(p)); + if (d=Dock.Left) or (d=Dock.Right) then + Result -= FrameworkElement(p).Width; + end; +end; +function GraphWindowType.GetWidth := InvokeReal(GraphWindowTypeGetWidthP); + +function GraphWindowTypeGetHeightP: real; +begin + {if host.DataContext = nil then + Result := 0 + else Result := Size(host.DataContext).Height;} + Result := Window.Height; + foreach var p in MainDockPanel.Children do + if (p is FrameworkElement) and (p<>host) then + begin + var d := DockPanel.GetDock(FrameworkElement(p)); + if (d=Dock.Top) or (d=Dock.Bottom) then + Result -= FrameworkElement(p).Height; + end; +end; +function GraphWindowType.GetHeight := InvokeReal(GraphWindowTypeGetHeightP); + +procedure SaveWindowP(canvas: FrameworkElement; filename: string); +begin + var (scalex,scaley) := ScaleToDevice; + var (dpiX,dpiY) := (scalex * 96, scaley * 96); + + var sz := Size(host.DataContext); + + var bmp := new RenderTargetBitmap(Round(sz.Width*scalex), Round(sz.Height*scaley), dpiX, dpiY, PixelFormats.Pbgra32); + + bmp.Render(canvas); + + var ext := ExtractFileExt(filename).ToLower; + + var encoder: BitmapEncoder; + case ext of + '.png': encoder := new PngBitmapEncoder(); + '.jpg': encoder := new JpegBitmapEncoder(); + '.bmp': encoder := new BmpBitmapEncoder(); + '.gif': encoder := new GifBitmapEncoder(); + '.tiff': encoder := new TiffBitmapEncoder(); + else encoder := new PngBitmapEncoder(); + end; + + encoder.Frames.Add(BitmapFrame.Create(bmp)); + var fil := System.IO.File.Create(filename); + encoder.Save(fil); + fil.Close(); +end; + +procedure GraphWindowType.Save(fname: string) := Invoke(SaveWindowP,host,fname); + +procedure GraphWindowType.Load(fname: string) := DrawImageUnscaled(0,0,fname); + +procedure GraphWindowType.Fill(fname: string); +begin + //FillWindow(fname); +end; + +procedure WindowTypeWPF.Save(fname: string) := GraphWindow.Save(fname); + +procedure WindowTypeWPF.Load(fname: string) := GraphWindow.Load(fname); + +procedure WindowTypeClearP := begin Host.children.Clear; CountVisuals := 0; end; +procedure WindowTypeWPF.Clear := Invoke(WindowTypeClearP); + +function XMin := -XOrigin/GlobalScale; +function XMax := (Window.Width-XOrigin)/GlobalScale; +function YMin := -(Window.Height-YOrigin)/GlobalScale; +function YMax := YOrigin/GlobalScale; + +procedure DrawGridP; +begin + if CurrentCoordType = StandardCoords then + raise new Exception('Рисование координатной сетки возможно только в математическом режиме'); + + var xfrom := Round(XMin); + var xto := Round(XMax); + var yfrom := Round(YMin); + var yto := Round(YMax); + + Range(yfrom,yto).ForEach(y->Line(XMin,y,XMax,y,Colors.LightGray)); + Range(xfrom,xto).ForEach(x->Line(x,YMin,x,YMax,Colors.LightGray)); + Line(XMin,0,XMax,0); + Line(0,YMin,0,YMax); + + //Range(yfrom,yto).Where(y->y<>0).ForEach(y->TextOut(xmin+0.1,y,y,Alignment.LeftCenter)); + //Range(xfrom,xto).Where(x->x<>0).ForEach(x->TextOut(x,ymin+0.05,x,Alignment.CenterBottom)); +end; +procedure DrawGrid := Invoke(DrawGridP); + +var StandardCoordsPenWidthSave: real; + +procedure SetMathematicCoordsScaleP(x0,y0,scale: real); +begin + if CurrentCoordType = StandardCoords then + StandardCoordsPenWidthSave := Pen.Width; + CurrentCoordType := MathematicalCoords; + XOrigin := x0; + YOrigin := y0; + GlobalScale := scale; + var m: Transform := new MatrixTransform(scale,0,0,-scale,x0,y0); + Host.RenderTransform := m; + Pen.Width := StandardCoordsPenWidthSave / scale; +end; +procedure SetMathematicCoordsScale(x0,y0,scale: real) := Invoke(SetMathematicCoordsScaleP,x0,y0,scale); + +procedure SetMathematicCoordsP(x1,x2: real; drawcoords: boolean); +begin + if CurrentCoordType = StandardCoords then + StandardCoordsPenWidthSave := Pen.Width; + Window.Clear; + CurrentCoordType := MathematicalCoords; + // x1 0 x2 + // 0 x0 Window.Width + GlobalScale := Window.Width/(x2-x1); + XOrigin := -x1*GlobalScale; + YOrigin := Window.Height/2; + SetMathematicCoordsScaleP(XOrigin,YOrigin,GlobalScale); + if drawcoords then + DrawGridP +end; +procedure SetMathematicCoordsP1(x1,x2,ymin: real; drawcoords: boolean); +begin + if CurrentCoordType = StandardCoords then + StandardCoordsPenWidthSave := Pen.Width; + Window.Clear; + CurrentCoordType := MathematicalCoords; + // x1 0 x2 + // 0 x0 Window.Width + GlobalScale := Window.Width/(x2-x1); + XOrigin := -x1*GlobalScale; + // -ymin*scale - сколько надо отступить от низа окна + // Window.Height + ymin*scale + YOrigin := Window.Height + ymin*GlobalScale; + SetMathematicCoordsScaleP(XOrigin,YOrigin,GlobalScale); + if drawcoords then + DrawGridP +end; +procedure SetMathematicCoords(x1: real; x2: real; drawcoords: boolean) := Invoke(SetMathematicCoordsP,x1,x2,drawcoords); +procedure SetMathematicCoords(x1,x2,ymin: real; drawcoords: boolean) := Invoke(SetMathematicCoordsP1,x1,x2,ymin,drawcoords); + +procedure SetStandardCoordsP(scale: real := 1.0; x0: real := 0; y0: real := 0); +begin + Window.Clear; + if CurrentCoordType = MathematicalCoords then + Pen.Width := StandardCoordsPenWidthSave; + CurrentCoordType := StandardCoords; + XOrigin := x0; + YOrigin := y0; + GlobalScale := scale; + var m: Transform := new MatrixTransform(scale,0,0,scale,x0,y0); + Host.RenderTransform := m; + //Pen.Width := Pen.Width * scale; // нет! +end; +procedure SetStandardCoords(scale,x0,y0: real) := Invoke(SetStandardCoordsP,scale,x0,y0); +procedure SetStandardCoordsSharpLinesP(x0,y0: real); +begin + var (sx,sy) := ScaleToDevice; + if Round(Pen.Width) mod 2 = 1 then + SetStandardCoordsP(1/sx,(x0+0.5)/sx,(y0+0.5)/sy) + else SetStandardCoordsP(1/sx,x0/sx,y0/sy) +end; +procedure SetStandardCoordsSharpLines(x0,y0: real) := Invoke(SetStandardCoordsSharpLinesP,x0,y0); + +/// --- SystemMouseEvents +procedure SystemOnMouseDown(sender: Object; e: MouseButtonEventArgs); +begin + var mb := 0; + var p := e.GetPosition(host); + if e.LeftButton = MouseButtonState.Pressed then + mb := 1 + else if e.RightButton = MouseButtonState.Pressed then + mb := 2; + if OnMouseDown <> nil then + OnMouseDown(p.x, p.y, mb); +end; + +procedure SystemOnMouseUp(sender: Object; e: MouseButtonEventArgs); +begin + var mb := 0; + var p := e.GetPosition(host); + if e.LeftButton = MouseButtonState.Pressed then + mb := 1 + else if e.RightButton = MouseButtonState.Pressed then + mb := 2; + if OnMouseUp <> nil then + OnMouseUp(p.x, p.y, mb); +end; + +procedure SystemOnMouseMove(sender: Object; e: MouseEventArgs); +begin + var mb := 0; + var p := e.GetPosition(host); + if e.LeftButton = MouseButtonState.Pressed then + mb := 1 + else if e.RightButton = MouseButtonState.Pressed then + mb := 2; + if OnMouseMove <> nil then + OnMouseMove(p.x, p.y, mb); +end; + +/// --- SystemKeyEvents +procedure SystemOnKeyDown(sender: Object; e: KeyEventArgs) := + if OnKeyDown<>nil then + OnKeyDown(e.Key); + +procedure SystemOnKeyUp(sender: Object; e: KeyEventArgs) := + if OnKeyUp<>nil then + OnKeyUp(e.Key); + +procedure SystemOnResize(sender: Object; e: SizeChangedEventArgs) := + if OnResize<>nil then + OnResize(); + +///---------------------------------------------------------------------- + +{procedure RenderFrame(s: Object; e: System.EventArgs); +begin +end;} + +var OnDraw: procedure := nil; +var OnDraw1: procedure(frame: integer) := nil; + +var FrameRate := 60; // кадров в секунду. Можно меньше! +var LastUpdatedTime := new System.TimeSpan(integer.MinValue); + +var FrameNum := 0; + +procedure RenderFrame(o: Object; e: System.EventArgs); +begin + if (OnDraw<>nil) or (OnDraw1<>nil) then + begin + var e1 := RenderingEventArgs(e).RenderingTime; + var dt := e1 - LastUpdatedTime; + var delta := 1000/Framerate; // через какое время обновлять + if dt.TotalMilliseconds < delta then + exit + else LastUpdatedTime := e1; + FrameNum += 1; + Window.Clear; + CountVisuals := integer.MinValue; // чтобы не было паузы после 1000 объектов + end; + if OnDraw<>nil then + OnDraw() + else if OnDraw1<>nil then + OnDraw1(FrameNum); +end; + +procedure BeginFrameBasedAnimation(Draw: procedure; frate: integer); +begin + FrameNum := 0; + OnDraw := Draw; + OnDraw1 := nil; + FrameRate := frate; +end; + +procedure BeginFrameBasedAnimation(Draw: procedure(frame: integer); frate: integer); +begin + FrameNum := 0; + OnDraw1 := Draw; + OnDraw := nil; + FrameRate := frate; +end; + +procedure EndFrameBasedAnimation; +begin + CountVisuals := 0; + OnDraw := nil; + OnDraw1 := nil; + FrameRate := 60; +end; + +{procedure AddGraphWindow; +begin + host := new MyVisualHost(); + host.ClipToBounds := True; + host.SizeChanged += (s,e) -> + begin + var sz := e.NewSize; + host.DataContext := sz; + end; + // Всегда последнее + MainDockPanel.children.Add(host); +end;} + +var mre := new ManualResetEvent(false); + +type +GraphWPFWindow = class(GMainWindow) +public + procedure InitMainGraphControl; override; + begin + host := new MyVisualHost(); + //host.ClipToBounds := True; + host.SizeChanged += (s,e) -> + begin + var sz := e.NewSize; + host.DataContext := sz; + end; + // Всегда последнее + var g := Content as DockPanel; + g.children.Add(host); + end; + + procedure InitWindowProperties; override; + begin + Title := 'Графика WPF'; + var (w,h) := (800,600); + + (Width, Height) := (w + wplus, h + hplus); + WindowStartupLocation := System.Windows.WindowStartupLocation.CenterScreen; + end; + + procedure InitGlobals; override; + begin + Brush := new BrushType; + Pen := new PenType; + Font := new FontType; + Window := new WindowTypeWPF; + GraphWindow := new GraphWindowType; + end; + + procedure InitHandlers; override; + begin + Closed += procedure(sender,e) -> begin Halt; end; + MouseDown += SystemOnMouseDown; + MouseUp += SystemOnMouseUp; + MouseMove += SystemOnMouseMove; + KeyDown += SystemOnKeyDown; + KeyUp += SystemOnKeyUp; + SizeChanged += SystemOnResize; + + CompositionTarget.Rendering += RenderFrame; + + Loaded += (o,e) -> mre.Set(); + + {PreviewMouseDown += (o,e) -> SystemOnMouseDown(o,e); + PreviewMouseUp += (o,e) -> SystemOnMouseUp(o,e); + PreviewMouseMove += (o,e) -> SystemOnMouseMove(o,e); + + PreviewKeyDown += (o,e)-> SystemOnKeyDown(o,e); + PreviewKeyUp += (o,e)-> SystemOnKeyUp(o,e); + + Closed += procedure(sender, e) -> begin Halt; end;} + end; + + + /// --- SystemKeyEvents + procedure SystemOnKeyDown(sender: Object; e: System.Windows.Input.KeyEventArgs); + begin + if GraphWPF.OnKeyDown <> nil then + GraphWPF.OnKeyDown(e.Key); + e.Handled := True; + end; + + procedure SystemOnKeyUp(sender: Object; e: System.Windows.Input.KeyEventArgs); + begin + if GraphWPF.OnKeyUp <> nil then + GraphWPF.OnKeyUp(e.Key); + e.Handled := True; + end; + + /// --- SystemMouseEvents + procedure SystemOnMouseDown(sender: Object; e: System.Windows.Input.MouseButtonEventArgs); + begin + var mb := 0; + var p := e.GetPosition(nil{hvp}); + if e.LeftButton = MouseButtonState.Pressed then + mb := 1 + else if e.RightButton = MouseButtonState.Pressed then + mb := 2; + if GraphWPF.OnMouseDown <> nil then + GraphWPF.OnMouseDown(p.x, p.y, mb); + end; + + procedure SystemOnMouseUp(sender: Object; e: MouseButtonEventArgs); + begin + var mb := 0; + var p := e.GetPosition(nil{hvp}); + if e.LeftButton = MouseButtonState.Pressed then + mb := 1 + else if e.RightButton = MouseButtonState.Pressed then + mb := 2; + if GraphWPF.OnMouseUp <> nil then + GraphWPF.OnMouseUp(p.x, p.y, mb); + end; + + procedure SystemOnMouseMove(sender: Object; e: MouseEventArgs); + begin + var mb := 0; + var p := e.GetPosition(nil{hvp}); + if e.LeftButton = MouseButtonState.Pressed then + mb := 1 + else if e.RightButton = MouseButtonState.Pressed then + mb := 2; + if GraphWPF.OnMouseMove <> nil then + GraphWPF.OnMouseMove(p.x, p.y, mb); + end; + +end; + + +{procedure InitApp1; +begin + app := new Application(); + + app.Dispatcher.UnhandledException += (o,e) -> begin + Println(e.Exception.InnerException); + halt; + end; + MainWindow := new GWindow; + + MainDockPanelF := new DockPanel; + MainDockPanelF.LastChildFill := True; + MainWindow.Content := MainDockPanelF; + + AddGraphWindow; + + host := new MyVisualHost(); + MainWindow.Content := host; + + Brush := new BrushType; + Pen := new PenType; + Font := new FontType; + Window := new WindowType; + GraphWindow := new GraphWindowType; + + MainWindow.Title := 'Графика WPF'; + var (w,h) := (800,600); + + (MainWindow.Width, MainWindow.Height) := (w + wplus, h + hplus); + MainWindow.WindowStartupLocation := WindowStartupLocation.CenterScreen; + + //MainWindow.Show; + MainWindow.Closed += procedure(sender,e) -> begin Halt; end; + MainWindow.MouseDown += SystemOnMouseDown; + MainWindow.MouseUp += SystemOnMouseUp; + MainWindow.MouseMove += SystemOnMouseMove; + MainWindow.KeyDown += SystemOnKeyDown; + MainWindow.KeyUp += SystemOnKeyUp; + MainWindow.SizeChanged += SystemOnResize; + + CompositionTarget.Rendering += RenderFrame; + + MainWindow.Loaded += (o,e) -> mre.Set(); + + app.Run(MainWindow); +end;} + +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 GraphWPFWindow; + + 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. \ No newline at end of file diff --git a/TestSuite/formatter_tests/input/Program1200.pas b/TestSuite/formatter_tests/input/Program1200.pas new file mode 100644 index 000000000..f6c87ef4b --- /dev/null +++ b/TestSuite/formatter_tests/input/Program1200.pas @@ -0,0 +1,4 @@ +begin + var b: byte; + b += 1;b += 1; +end. \ No newline at end of file diff --git a/TestSuite/formatter_tests/input/graph3d.pas b/TestSuite/formatter_tests/input/graph3d.pas index ea0587a05..893a61f81 100644 --- a/TestSuite/formatter_tests/input/graph3d.pas +++ b/TestSuite/formatter_tests/input/graph3d.pas @@ -1,64 +1,3158 @@ -// Пример из пакета KuMir/PMir -// Публикуется практически без изменений -// Дорог как память :) -Uses GraphABC; +// 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; -var Xmin,Xmax,Xstep: real; - Ymin,Ymax,Ystep,asp: real; - dx: integer; +{$reference System.Xml.dll} +{$reference HelixToolkit.Wpf.dll} -function f(x,y:real): integer; -var r: real; -begin - r := x*x+y*y+1; - f := round(5*asp*(cos(r)/r+0.1)) -end; +uses GraphWPFBase; -procedure gr(N : integer); -var X,Y: real; - i,j,k,Z0,dy: integer; - pred: array [1..100] of integer; - jj,maxX,maxY: integer; -begin - Xmin := -4; - Xmax := 4; - Ymin := -3; - Ymax := 3; - maxX := 600; - maxY := 400; - Xstep := dx*(Xmax-Xmin)/maxX; - X := Xmin; - Ystep := (Ymax-Ymin)/N; - Y := Ymin; - dy := maxY div N div 2; - asp := maxY/8; - for i := 1 to N do - begin - pred[i] := maxY-i*dy-f(X,Y); - Y := Y + Ystep - end; - for jj := 1 to maxX div dx do - begin - j := jj*dx; - X := X + Xstep; - Y := Ymin; Z0 := maxY; - for i := 1 to N do +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; + +type + Key = System.Windows.Input.Key; + Colors = System.Windows.Media.Colors; + GColor = System.Windows.Media.Color; + GMaterial = System.Windows.Media.Media3D.Material; + GCamera = System.Windows.Media.Media3D.ProjectionCamera; + GRect = System.Windows.Rect; + CameraMode = HelixToolkit.Wpf.CameraMode; + TupleInt3 = (integer, integer, integer); + TupleReal3 = (real, real, real); + Point3D = Point3D; + Vector3D = Vector3D; + Point = System.Windows.Point; + Ray3D = HelixToolkit.Wpf.Ray3D; + Line3D = class(Ray3D) end; + Plane3D = HelixToolkit.Wpf.Plane3D; + Matrix3D = System.Windows.Media.Media3D.Matrix3D; + +var + hvp: HelixViewport3D; + LightsGroup: Model3DGroup; + gvl: GridLinesVisual3D; + /// Событие нажатия на кнопку мыши. (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); + +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 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); + + +var + OrtX := V3D(1, 0, 0); + OrtY := V3D(0, 1, 0); + OrtZ := V3D(0, 0, 1); + Origin: Point3D := P3D(0, 0, 0); + EmptyColor := ARGB(0, 0, 0, 0); + +function ChangeOpacity(Self: GColor; value: integer); extensionmethod := ARGB(value, Self.R, Self.G, Self.B); + +function MoveX(Self: Point3D; dx: real); extensionmethod := P3D(Self.x + dx, Self.y, Self.z); + +function MoveY(Self: Point3D; dy: real); extensionmethod := P3D(Self.x, Self.y + dy, Self.z); + +function MoveZ(Self: Point3D; dz: real); extensionmethod := P3D(Self.x, Self.y, Self.z + dz); + +function Move(Self: Point3D; dx, dy, dz: real); extensionmethod := P3D(Self.x + dx, Self.y + dy, Self.z + dz); + +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): Point3DCollection; extensionmethod := new Point3DCollection(ar); + +function RandomColor := RGB(Random(256), Random(256), Random(256)); + +function GrayColor(b: byte) := RGB(b, b, b); + +function RandomSolidBrush := new SolidColorBrush(RandomColor); + +function wplus := SystemParameters.WindowResizeBorderThickness.Left + SystemParameters.WindowResizeBorderThickness.Right; + +function hplus := SystemParameters.WindowCaptionHeight + SystemParameters.WindowResizeBorderThickness.Top + SystemParameters.WindowResizeBorderThickness.Bottom; + +type + IMHelper = auto class + fname: string; + M, N: real; + function ImageMaterial: Material; begin - k := maxY-i*dy-f(X,Y); - if k 1) or (N <> 1) then + b.TileMode := TileMode.Tile; + Result := new DiffuseMaterial(b); + end; + end; + DEMHelper = auto class + c: Color; + function Diffuse := new DiffuseMaterial(new SolidColorBrush(c)); + function Emissive := new EmissiveMaterial(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: real := 1; N: real := 1): Material := Invoke&(IMHelper.Create(fname, M, N).ImageMaterial); + +function DiffuseMaterial(c: Color): Material := Invoke&(DEMHelper.Create(c).Diffuse); + +function SpecularMaterial(specularBrightness: byte; specularpower: real := 100): Material := Invoke&(SpMHelper.Create(RGB(specularBrightness, specularBrightness, specularBrightness), specularpower).SpecularMaterial); + +function SpecularMaterial(c: Color; specularpower: real := 100): Material := Invoke&(SpMHelper.Create(c, specularpower).SpecularMaterial); + +function EmissiveMaterial(c: Color): Material := Invoke&(DEMHelper.Create(c).Emissive); + +function RainbowMaterial: Material := Materials.Rainbow; + +type + ///!# + Materials = class + class function Diffuse(c: Color) := DiffuseMaterial(c); + class function Specular(specularBrightness: byte := 255; specularpower: real := 100) := SpecularMaterial(specularBrightness, specularpower); + class function Specular(c: Color; specularpower: real := 100) := SpecularMaterial(c, specularpower); + class function Emissive(c: Color) := EmissiveMaterial(c); + class function Rainbow := RainbowMaterial; + end; + + 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; + + +function operator+(a, b: Material): Material; extensionmethod := Invoke&(GMHelper.Create(a, b).GroupMaterial); + +type + ///!# + View3DT = class + private + procedure SetSCSP(v: boolean) := hvp.ShowCoordinateSystem := v; + procedure SetSCS(v: boolean) := Invoke(SetSCSP, v); + function GetSCS: boolean := InvokeBoolean(()->hvp.ShowCoordinateSystem); + + 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&(()->hvp.CameraMode); + + procedure SetBCP(v: GColor) := hvp.Background := new SolidColorBrush(v); + procedure SetBC(v: GColor) := Invoke(SetBCP, v); + function GetBC: GColor := Invoke&(()->(hvp.Background as SolidColorBrush).Color); + procedure ExportP(fname: string) := hvp.Viewport.Export(fname, hvp.Background); + public + property ShowCoordinateSystem: boolean read GetSCS write SetSCS; + property ShowGridLines: boolean read GetSGL write SetSGL; + property ShowCameraInfo: boolean read GetSCI write SetSCI; + 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; + + procedure Save(fname: string) := Invoke(ExportP, fname); + end; + + ///!# + 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&(()->Cam.Position); + procedure SetLDP(v: Vector3D) := Cam.LookDirection := v; + procedure SetLD(v: Vector3D) := Invoke(SetLDP, v); + function GetLD: Vector3D := Invoke&(()->Cam.LookDirection); + procedure SetUDP(v: Vector3D) := Cam.UpDirection := v; + procedure SetUD(v: Vector3D) := Invoke(SetUDP, v); + function GetUD: Vector3D := Invoke&(()->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; + procedure MoveOn(x,y,z: real) := Invoke(MoveOnP,x,y,z); + 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 + private + function GetC: integer := Invoke&(()->LightsGroup.Children.Count); + //procedure SetLDP(v: Vector3D) := Cam.LookDirection := v; + //procedure SetLD(v: Vector3D) := Invoke(SetLDP, v); + //function GetLD: Vector3D := Invoke&(()->Cam.LookDirection); + public + property Count: integer read GetC; + 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; + + ///!# + 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 + property Width: real read GetW write SetW; + 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; + +var + View3D: View3DT; + Window: WindowType; + Camera: CameraType; + Lights: LightsType; + GridLines: GridLinesType; + +function operator implicit(c: GColor): GMaterial; extensionmethod := Materialhelper.CreateMaterial(c); + +type + MyAnimation = class; + ObjectWithChildren3D = 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&(()->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); + + property X: real read GetX write SetX; + property Y: real read GetY write SetY; + property Z: real read GetZ write SetZ; + + function MoveTo(xx, yy, zz: real): Object3D := + Invoke&(()->begin + transltransform.OffsetX += xx - Self.X; + transltransform.OffsetY += yy - Self.Y; + transltransform.OffsetZ += zz - Self.Z; + Result := Self; + end); + function MoveTo(p: Point3D) := MoveTo(p.X, p.y, p.z); + function MoveOn(dx, dy, dz: real) := MoveTo(x + dx, y + dy, z + dz); + function MoveOn(v: Vector3D) := MoveOn(v.X, v.Y, v.Z); + function MoveOnX(dx: real) := MoveOn(dx, 0, 0); + function MoveOnY(dy: real) := MoveOn(0, dy, 0); + function MoveOnZ(dz: real) := MoveOn(0, 0, dz); + property Color: GColor read GetColor write SetColor; virtual; + private + procedure MoveToProp(p: Point3D) := MoveTo(p); + + ///---------------------------------- Эксперимент - Position для анимации -------------- + (*public + class PositionProperty: DependencyProperty; + private + procedure SetPositionT(value: Point3D); + begin + MoveTo(value.X,value.Y,value.Z); + SetValue(PositionProperty, value); + end; + procedure SetPosition(value: Point3D) := Invoke(SetPositionT,value); + function GetPosition: Point3D := GetPos; + public + class constructor; + begin + PositionProperty := DependencyProperty.Register('Position1', typeof (Point3D), typeof (Object3D), nil); + end; + + property Position1: Point3D read GetPosition write SetPosition; *) + ///---------------------------------- Конец эксперимента + + public + property Position: Point3D read GetPos write MoveToProp; + + function Scale(f: real): Object3D := + Invoke&(()->begin + scaletransform.ScaleX *= f; + scaletransform.ScaleY *= f; + scaletransform.ScaleZ *= f; + Result := Self; + end); + function ScaleX(f: real): Object3D := + Invoke&(()->begin + scaletransform.ScaleX *= f; + Result := Self; + end); + function ScaleY(f: real): Object3D := + Invoke&(()->begin + scaletransform.ScaleY *= f; + Result := Self; + end); + function ScaleZ(f: real): Object3D := + Invoke&(()->begin + scaletransform.ScaleZ *= f; + Result := Self; + end); + /// Поворот на угол angle вокруг оси axis + function Rotate(axis: Vector3D; angle: real): Object3D := + Invoke&(()->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&(()->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); + function AnimMoveTo(x, y, z: real; seconds: real; Completed: procedure): MyAnimation; + function AnimMoveTo(x, y, z: real; seconds: real := 1): MyAnimation := AnimMoveTo(x,y,z,seconds,nil); + + function AnimMoveTo(p: Point3D; seconds: real; Completed: procedure) := AnimMoveTo(p.x, p.y, p.z, seconds, Completed); + function AnimMoveTo(p: Point3D; seconds: real := 1) := AnimMoveTo(p.x, p.y, p.z, seconds, nil); + + function AnimMoveTrajectory(a: sequence of Point3D; seconds: real; Completed: procedure): MyAnimation; + function AnimMoveTrajectory(a: sequence of Point3D; seconds: real := 1): MyAnimation := AnimMoveTrajectory(a,seconds,nil); + + //function AnimMoveToP3D(x,y,z: real; seconds: real := 1): MyAnimation; - не получилось! Свойство не анимируется! + function AnimMoveOn(dx, dy, dz: real; seconds: real; Completed: procedure): MyAnimation; + function AnimMoveOn(dx, dy, dz: real; seconds: real := 1): MyAnimation := AnimMoveOn(dx,dy,dz,seconds,nil); + + function AnimMoveOn(v: Vector3D; seconds: real; Completed: procedure) := AnimMoveOn(v.x, v.y, v.z, seconds, Completed); + function AnimMoveOn(v: Vector3D; seconds: real := 1) := AnimMoveOn(v.x, v.y, v.z, seconds, nil); + + // Что-то одна версия с параметрами по умолчанию не на всех компьютерах срабатывает, поэтому сделал без параметров по умолчанию + function AnimMoveOnX(dx: real; seconds: real; Completed: procedure) := AnimMoveOn(dx, 0, 0, seconds, Completed); + function AnimMoveOnX(dx: real; seconds: real) := AnimMoveOnX(dx, seconds, nil); + function AnimMoveOnX(dx: real) := AnimMoveOnX(dx, 1, nil); + + function AnimMoveOnY(dy: real; seconds: real; Completed: procedure) := AnimMoveOn(0, dy, 0, seconds, Completed); + function AnimMoveOnY(dy: real; seconds: real) := AnimMoveOnY(dy, seconds, nil); + function AnimMoveOnY(dy: real) := AnimMoveOnY(dy, 1, nil); + + function AnimMoveOnZ(dz: real; seconds: real; Completed: procedure) := AnimMoveOn(0, 0, dz, seconds, Completed); + function AnimMoveOnZ(dz: real; seconds: real) := AnimMoveOnZ(dz, seconds, nil); + function AnimMoveOnZ(dz: real) := AnimMoveOnZ(dz, 1, nil); + + function AnimScale(sc: real; seconds: real; Completed: procedure): MyAnimation; + function AnimScaleX(sc: real; seconds: real; Completed: procedure): MyAnimation; + function AnimScaleY(sc: real; seconds: real; Completed: procedure): MyAnimation; + function AnimScaleZ(sc: real; seconds: real; Completed: procedure): MyAnimation; + + function AnimScale(sc: real; seconds: real := 1): MyAnimation := AnimScale(sc,seconds,nil); + function AnimScaleX(sc: real; seconds: real := 1): MyAnimation := AnimScale(sc,seconds,nil); + function AnimScaleY(sc: real; seconds: real := 1): MyAnimation := AnimScale(sc,seconds,nil); + function AnimScaleZ(sc: real; seconds: real := 1): MyAnimation := AnimScale(sc,seconds,nil); + + function AnimRotate(vx, vy, vz, angle: real; seconds: real; Completed: procedure): MyAnimation; + function AnimRotate(vx, vy, vz, angle: real; seconds: real := 1): MyAnimation := AnimRotate(vx,vy,vz,angle,seconds,nil); + + function AnimRotate(v: Vector3D; angle: real; seconds: real; Completed: procedure) := AnimRotate(v.x, v.y, v.z, angle, seconds, Completed); + function AnimRotate(v: Vector3D; angle: real; seconds: real := 1) := AnimRotate(v.x, v.y, v.z, angle, seconds, nil); + + function AnimRotateAt(axis: Vector3D; angle: real; center: Point3D; seconds: real; Completed: procedure): MyAnimation; + function AnimRotateAt(axis: Vector3D; angle: real; center: Point3D; seconds: real := 1): MyAnimation := AnimRotateAt(axis,angle,center,seconds,nil); + + function Clone: Object3D := Invoke&(CloneT); + + procedure SaveP(fname: string); + begin + var f := new System.IO.StreamWriter(fname); + XamlWriter.Save(Model, f); + f.Close() + end; + + procedure Save(fname: string); virtual := Invoke(SaveP, fname); // надо её сделать виртуальной! + class function Load(fname: string): Object3D := Invoke&(()->begin + var m := XamlReader.Load(new System.IO.FileStream(fname, System.IO.FileMode.Open)) as Visual3D; + Result := new Object3D(m); + end); + procedure Destroy(); virtual := DeleteFromObject3DList; + end; + + ObjectWithChildren3D = class(Object3D) // model is ModelVisual3D + private + l := new List; + + 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); + property Items[i: integer]: Object3D read GetObj; default; + + function Count: integer := Invoke&(CountT); + + 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; + + procedure Destroy; override; + begin + inherited Destroy; + Invoke(DestroyP); + end; + end; + + 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&(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&(()->(model as MeshElement3D).Visible); + + procedure SetMP(mat: GMaterial) := (model as MeshElement3D).Material := mat; + procedure SetMaterial(mat: GMaterial) := Invoke(SetMP, mat); + function GetMaterial: GMaterial := Invoke&(()->(model as MeshElement3D).Material); + procedure SetBMP(mat: GMaterial) := (model as MeshElement3D).BackMaterial := mat; + procedure SetBMaterial(mat: GMaterial) := Invoke(SetBMP, mat); + function GetBMaterial: GMaterial := Invoke&(()->(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; + + GroupT = class(ObjectWithChildren3D) + protected + function CreateObject: Object3D; override := new GroupT(X, Y, Z); + public + 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; + + function Clone := (inherited Clone) as GroupT; + end; + + //------------------------------ Animation ----------------------------------- + + MyAnimation = class + private + Element: Object3D; + Seconds: real; + // Completed - действие при завершении элементарной (не составной) анимации (имеющей единую продолжительность). + // Не учитывается составными анимациями - у них есть AnimationCompleted. Работает точнее чем sb.Completed. + Completed: procedure; + // AnimationCompleted - фигурирует только в WhenCompleted. Неточна. После неё индивидуальные анимации делают ещё один шаг + AnimationCompleted: procedure; + ApplyDecorators := new List; + 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): MyAnimation; + begin + Self.AnimationCompleted := act; + Result := Self; + end; + + private + procedure BeginT; + begin + sb := CreateStoryboard; + InitAnim; + + ApplyAllDecorators; + {sb.Completed += procedure (o, e) -> + begin + sb.Children.Clear; + end;} + sb.Begin; + end; + + procedure RemoveT := begin + sb.Pause; + sb.Remove; + sb := new Storyboard; + end; + procedure ChangeT(a: MyAnimation); + 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: MyAnimation) := 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: MyAnimation): MyAnimation; + function Forever: MyAnimation; virtual := Self; + function AutoReverse: MyAnimation; virtual := Self; + function AccelerationRatio(acceleration: real; deceleration: real := 0): MyAnimation; virtual := Self; + end; + + EmptyAnimation = class(MyAnimation) + public + constructor(wait: real); + begin + Self.Seconds := wait; + end; + + procedure InitAnim(); virtual := InitAnimWait; + end; + + + Double1AnimationBase = class(MyAnimation) + 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; + + function AutoReverse: MyAnimation; override; + begin + ApplyDecorators.Add(()-> begin + da.AutoReverse := True; + end); + Result := Self; + end; + + function Forever: MyAnimation; override; + begin + ApplyDecorators.Add(()-> begin + da.RepeatBehavior := RepeatBehavior.Forever; + end); + Result := Self; + end; + + function AccelerationRatio(acceleration: real; deceleration: real := 0): MyAnimation; 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(MyAnimation) + 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; + + function AutoReverse: MyAnimation; override; + begin + ApplyDecorators.Add(()-> begin + dax.AutoReverse := True; + day.AutoReverse := True; + daz.AutoReverse := True; + end); + Result := Self; + end; + + function Forever: MyAnimation; 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): MyAnimation; 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 + 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 + 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; + dax := AddDoubleAnimByNameUsingKeyframes(sb, a.Select(p -> p.x-Element.x), seconds, ttname, TranslateTransform3D.OffsetXProperty); + day := AddDoubleAnimByNameUsingKeyframes(sb, a.Select(p -> p.y-Element.y), seconds, ttname, TranslateTransform3D.OffsetYProperty); + daz := AddDoubleAnimByNameUsingKeyframes(sb, a.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; + end; + + ScaleAnimation = class(Double3AnimationBase) + private + scale: real; + el: ScaleTransform3D; + procedure Hand(o: object; e: System.EventArgs); + begin + var el0 := Element.scaletransform; + el0.ScaleX += el.ScaleX; + el0.ScaleY += el.ScaleY; + el0.ScaleZ += el.ScaleZ; + 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; + end; + + ScaleXAnimation = class(Double1AnimationBase) + private + scale: real; + el: ScaleTransform3D; + procedure Hand(o: object; e: System.EventArgs); + begin + var el0 := Element.scaletransform; + el0.ScaleX += el.ScaleX; + 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; + end; + + ScaleYAnimation = class(ScaleXAnimation) + private + procedure Hand(o: object; e: System.EventArgs); + begin + var el0 := Element.scaletransform; + el0.ScaleY += el.ScaleY; + 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; + end; + + ScaleZAnimation = class(ScaleXAnimation) + private + procedure Hand(o: object; e: System.EventArgs); + begin + var el0 := Element.scaletransform; + el0.ScaleZ += el.ScaleZ; + 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; + end; + + {RotateAnimation = class(Double1AnimationBase) + private + vx, vy, vz, angle: real; + procedure InitAnimWait(sb: StoryBoard; wait: real); override; + begin + var rottransform := Element.rotatetransform_anim; + 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 el: Object3D := Element; + sb.Completed += (o, e) -> begin + rottransform.Rotation := new AxisAngleRotation3D(); + el.Rotate(rot.Axis, angle); // переходит в основную матрицу + end; + + da := AddDoubleAnimByName(sb, angle, seconds, ttname, AxisAngleRotation3D.AngleProperty, wait); + end; + + public + constructor(e: Object3D; sec: real; vvx, vvy, vvz, a: real); + begin + inherited Create(e, sec); + (vx, vy, vz, angle) := (vvx, vvy, vvz, a) + end; + 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; + Element.RotateAt(rot.Axis, angle, center); + 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; + end; + + CompositeAnimation = class(MyAnimation) + private + ll: List; + public + constructor(params l: array of MyAnimation) := ll := Lst(l); + constructor(l: List) := ll := l; + end; + + GroupAnimation = class(CompositeAnimation) + public + function Duration: real; override := ll.Select(l -> l.Duration).Max; + function Add(b: MyAnimation): GroupAnimation; + begin + ll += b; + Result := Self; + end; + class function operator +=(a: GroupAnimation; b: MyAnimation): 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.Sum(l -> l.Duration); + function Add(b: MyAnimation): SequenceAnimation; + begin + ll += b; + Result := Self; + end; + class function operator +=(a: SequenceAnimation; b: MyAnimation): SequenceAnimation; + begin + a.ll += b; + Result := a; + end; + procedure BeginT; + begin + 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]; + while lf is CompositeAnimation do + begin + var ca := lf as CompositeAnimation; + lf := ca.ll[ca.ll.Count-1]; + end; + + lf.Completed += procedure -> + begin + lll[i+1].Begin; + end; + end; + ll[0].Begin; + end; + procedure &Begin; override := Invoke(BeginT); + end; + +function Object3D.AnimMoveTo(x, y, z, seconds: real; Completed: procedure) := new OffsetAnimation(Self, seconds, x, y, z, Completed); + +function Object3D.AnimMoveTrajectory(a: sequence of Point3D; seconds: real; Completed: procedure) := new OffsetAnimationUsingKeyframes(Self, seconds, a, 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); + +var + Object3DList := new List; + +procedure Object3D.AddToObject3DList; +begin + Object3DList.Add(Self) end; +procedure Object3D.DeleteFromObject3DList; begin - SetWindowCaption('График функции двух переменных'); - SetWindowSize(600,400); - dx := 2; { разрешение по оси X } - gr(100); { количество линий по Y <= MaxN } -end. + var oc := Self as ObjectWithChildren3D; + foreach var c in oc.l do + c.DeleteFromObject3DList; + Object3DList.Remove(Self) +end; + +type + Animate = class + public + class function Group(params l: array of MyAnimation) := new GroupAnimation(Lst(l)); + //class function &Then(first,second: MyAnimation) := new ThenAnimation(first,second); + class function &Sequence(params l: array of MyAnimation) := new SequenceAnimation(l); + end; + +function Sec(Self: integer): real; extensionmethod := Self; + +function Sec(Self: real): real; extensionmethod := Self; +// А теперь - тадам! - перегрузка + для Animate.Sequence и перегрузка * для Animate.Group +function operator+(a, b: MyAnimation): MyAnimation; extensionmethod := Animate.Sequence(a, b); + +function operator*(a, b: MyAnimation): MyAnimation; extensionmethod := Animate.Group(a, b); + +function MyAnimation.&Then(second: MyAnimation): MyAnimation := Self + second; + +function EmptyAnim(sec: real) := EmptyAnimation.Create(sec); + +//------------------------------ End Animation ------------------------------- + + +type + 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 := Origin; + sph.Radius := r; + Result := sph; + end; + + protected + function CreateObject: Object3D; override := new SphereT(X, Y, Z, Radius, Material.Clone); + public + constructor := CreateBase(NewVisualObject(1), 0, 0, 0, Colors.Blue); + constructor(x, y, z, r: real; m: Gmaterial) := CreateBase(NewVisualObject(r), x, y, z, m); + + property Radius: real read GetR write SetR; + function Clone := (inherited Clone) as SphereT; + end; + + 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 := Origin; + 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); + public + constructor(x, y, z, rx, ry, rz: real; m: GMaterial) := CreateBase(NewVisualObject(rx, ry, rz), x, y, z, m); + + property RadiusX: real read GetRX write SetRX; + property RadiusY: real read GetRY write SetRY; + property RadiusZ: real read GetRZ write SetRZ; + function Clone := (inherited Clone) as EllipsoidT; + end; + + 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 := Origin; + bx.SideLength := w; + Result := bx; + end; + + protected + function CreateObject: Object3D; override := new CubeT(X, Y, Z, SideLength, Material.Clone); + public + constructor(x, y, z, w: real; m: GMaterial) := CreateBase(NewVisualObject(w), x, y, z, m); + + property SideLength: real read GetW write SetW; + function Clone := (inherited Clone) as CubeT; + end; + + 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 := Origin; + (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); + public + constructor(x, y, z, l, w, h: real; m: GMaterial) := CreateBase(NewVisualObject(l, w, h), x, y, z, m); + + property Length: real read GetL write SetL; + property Width: real read GetW write SetW; + property Height: real read GetH write SetH; + property Size: Size3D read GetSz write SetSz; + function Clone := (inherited Clone) as BoxT; + end; + + 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&(()->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 := Origin; + Result := a; + end; + + protected + function CreateObject: Object3D; override := new ArrowT(X, Y, Z, Direction.X, Direction.Y, Direction.Z, Diameter, HeadLength, Material.Clone); + public + 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; + + property HeadLength: real read GetL write SetL; + property Diameter: real read GetD write SetD; + property Direction: Vector3D read GetDir write SetDir; + function Clone := (inherited Clone) as ArrowT; + end; + + 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&(()->model.TopCap); + private + function NewVisualObject(h, baser, topr: real; sides: integer; topcap: boolean): TruncatedConeVisual3D; + begin + var a := new TruncatedConeVisual3D; + a.Origin := Origin; + 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); + public + 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; + + 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; + + 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); + public + 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; + + function Clone := (inherited Clone) as CylinderT; + property Radius: real read GetR write SetR; + end; + + TeapotT = class(ObjectWithMaterial3D) + private + procedure SetVP(v: boolean) := (model as MeshElement3D).Visible := v; + procedure SetV(v: boolean) := Invoke(SetVP, v); + function GetV: boolean := Invoke&(()->(model as MeshElement3D).Visible); + protected + function CreateObject: Object3D; override := new TeapotT(X, Y, Z, Material.Clone); + public + constructor(x, y, z: real; m: GMaterial); + begin + var a := new Teapot; + CreateBase(a, x, y, z, m); + Rotate(OrtX, 90); + end; + + property Visible: boolean read GetV write SetV; + function Clone := (inherited Clone) as TeapotT; + end; + + 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); + public + 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; + + property ArrowLengths: real read GetAL write SetAL; + property Diameter: real read GetD; + function Clone := (inherited Clone) as CoordinateSystemT; + end; + + 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); + public + 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; + + property Text: string read GetT write SetT; + property FontSize: real read GetFS write SetFS; + function Clone := (inherited Clone) as BillboardTextT; + end; + + 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&(()->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&(()->(model.Foreground as SolidColorBrush).Color); + protected + function CreateObject: Object3D; override := new TextT(X, Y, Z, Text, Height, Name, Color); + public + 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; + + property Text: string read GetT write SetT; + property Height: real read GetFS write SetFS; + property Name: string read GetN write SetN; + property UpDirection: Vector3D read GetU write SetU; + property Color: GColor read GetColor write SetColor; override; + function Clone := (inherited Clone) as TextT; + end; + + 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&(()->model.LengthDirection); + + procedure SetNP(r: Vector3D) := model.Normal := r; + procedure SetN(r: Vector3D) := Invoke(SetNP, r); + function GetN: Vector3D := Invoke&(()->model.Normal); + protected + function CreateObject: Object3D; override := new RectangleT(X, Y, Z, Length, Width, Normal, LengthDirection, Material); + public + 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; + + property Width: real read GetW write SetW; + property Length: real read GetL write SetL; + property LengthDirection: Vector3D read GetLD write SetLD; + property Normal: Vector3D read GetN write SetN; + function Clone := (inherited Clone) as RectangleT; + end; + + 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&(()->(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&(()->(model as FileModelVisual3D).Visibility);} + protected + function CreateObject: Object3D; override := new FileModelT(X, Y, Z, fn, Material.Clone); + public + constructor(x, y, z: real; fname: string; mat: GMaterial); + begin + {model := new MeshVisual3D(); + + var fs := System.IO.File.OpenRead(fname); + fn := fname; + + var ext := System.IO.Path.GetExtension(fname); + ext := ext?.ToLower; + + var r: ModelReader; + + case ext of + '.off': begin + r := new offreader(nil); + (model as MeshVisual3D).FaceMaterial := mat; + (model as MeshVisual3D).EdgeDiameter := 0; + (model as MeshVisual3D).VertexRadius := 0; + end; + '.3ds': r := new studioreader(nil); + '.lwo': r := new lworeader(nil); + '.stl': r := new stlreader(nil); + '.obj','.objx': r := new objreader(nil); + end; + + r.DefaultMaterial := mat; + //r.DefaultMaterial := Colors.Gray; + if ext = '.off' then + begin + (r as offreader).Load(fs); + (model as MeshVisual3D).Mesh := (r as offreader).CreateMesh; + end + else + begin + var md := r.Read(fs); + (model as MeshVisual3D).Content := md; + end; + + fs.Close;} + + var a := new FileModelVisual3D; + a.DefaultMaterial := mat; + a.Source := fname; + CreateBase0(a, x, y, z); + end; + + function Clone := (inherited Clone) as FileModelT; + end; + + 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); + public + 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; + + 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; + +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)); + public + 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(48)); + end; + + 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; + +type + LegoT = class(ObjectWithMaterial3D) + private + function model := inherited model as LegoVisual3D; + procedure SetWP(r: integer) := model.Rows := r; + procedure SetW(r: integer) := Invoke(SetWP, r); + function GetW: integer := InvokeInteger(()->model.Rows); + + procedure SetHP(r: integer) := model.Height := r; + procedure SetH(r: integer) := Invoke(SetHP, r); + function GetH: integer := InvokeInteger(()->model.Height); + + procedure SetLP(r: integer) := model.Columns := r; + procedure SetL(r: integer) := Invoke(SetLP, r); + function GetL: integer := InvokeInteger(()->model.Columns); + + {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&(()->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); + begin + var bx := new LegoVisual3D; + (bx.Rows, bx.Height, bx.Columns) := (Rows, Height, Columns); + CreateBase(bx, x, y, z, m); + end; + + property Columns: integer read GetL write SetL; + 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; + +type + Panel = class + Points: array of Point3D; + TriangleIndex: integer; + end; + + ModelTypes = (TetrahedronType, OctahedronType, HexahedronType, IcosahedronType, DodecahedronType, StellatedOctahedronType, MyAny); + + PanelModelBuilder = class + Panels: List := new List; + TriangleIndexToPanelIndex: List; + + 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; + + 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; + + PlatonicAbstractT = class(ObjectWithMaterial3D) + private + procedure SetLengthP(r: real) := (model as PlatonicAbstractVisual3D).Length := r; + procedure SetLength(r: real) := Invoke(SetLengthP, r); + function GetLength: real := InvokeReal(()->(model as PlatonicAbstractVisual3D).Length); + public + property Length: real read GetLength write SetLength; + end; + + IcosahedronT = class(PlatonicAbstractT) + protected + function CreateObject: Object3D; override := new IcosahedronT(X, Y, Z, Length, Material); + public + constructor(x, y, z, Length: real; m: GMaterial) := CreateBase(new IcosahedronVisual3D(Length), x, y, z, m); + function Clone := (inherited Clone) as IcosahedronT; + end; + + DodecahedronT = class(PlatonicAbstractT) + protected + function CreateObject: Object3D; override := new DodecahedronT(X, Y, Z, Length, Material); + public + constructor(x, y, z, Length: real; m: GMaterial) := CreateBase(new DodecahedronVisual3D(Length), x, y, z, m); + function Clone := (inherited Clone) as DodecahedronT; + end; + + TetrahedronT = class(PlatonicAbstractT) + protected + function CreateObject: Object3D; override := new TetrahedronT(X, Y, Z, Length, Material); + public + constructor(x, y, z, Length: real; m: GMaterial) := CreateBase(new TetrahedronVisual3D(Length), x, y, z, m); + function Clone := (inherited Clone) as TetrahedronT; + end; + + OctahedronT = class(PlatonicAbstractT) + protected + function CreateObject: Object3D; override := new OctahedronT(X, Y, Z, Length, Material); + public + constructor(x, y, z, Length: real; m: GMaterial) := CreateBase(new OctahedronVisual3D(Length), x, y, z, m); + function Clone := (inherited Clone) as OctahedronT; + end; + + 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 + var a := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray; + var b := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), fh)).ToArray; + 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 + var a := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray; + 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 := 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; + + TriangleT = class(ObjectWithMaterial3D) + protected + function Model := inherited model as TriangleVisual3D; + procedure SetP1(p: Point3D) := Invoke(procedure(p: Point3D)->model.P1 := p, p); + function GetP1: Point3D := Invoke&(()->model.P1); + procedure SetP2(p: Point3D) := Invoke(procedure(p: Point3D)->model.P2 := p, p); + function GetP2: Point3D := Invoke&(()->model.P2); + procedure SetP3(p: Point3D) := Invoke(procedure(p: Point3D)->model.P3 := p, p); + function GetP3: Point3D := Invoke&(()->model.P3); + + function CreateObject: Object3D; override := new TriangleT(Model.p1, Model.p2, Model.p3, Material.Clone); + public + constructor(p1, p2, p3: Point3D; m: Gmaterial); + begin + CreateBase(new TriangleVisual3D(p1, p2, p3), 0, 0, 0, m); + Model.BackMaterial := Model.Material; + end; + + property P1: Point3D read GetP1 write SetP1; + property P2: Point3D read GetP2 write SetP2; + property P3: Point3D read GetP3 write SetP3; + procedure SetPoints(p1, p2, p3: Point3D) := Invoke(procedure(p1, p2, p3: Point3D)->begin model.SetPoints(p1, p2, p3); end, p1, p2, p3); + end; + + + PrismT = class(ObjectWithMaterial3D) + private + function Model := inherited model as PrismVisual3D; + procedure SetR(r: real) := Invoke(procedure(r: real)->model.Radius := r, r); + function GetR: real := InvokeReal(()->model.Radius); + procedure SetH(r: real) := Invoke(procedure(r: real)->model.Height := r, r); + function GetH: real := InvokeReal(()->model.Height); + procedure SetN(n: integer) := Invoke(procedure(n: integer)->model.N := n, n); + function GetN: integer := InvokeInteger(()->model.N); + 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) := CreateBase(new PrismVisual3D(N, r, h), x, y, z, m); + 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; + + 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) := CreateBase(new PyramidVisual3D(N, r, h), x, y, z, m); + function Clone := (inherited Clone) as PyramidT; + end; + + PrismTWireframe = class(ObjectWithChildren3D) + private + fn: integer; + fh, fr: real; + function Model := inherited model as LinesVisual3D; + + procedure SetCP(c: GColor) := Model.Color := c; + procedure SetC(c: GColor) := Invoke(SetCP, c); + function GetC: GColor := Invoke&(()->Model.Color); + procedure SetTP(th: real) := Model.Thickness := th; + procedure SetT(th: real) := Invoke(SetTP, th); + function GetT: real := InvokeReal(()->Model.Thickness); + + procedure SetRP(value: real); + begin + if fr = value then + exit; + fr := value; + model.Points := CreatePoints; + end; + + procedure SetR(value: real) := Invoke(SetRP, value); + procedure SetHP(value: real); + begin + if fh = value then + exit; + fh := value; + model.Points := CreatePoints; + end; + + procedure SetH(value: real) := Invoke(SetHP, value); + procedure SetNP(value: integer); + begin + if fN = value then + exit; + fN := value; + model.Points := CreatePoints; + end; + + procedure SetN(value: integer) := Invoke(SetNP, value); + + function CreatePoints: Point3DCollection; virtual; + begin + var pc := new Point3DCollection; + + var a := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray; + var b := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), fh)).ToArray; + 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 + var a := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).SkipLast; + var b := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), fh)).SkipLast; + 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 Height: real read fh write SetH; + property Radius: real read fr write SetR; + property N: integer read fn write SetN; + property Color: GColor read GetC write SetC; override; + property Thickness: real read GetT write SetT; + end; + + 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; + + var a := Partition(0, 2 * Pi, N).Select(x -> P3D(fr * cos(x), fr * sin(x), 0)).ToArray; + 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; + end; + + P3DArray = array of Point3D; + //P3DList = List; + 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&(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&(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; + + property Thickness: real read GetT write SetT; + property Color: GColor read GetC write SetC; override; + property Points: array of Point3D read GetP write SetP; + function Clone := (inherited Clone) as SegmentsT; + end; + + TorusT = class(ObjectWithMaterial3D) + private + function Model := inherited model as TorusVisual3D; + procedure SetD(d: real) := Invoke(procedure(d: real)->model.TorusDiameter := d, d); + function GetD: real := InvokeReal(()->model.TorusDiameter); + procedure SetTD(d: real) := Invoke(procedure(d: real)->model.TubeDiameter := d, d); + function GetTD: real := InvokeReal(()->model.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; + + 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; + +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, 80); + 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 := 80; + + var q := Partition(0,2*Pi*20,360*20*10).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 := 360; + a.ThetaDiv := 60;} + + {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 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; + +var + BadPoint := P3D(real.MaxValue, real.MaxValue, real.MaxValue); + +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); + +var + PlaneXY := Plane(Origin, OrtZ); + PlaneYZ := Plane(Origin, OrtX); + PlaneXZ := Plane(Origin, OrtY); + XAxis := Ray(Origin, OrtX); + YAxis := Ray(Origin, OrtY); + ZAxis := Ray(Origin, OrtZ); + +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 DefaultMaterialColor := RandomColor; + +function DefaultMaterial := MaterialHelper.CreateMaterial(DefaultMaterialColor); + +function Group(x, y, z: integer): GroupT := Inv(()->GroupT.Create(x, y, z)); + +function Group(p: Point3D): GroupT := Inv(()->GroupT.Create(p.x, p.y, p.z)); + +function Group: GroupT := Inv(()->GroupT.Create(0, 0, 0)); + +function Group(params lst: array of Object3D): GroupT := Inv(()->GroupT.Create(0, 0, 0, lst)); + +function Group(en: sequence of Object3D): GroupT := Inv(()->GroupT.Create(0, 0, 0, en)); + +function Sphere(x, y, z, Radius: real; m: Material := DefaultMaterial): SphereT := Inv(()->SphereT.Create(x, y, z, Radius, m)); + +function Sphere(center: Point3D; Radius: real; m: Material := DefaultMaterial) := Sphere(center.x, center.y, center.z, Radius, m); + +function Ellipsoid(x, y, z, RadiusX, RadiusY, RadiusZ: real; m: Material := DefaultMaterial): EllipsoidT := Inv(()->EllipsoidT.Create(x, y, z, RadiusX, RadiusY, RadiusZ, m)); + +function Ellipsoid(center: Point3D; RadiusX, RadiusY, RadiusZ: real; m: Material := DefaultMaterial) := Ellipsoid(center.x, center.y, center.z, RadiusX, RadiusY, RadiusZ, m); + +function Cube(x, y, z, SideLength: real; m: Material := DefaultMaterial): CubeT := Inv(()->CubeT.Create(x, y, z, SideLength, m)); + +function Cube(center: Point3D; SideLength: real; m: Material := DefaultMaterial): CubeT := Cube(center.x, center.y, center.z, SideLength, m); + +function Box(x, y, z, SizeX, SizeY, SizeZ: real; m: Material := DefaultMaterial): BoxT := Inv(()->BoxT.Create(x, y, z, SizeX, SizeY, SizeZ, m)); + +function Box(center: Point3D; sz: Size3D; m: Material := DefaultMaterial): 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, hl: real; m: Material := DefaultMaterial): ArrowT := Inv(()->ArrowT.Create(x, y, z, vx, vy, vz, diameter, hl, m)); + +function Arrow(x, y, z, vx, vy, vz, diameter: real; m: Material := DefaultMaterial) := Arrow(x, y, z, vx, vy, vz, diameter, arhl, m); + +function Arrow(x, y, z, vx, vy, vz: real; m: Material := DefaultMaterial) := Arrow(x, y, z, vx, vy, vz, ard, arhl, m); + +function Arrow(p: Point3D; v: Vector3D; diameter, hl: real; m: Material := DefaultMaterial) := Arrow(p.x, p.y, p.z, v.X, v.Y, v.Z, diameter, hl, m); + +function Arrow(p: Point3D; v: Vector3D; diameter: real; m: Material := DefaultMaterial) := Arrow(p.x, p.y, p.z, v.X, v.Y, v.Z, diameter, arhl, m); + +function Arrow(p: Point3D; v: Vector3D; m: Material := DefaultMaterial) := 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 = 37; + +///-- +function TruncatedCone(x, y, z, Height, Radius, TopRadius: real; topcap: boolean; m: Material := DefaultMaterial): TruncatedConeT := TruncatedConeAux(x, y, z, Height, Radius, TopRadius, maxsides, topcap, m); + +function TruncatedCone(x, y, z, Height, Radius, TopRadius: real; m: Material := DefaultMaterial) := TruncatedCone(x, y, z, Height, Radius, TopRadius, True, m); +///-- +function TruncatedCone(p: Point3D; Height, Radius, TopRadius: real; topcap: boolean; m: Material := DefaultMaterial) := TruncatedCone(p.x, p.y, p.z, Height, Radius, TopRadius, topcap, m); + +function TruncatedCone(p: Point3D; Height, Radius, TopRadius: real; m: Material := DefaultMaterial) := TruncatedCone(p.x, p.y, p.z, Height, Radius, TopRadius, True, m); + +///-- +function Cylinder(x, y, z, Height, Radius: real; topcap: boolean; m: Material := DefaultMaterial): CylinderT := Inv(()->CylinderT.Create(x, y, z, Height, Radius, maxsides, topcap, m)); + +function Cylinder(x, y, z, Height, Radius: real; m: Material := DefaultMaterial) := Cylinder(x, y, z, Height, Radius, True, m); +///-- +function Cylinder(p: Point3D; Height, Radius: real; topcap: boolean; m: Material := DefaultMaterial) := Cylinder(p.x, p.y, p.z, Height, Radius, topcap, m); + +function Cylinder(p: Point3D; Height, Radius: real; m: Material := DefaultMaterial) := Cylinder(p.x, p.y, p.z, Height, Radius, True, m); + +function Tube(x, y, z, Height, Radius, InnerRadius: real; m: Material := DefaultMaterial): PipeT := Inv(()->PipeT.Create(x, y, z, Height, Radius, InnerRadius, m)); + +function Tube(p: Point3D; Height, Radius, InnerRadius: real; m: Material := DefaultMaterial) := Tube(p.x, p.y, p.z, Height, Radius, InnerRadius, m); + +function Cone(x, y, z, Height, Radius: real; m: Material := DefaultMaterial): TruncatedConeT := TruncatedCone(x, y, z, Height, Radius, 0, True, m); + +function Cone(p: Point3D; Height, Radius: real; m: Material := DefaultMaterial) := TruncatedCone(p.x, p.y, p.z, Height, Radius, 0, True, m); + +function Teapot(x, y, z: real; c: Material := DefaultMaterial): TeapotT := Inv(()->TeapotT.Create(x, y, z, c)); + +function Teapot(p: Point3D; c: Material := DefaultMaterial) := Teapot(p.x, p.y, p.z, c); + +function BillboardText(x, y, z: real; Text: string; Fontsize: real := 12): BillboardTextT := Inv(()->BillboardTextT.Create(x, y, z, text, fontsize)); + +function BillboardText(p: Point3D; Text: string; Fontsize: real := 12) := 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 / 10); + +function Text3D(x, y, z: real; Text: string; Height: real; fontname: string := 'Arial'; c: Color := Colors.Black): TextT := Inv(()->TextT.Create(x, y, z, text, height, fontname, c)); + +function Text3D(p: Point3D; Text: string; Height: real; fontname: string := 'Arial'; c: Color := Colors.Black) := 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 := DefaultMaterial): RectangleT := Inv(()->RectangleT.Create(x, y, z, Length, Width, normal, LengthDirection, m)); + +function Rectangle3D(p: Point3D; Length, Width: real; Normal, LengthDirection: Vector3D; m: Material := DefaultMaterial): 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 := DefaultMaterial): RectangleT := Rectangle3D(x, y, z, Length, Width, Normal, OrtX, m); + +function Rectangle3D(x, y, z, Length, Width: real; m: Material := DefaultMaterial): RectangleT := Rectangle3D(x, y, z, Length, Width, OrtZ, OrtX, m); + +function Rectangle3D(p: Point3D; Length, Width: real; Normal: Vector3D; m: Material := DefaultMaterial): RectangleT := Rectangle3D(p.x, p.y, p.z, Length, Width, Normal, OrtX, m); + +function Rectangle3D(p: Point3D; Length, Width: real; m: Material := DefaultMaterial): 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 := DefaultMaterial): PrismT := Inv(()->PrismT.Create(x, y, z, Sides, Radius, Height, m)); + +function Prism(p: Point3D; Sides: integer; Height, Radius: real; m: Material := DefaultMaterial): 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 := 1.2; c: Color := GrayColor(64)): PrismTWireFrame := Inv(()->PrismTWireFrame.Create(x, y, z, Sides, Radius, Height, thickness, c)); + +function PrismWireFrame(p: Point3D; Sides: integer; Height, Radius: real; Thickness: real := 1.2; c: Color := GrayColor(64)): 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 := DefaultMaterial): PyramidT := Inv(()->PyramidT.Create(x, y, z, Sides, Radius, Height, m)); + +function Pyramid(p: Point3D; Sides: integer; Height, Radius: real; m: Material := DefaultMaterial): 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 := 1.2; c: Color := GrayColor(64)): PyramidTWireFrame := Inv(()->PyramidTWireFrame.Create(x, y, z, Sides, Radius, Height, thickness, c)); + +function PyramidWireFrame(p: Point3D; Sides: integer; Height, Radius: real; Thickness: real := 1.2; c: Color := GrayColor(64)): 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 := DefaultMaterial): LegoT := Inv(()->LegoT.Create(x, y, z, Rows, Columns, Height, m)); + +function Icosahedron(x, y, z, r: real; m: Material := DefaultMaterial): IcosahedronT := Inv(()->IcosahedronT.Create(x, y, z, 4 * R / Sqrt(2) / Sqrt(5 + Sqrt(5)), m)); + +function Dodecahedron(x, y, z, r: real; m: Material := DefaultMaterial): DodecahedronT := Inv(()->DodecahedronT.Create(x, y, z, R * 4 / Sqrt(3) / (1 + Sqrt(5)), m)); + +function Tetrahedron(x, y, z, r: real; m: Material := DefaultMaterial): TetrahedronT := Inv(()->TetrahedronT.Create(x, y, z, 4 * R / Sqrt(6), m)); + +function Octahedron(x, y, z, r: real; m: Material := DefaultMaterial): OctahedronT := Inv(()->OctahedronT.Create(x, y, z, R * Sqrt(2), m)); + +function Icosahedron(p: Point3D; r: real; m: Material := DefaultMaterial): IcosahedronT := Icosahedron(p.X, p.Y, p.Z, R, m); + +function Dodecahedron(p: Point3D; r: real; m: Material := DefaultMaterial): DodecahedronT := Dodecahedron(p.X, p.Y, p.Z, R, m); + +function Tetrahedron(p: Point3D; r: real; m: Material := DefaultMaterial): TetrahedronT := Tetrahedron(p.X, p.Y, p.Z, R, m); + +function Octahedron(p: Point3D; r: real; m: Material := DefaultMaterial): OctahedronT := Octahedron(p.X, p.Y, p.Z, R, m); + +function Segments3D(points: sequence of Point3D; thickness: real := 1.2; c: Color := GrayColor(64)): SegmentsT := Inv(()->SegmentsT.Create(points, thickness, c)); + +function Polyline3D(points: sequence of Point3D; thickness: real := 1.2; c: Color := GrayColor(64)): SegmentsT := Inv(()->SegmentsT.Create(points.Pairwise.SelectMany(x -> Seq(x[0], x[1])), thickness, c)); + +function Polygon3D(points: sequence of Point3D; thickness: real := 1.2; c: Color := GrayColor(64)): SegmentsT := Inv(()->SegmentsT.Create((points + points.First).Pairwise.SelectMany(x -> Seq(x[0], x[1])), thickness, c)); + +function Segment3D(p1, p2: Point3D; thickness: real := 1.2; c: Color := GrayColor(64)): SegmentsT := Inv(()->SegmentsT.Create(Seq(p1, p2), thickness, c)); + +function Torus(x, y, z, Diameter, TubeDiameter: real; m: Material := DefaultMaterial): TorusT := Inv(()->TorusT.Create(x, y, z, Diameter, TubeDiameter, m)); + +function Torus(p: Point3D; Diameter, TubeDiameter: real; m: Material := DefaultMaterial): TorusT := Torus(p.x, p.y, p.z, Diameter, TubeDiameter, m); + +function Triangle(p1, p2, p3: Point3D; m: Material := DefaultMaterial): TriangleT := Inv(()->TriangleT.Create(p1, p2, p3, m)); + +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)); + + +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, 100, 255)); + Sphere(-2, -4, 0, 2, MaterialHelper.CreateMaterial(Brushes.Green, 0.6, 100, 255)); + Sphere(-6, -4, 0, 2, MaterialHelper.CreateMaterial(Brushes.Green, 0.8, 100, 0)); + + Sphere(6, 0, 0, 2, MaterialHelper.CreateMaterial(Brushes.Green, 0.5, 100, 255)); + Sphere(2, 0, 0, 2, MaterialHelper.CreateMaterial(Brushes.Green, 0.5, 70, 255)); + Sphere(-2, 0, 0, 2, MaterialHelper.CreateMaterial(Brushes.Green, 0.5, 40, 255)); + Sphere(-6, 0, 0, 2, MaterialHelper.CreateMaterial(Brushes.Green, 0.5, 20, 255)); + + 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, 40, 255)); + //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 + 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 := 12; + gvl.Length := 12; + gvl.Normal := OrtZ; + gvl.MinorDistance := 1; + gvl.MajorDistance := 1; + gvl.Thickness := 0.02; + hvp.Children.Add(gvl); + end; + + procedure InitWindowProperties; override; + begin + (Width, Height) := (800, 600); + 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 View3DT; + + 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; + + procedure SystemOnKeyUp(sender: Object; e: System.Windows.Input.KeyEventArgs) := + begin + if Graph3D.OnKeyUp <> nil then + Graph3D.OnKeyUp(e.Key); + e.Handled := True; + end; + + /// --- 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); + + 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. \ No newline at end of file diff --git a/TestSuite/formatter_tests/should/Program1200.pas b/TestSuite/formatter_tests/should/Program1200.pas new file mode 100644 index 000000000..c4643bbff --- /dev/null +++ b/TestSuite/formatter_tests/should/Program1200.pas @@ -0,0 +1,4 @@ +begin + var b: byte; + b += 1; b += 1; +end. \ No newline at end of file