administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Sounds.pas

Browse source
This commit is contained in:
miks1965 2018-03-15 12:43:17 +03:00
parent cee3fecba5
commit 51b1021489
10 changed files with 139 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Configuration/GlobalAssemblyInfo.cs
View file

@ -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;

2
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%MINOR%=3
%REVISION%=1636
%REVISION%=1638
%COREVERSION%=5
%MAJOR%=3

19
InstallerSamples/Graph3D/События мыши/СлучайныйЦвет.pas
View file

@ -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.

BIN
Localization/DefaultLang.resources
View file

Binary file not shown.

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.3.5.1636'
!define VERSION '3.3.5.1638'

2
ReleaseGenerators/RebuildStandartModules.pas
View file

@ -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));

4
ReleaseGenerators/sect_Core.nsh
View file

@ -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"

61
TestSuite/CompilationSamples/graph3d.pas
View file

@ -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<Object3D>;
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&<GColor>(GetColorP);
procedure SetColorP(c: GColor) := (model as MeshElement3D).Material := MaterialHelper.CreateMaterial(c);
procedure SetColor(c: GColor) := Invoke(SetColorP, c);
procedure SetVP(v: boolean) := (model as MeshElement3D).Visible := v;
@ -698,7 +732,7 @@ type
procedure SetBMaterial(mat: GMaterial) := Invoke(SetBMP, mat);
function GetBMaterial: GMaterial := Invoke&<GMaterial>(()->(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;

61
bin/Lib/Graph3D.pas
View file

@ -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<Object3D>;
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&<GColor>(GetColorP);
procedure SetColorP(c: GColor) := (model as MeshElement3D).Material := MaterialHelper.CreateMaterial(c);
procedure SetColor(c: GColor) := Invoke(SetColorP, c);
procedure SetVP(v: boolean) := (model as MeshElement3D).Visible := v;
@ -698,7 +732,7 @@ type
procedure SetBMaterial(mat: GMaterial) := Invoke(SetBMP, mat);
function GetBMaterial: GMaterial := Invoke&<GMaterial>(()->(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;

26
bin/Lib/Sounds.pas Normal file
View file

@ -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.