diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index bef21dfb7..cec146ae4 100644 --- a/Configuration/GlobalAssemblyInfo.cs +++ b/Configuration/GlobalAssemblyInfo.cs @@ -15,7 +15,7 @@ internal static class RevisionClass public const string Major = "3"; public const string Minor = "3"; public const string Build = "5"; - public const string Revision = "1636"; + public const string Revision = "1638"; public const string MainVersion = Major + "." + Minor; public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision; diff --git a/Configuration/Version.defs b/Configuration/Version.defs index 95122e21d..8a3145d02 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ %MINOR%=3 -%REVISION%=1636 +%REVISION%=1638 %COREVERSION%=5 %MAJOR%=3 diff --git a/InstallerSamples/Graph3D/События мыши/СлучайныйЦвет.pas b/InstallerSamples/Graph3D/События мыши/СлучайныйЦвет.pas index 839cae286..a59e5bed6 100644 --- a/InstallerSamples/Graph3D/События мыши/СлучайныйЦвет.pas +++ b/InstallerSamples/Graph3D/События мыши/СлучайныйЦвет.pas @@ -1,18 +1,13 @@ uses Graph3D; begin - var s := Sphere(3,0,0,1); - var b := Box(0,2,0,3,2,1); + var s := Sphere(3,0,1,1); + var b := Box(0,2,0.5,3,2,1); + var t := Text3D(-5,0,1,'GraphABC',2); OnMouseDown += procedure (x,y,mb) -> begin - if mb=1 then - begin - var v := FindObject3D(x,y); - if v<>nil then - begin - var v1 := v as ObjectWithMaterial3D; - if v1<>nil then - v1.Color := RandomColor; - end; - end; + if mb<>1 then exit; + var v := FindObject3D(x,y); + if v<>nil then + v.Color := RandomColor; end; end. \ No newline at end of file diff --git a/Localization/DefaultLang.resources b/Localization/DefaultLang.resources index c70aa993c..5909fb49d 100644 Binary files a/Localization/DefaultLang.resources and b/Localization/DefaultLang.resources differ diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index 9485744e4..c1a58d4d0 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.3.5.1636' +!define VERSION '3.3.5.1638' diff --git a/ReleaseGenerators/RebuildStandartModules.pas b/ReleaseGenerators/RebuildStandartModules.pas index 0d3737b35..6252ad33a 100644 --- a/ReleaseGenerators/RebuildStandartModules.pas +++ b/ReleaseGenerators/RebuildStandartModules.pas @@ -8,7 +8,7 @@ uses NumLibABC, IniFile, PointerTools, PointRect, PT4, PT4MakerNetX, Robot, RobotField, RobotTaskMaker, RobotZadan, Sockets, Utils, VCL, Timers, PT4Exam, PT4TaskMakerNET, RBDMUtils, - Collections, Arrays, Core, FormsABC, MPI, ClientServer, OpenGL, Speech; + Collections, Arrays, Core, FormsABC, MPI, ClientServer, OpenGL, Speech, Sounds; begin writeln(cos(pi)); diff --git a/ReleaseGenerators/sect_Core.nsh b/ReleaseGenerators/sect_Core.nsh index ef6c8a2cb..fd97cb297 100644 --- a/ReleaseGenerators/sect_Core.nsh +++ b/ReleaseGenerators/sect_Core.nsh @@ -108,6 +108,7 @@ File ..\bin\Lib\OpenGL.pcu File ..\bin\Lib\PT4MakerNetX.pcu File ..\bin\Lib\Speech.pcu + File ..\bin\Lib\Sounds.pcu File ..\bin\Lib\PABCRtl.dll File ..\bin\Lib\PABCRtl32.dll File ..\bin\Lib\HelixToolkit.Wpf.dll @@ -161,6 +162,7 @@ ${AddFile} "OpenGL.pcu" ${AddFile} "PT4MakerNetX.pcu" ${AddFile} "Speech.pcu" + ${AddFile} "Sounds.pcu" ${AddFile} "PABCRtl.dll" ${AddFile} "HelixToolkit.Wpf.dll" ${AddFile} "HelixToolkit.dll" @@ -225,6 +227,7 @@ File ..\bin\Lib\OpenGL.pas File ..\bin\Lib\PT4MakerNetX.pas File ..\bin\Lib\Speech.pas + File ..\bin\Lib\Sounds.pas File ..\bin\Lib\__RedirectIOMode.vb File ..\bin\Lib\VBSystem.vb @@ -275,6 +278,7 @@ ${AddFile} "OpenGL.pas" ${AddFile} "PT4MakerNetX.pas" ${AddFile} "Speech.pas" + ${AddFile} "Sounds.pas" ${AddFile} "__RedirectIOMode.vb" ${AddFile} "VBSystem.vb" diff --git a/TestSuite/CompilationSamples/graph3d.pas b/TestSuite/CompilationSamples/graph3d.pas index 5df68b742..9781474a5 100644 --- a/TestSuite/CompilationSamples/graph3d.pas +++ b/TestSuite/CompilationSamples/graph3d.pas @@ -87,6 +87,7 @@ const 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); @@ -445,11 +446,6 @@ type AddToObject3DList; end; - procedure Destroy(); - begin - DeleteFromObject3DList; - end; - procedure SetX(xx: real) := Invoke(()->begin transltransform.OffsetX := xx; end); function GetX: real := InvokeReal(()->transltransform.OffsetX); procedure SetY(yy: real) := Invoke(()->begin transltransform.OffsetY := yy; end); @@ -463,6 +459,10 @@ type if model = v then Result := Self end; + function GetColor: GColor := EmptyColor; + procedure SetColor(c: GColor); + begin end; + protected function CreateObject: Object3D; virtual; // нужно для клонирования begin @@ -506,6 +506,7 @@ type 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); @@ -599,12 +600,20 @@ type var m := XamlReader.Load(new System.IO.FileStream(fname,System.IO.FileMode.Open)) as Visual3D; Result := new Object3D(m); end); + procedure Destroy(); virtual; + begin + DeleteFromObject3DList; + end; end; ObjectWithChildren3D = class(Object3D) // model is ModelVisual3D private l := new List; + procedure DestroyT; + begin + + end; procedure AddT(obj: Object3D); begin var p := Self; @@ -616,6 +625,7 @@ type end; if obj.Parent = Self then exit; + if obj.Parent = nil then hvp.Children.Remove(obj.model) else @@ -624,6 +634,7 @@ type q.Children.Remove(obj.model); obj.Parent.l.Remove(obj); end; + (model as ModelVisual3D).Children.Add(obj.model); l.Add(obj); obj.Parent := Self; @@ -668,10 +679,21 @@ type procedure DestroyP; begin - hvp.Children.Remove(model); + 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 := Invoke(DestroyP); + procedure Destroy; override; + begin + inherited Destroy; + Invoke(DestroyP); + end; end; ObjectWithMaterial3D = class(ObjectWithChildren3D) // model is MeshElement3D @@ -685,6 +707,18 @@ type //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; @@ -698,7 +732,7 @@ type procedure SetBMaterial(mat: GMaterial) := Invoke(SetBMP, mat); function GetBMaterial: GMaterial := Invoke&(()->(model as MeshElement3D).BackMaterial); public - property Color: GColor write SetColor; + 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; @@ -1221,6 +1255,9 @@ end; procedure Object3D.DeleteFromObject3DList; begin + var oc := Self as ObjectWithChildren3D; + foreach var c in oc.l do + c.DeleteFromObject3DList; Object3DList.Remove(Self) end; @@ -1569,7 +1606,7 @@ type 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: Color); + constructor(x, y, z: real; text: string; height: real; fontname: string; c: GColor); begin var a := new TextVisual3D; a.Position := p3D(0, 0, 0); @@ -1586,7 +1623,7 @@ type 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; + property Color: GColor read GetColor write SetColor; override; function Clone := (inherited Clone) as TextT; end; @@ -2241,7 +2278,7 @@ type 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; + property Color: GColor read GetC write SetC; override; property Thickness: real read GetT write SetT; end; @@ -2297,7 +2334,7 @@ type end; property Thickness: real read GetT write SetT; - property Color: GColor read GetC write SetC; + property Color: GColor read GetC write SetC; override; property Points: array of Point3D read GetP write SetP; function Clone := (inherited Clone) as SegmentsT; end; diff --git a/bin/Lib/Graph3D.pas b/bin/Lib/Graph3D.pas index 5df68b742..9781474a5 100644 --- a/bin/Lib/Graph3D.pas +++ b/bin/Lib/Graph3D.pas @@ -87,6 +87,7 @@ const 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); @@ -445,11 +446,6 @@ type AddToObject3DList; end; - procedure Destroy(); - begin - DeleteFromObject3DList; - end; - procedure SetX(xx: real) := Invoke(()->begin transltransform.OffsetX := xx; end); function GetX: real := InvokeReal(()->transltransform.OffsetX); procedure SetY(yy: real) := Invoke(()->begin transltransform.OffsetY := yy; end); @@ -463,6 +459,10 @@ type if model = v then Result := Self end; + function GetColor: GColor := EmptyColor; + procedure SetColor(c: GColor); + begin end; + protected function CreateObject: Object3D; virtual; // нужно для клонирования begin @@ -506,6 +506,7 @@ type 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); @@ -599,12 +600,20 @@ type var m := XamlReader.Load(new System.IO.FileStream(fname,System.IO.FileMode.Open)) as Visual3D; Result := new Object3D(m); end); + procedure Destroy(); virtual; + begin + DeleteFromObject3DList; + end; end; ObjectWithChildren3D = class(Object3D) // model is ModelVisual3D private l := new List; + procedure DestroyT; + begin + + end; procedure AddT(obj: Object3D); begin var p := Self; @@ -616,6 +625,7 @@ type end; if obj.Parent = Self then exit; + if obj.Parent = nil then hvp.Children.Remove(obj.model) else @@ -624,6 +634,7 @@ type q.Children.Remove(obj.model); obj.Parent.l.Remove(obj); end; + (model as ModelVisual3D).Children.Add(obj.model); l.Add(obj); obj.Parent := Self; @@ -668,10 +679,21 @@ type procedure DestroyP; begin - hvp.Children.Remove(model); + 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 := Invoke(DestroyP); + procedure Destroy; override; + begin + inherited Destroy; + Invoke(DestroyP); + end; end; ObjectWithMaterial3D = class(ObjectWithChildren3D) // model is MeshElement3D @@ -685,6 +707,18 @@ type //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; @@ -698,7 +732,7 @@ type procedure SetBMaterial(mat: GMaterial) := Invoke(SetBMP, mat); function GetBMaterial: GMaterial := Invoke&(()->(model as MeshElement3D).BackMaterial); public - property Color: GColor write SetColor; + 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; @@ -1221,6 +1255,9 @@ end; procedure Object3D.DeleteFromObject3DList; begin + var oc := Self as ObjectWithChildren3D; + foreach var c in oc.l do + c.DeleteFromObject3DList; Object3DList.Remove(Self) end; @@ -1569,7 +1606,7 @@ type 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: Color); + constructor(x, y, z: real; text: string; height: real; fontname: string; c: GColor); begin var a := new TextVisual3D; a.Position := p3D(0, 0, 0); @@ -1586,7 +1623,7 @@ type 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; + property Color: GColor read GetColor write SetColor; override; function Clone := (inherited Clone) as TextT; end; @@ -2241,7 +2278,7 @@ type 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; + property Color: GColor read GetC write SetC; override; property Thickness: real read GetT write SetT; end; @@ -2297,7 +2334,7 @@ type end; property Thickness: real read GetT write SetT; - property Color: GColor read GetC write SetC; + property Color: GColor read GetC write SetC; override; property Points: array of Point3D read GetP write SetP; function Clone := (inherited Clone) as SegmentsT; end; diff --git a/bin/Lib/Sounds.pas b/bin/Lib/Sounds.pas new file mode 100644 index 000000000..18e94fb4a --- /dev/null +++ b/bin/Lib/Sounds.pas @@ -0,0 +1,26 @@ +unit Sounds; + +{$reference 'PresentationCore.dll'} + +procedure PlaySound(fname: string); +begin + var fsound := new System.Windows.Media.MediaPlayer; + fsound.Open(new System.Uri(fname)); + fsound.Play; +end; + +type Sound = class + fsound := new System.Windows.Media.MediaPlayer; +public + constructor (fname: string); + begin + Open(fname); + end; + procedure Open(fname: string) := fsound.Open(new System.Uri(fname)); + procedure Play := fsound.Play; + procedure Stop := fsound.Stop; + procedure Pause := fsound.Pause; + procedure Reset := fsound.Position := new System.Timespan(0); +end; + +end. \ No newline at end of file