From c7a3beec39b793f0426c596aeb347b7dfcb34a73 Mon Sep 17 00:00:00 2001 From: Mikhalkovich Stanislav Date: Sun, 18 Aug 2019 00:16:39 +0300 Subject: [PATCH] =?UTF-8?q?=D0=A3=D0=B1=D1=80=D0=B0=D0=BD=20PabcRtl32.dll?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Compiler/Compiler.cs | 2 +- Configuration/GlobalAssemblyInfo.cs | 2 +- Configuration/Version.defs | 4 +- InstallerSamples/Games/DeleteByMouse.pas | 2 +- .../WPFObjects/MovingFrameBasedTime.pas | 2 +- .../Graphics/WPFObjects/Shooter.pas | 50 +- NETGenerator/NETGenerator.cs | 4 +- Release/pabcversion.txt | 2 +- ReleaseGenerators/PascalABCNET_end.nsh | 3 - ReleaseGenerators/PascalABCNET_version.nsh | 2 +- ReleaseGenerators/sect_Core.nsh | 1 - TestSuite/CompilationSamples/Timers.pas | 4 +- VisualPascalABCNET/UserOptions.cs | 2 +- _GenerateAllSetups.bat | 6 - _RebuildReleaseAndBuildUnits.bat | 6 - _RebuildReleaseAndRunTests.bat | 6 - bin/Lib/Controls.pas | 562 ++++++++++-------- 17 files changed, 341 insertions(+), 319 deletions(-) diff --git a/Compiler/Compiler.cs b/Compiler/Compiler.cs index 6fcaa273a..18fda0b9c 100644 --- a/Compiler/Compiler.cs +++ b/Compiler/Compiler.cs @@ -3615,7 +3615,7 @@ namespace PascalABCCompiler public static Dictionary standart_assembly_dict = new Dictionary(); static Compiler() { - string[] ss = new string[] { "mscorlib.dll","System.dll", "System.Core.dll", "System.Numerics.dll", "System.Windows.Forms.dll", "PABCRtl.dll", "PABCRtl32.dll" }; + string[] ss = new string[] { "mscorlib.dll","System.dll", "System.Core.dll", "System.Numerics.dll", "System.Windows.Forms.dll", "PABCRtl.dll" }; foreach (var x in ss) standart_assembly_dict[x] = get_standart_assembly_path(x); } diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index 1cd92cb09..31a267177 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 = "5"; public const string Build = "0"; - public const string Revision = "2223"; + public const string Revision = "2226"; 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 5bf9fdf15..ea768951f 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%MINOR%=5 -%REVISION%=2223 %COREVERSION%=0 +%REVISION%=2226 +%MINOR%=5 %MAJOR%=3 diff --git a/InstallerSamples/Games/DeleteByMouse.pas b/InstallerSamples/Games/DeleteByMouse.pas index 40f7bf9fe..bcbf4636b 100644 --- a/InstallerSamples/Games/DeleteByMouse.pas +++ b/InstallerSamples/Games/DeleteByMouse.pas @@ -43,7 +43,7 @@ begin begin var x := Random(Window.Width-50); var y := Random(Window.Height-100); - var ob := RectangleWPF.Create(x,y,50,50,Colors.LightGreen).WithBorder; + var ob := RectangleWPF.Create(x,y,50,50,Colors.LightGreen,1); ob.FontSize := 25; ob.Number := i; end; diff --git a/InstallerSamples/Graphics/WPFObjects/MovingFrameBasedTime.pas b/InstallerSamples/Graphics/WPFObjects/MovingFrameBasedTime.pas index c2c95f927..31400f5ce 100644 --- a/InstallerSamples/Graphics/WPFObjects/MovingFrameBasedTime.pas +++ b/InstallerSamples/Graphics/WPFObjects/MovingFrameBasedTime.pas @@ -4,7 +4,7 @@ begin var c := new CircleWPF(Window.Center, 20, Colors.Green); BeginFrameBasedAnimationTime(dt->begin - c.Move(dt); + c.MoveTime(dt); end); OnKeyDown := k -> begin diff --git a/InstallerSamples/Graphics/WPFObjects/Shooter.pas b/InstallerSamples/Graphics/WPFObjects/Shooter.pas index bed9235dc..885a58baf 100644 --- a/InstallerSamples/Graphics/WPFObjects/Shooter.pas +++ b/InstallerSamples/Graphics/WPFObjects/Shooter.pas @@ -3,11 +3,12 @@ type BulletWPF = class(CircleWPF) end; MonsterWPF = class(SquareWPF) end; + PlayerWPF = class(EllipseWPF) end; begin - var c := new EllipseWPF(200, 300, 30, 50, RandomColor); - c.Velocity := 100; - c.Number := 0; + var Player := new PlayerWPF(GraphWindow.Center, 30, 50, RandomColor); + Player.Velocity := 100; + Player.Number := 0; loop 5 do begin @@ -15,11 +16,11 @@ begin m.Velocity := 50; end; - OnMouseMove := (x,y,mb) -> c.RotateToPoint(x,y); + OnMouseMove := (x,y,mb) -> Player.RotateToPoint(x,y); OnMouseDown := (x,y,mb) -> begin - var cc := new BulletWPF(c.CenterTop,5,Colors.Red); - cc.Direction := (x-c.Center.X,y-c.Center.Y); + var cc := new BulletWPF(Player.CenterTop,5,Colors.Red); + cc.Direction := (x-Player.Center.X,y-Player.Center.Y); cc.Velocity := 300; end; @@ -27,49 +28,58 @@ begin BeginFrameBasedAnimationTime(dt->begin Window.Title := 'Количество объектов: '+Objects.Count; + // Перемещение игрока if kr then - c.Dx := 1 + Player.Dx := 1 else if kl then - c.Dx := -1 - else c.Dx := 0; + Player.Dx := -1 + else Player.Dx := 0; if ku then - c.Dy := -1 + Player.Dy := -1 else if kd then - c.Dy := 1 - else c.Dy := 0; + Player.Dy := 1 + else Player.Dy := 0; for var i:=Objects.Count-1 downto 0 do // все перемещаются в своём направлении со своей скоростью begin var o := Objects[i]; if o is MonsterWPF then - o.Direction := (c.Center.X - o.Center.X,c.Center.Y-o.Center.Y); - o.Move(dt); - end; + o.Direction := (Player.Center.X - o.Center.X,Player.Center.Y-o.Center.Y); + o.MoveTime(dt); + end; + + if Player.IntersectionList.Any(o -> o is MonsterWPF) then + begin + // Конец игры + + end; end); - CreateTimer(100,procedure -> // Таймер убивания монстров и умирания объектов за пределами экрана + CreateTimerAndStart(100,procedure -> // Таймер убивания монстров и умирания объектов за пределами экрана begin for var i:=Objects.Count-1 downto 0 do begin var o := Objects[i]; if (o.Center.X < 0) or (o.Center.X > Window.Width) or (o.Center.Y < 0) or (o.Center.Y > Window.Height) then - o.Destroy; + if not (o is PlayerWPF) then + o.Destroy; if o is BulletWPF then foreach var x in o.IntersectionList do if x is MonsterWPF then begin x.Destroy; o.Destroy; - c.Number += 1; + Player.Number += 1; break; end; end; end); - CreateTimer(500,procedure -> // Таймер рождения монстров + CreateTimerAndStart(1000,procedure -> // Таймер рождения монстров begin - var m := new MonsterWPF(750,Random(10,550),30,RandomColor); + var x := Random(2)=0 ? 750 : 50; + var m := new MonsterWPF(x,Random(10,550),30,RandomColor); m.Velocity := 50; end); diff --git a/NETGenerator/NETGenerator.cs b/NETGenerator/NETGenerator.cs index 7fd1ad5fd..24056fa2c 100644 --- a/NETGenerator/NETGenerator.cs +++ b/NETGenerator/NETGenerator.cs @@ -461,7 +461,7 @@ namespace PascalABCCompiler.NETGenerator an.Name = name;// + ".exe"; else an.Name = name; //+ ".dll"; - if (name == "PABCRtl" || name == "PABCRtl32") + if (name == "PABCRtl") { pabc_rtl_converted = true; an.Flags = AssemblyNameFlags.PublicKey; @@ -883,7 +883,7 @@ namespace PascalABCCompiler.NETGenerator { } - if (an.Name == "PABCRtl" || an.Name == "PABCRtl32") + if (an.Name == "PABCRtl") { CustomAttributeBuilder cab = new CustomAttributeBuilder(typeof(AssemblyKeyFileAttribute).GetConstructor(new Type[] { typeof(string) }), new object[] { an.Name == "PABCRtl" ? "PublicKey.snk" : "PublicKey32.snk" }); ab.SetCustomAttribute(cab); diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index ca8712d57..9a84469d6 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.5.0.2223 +3.5.0.2226 diff --git a/ReleaseGenerators/PascalABCNET_end.nsh b/ReleaseGenerators/PascalABCNET_end.nsh index a6d92be6d..298543ed7 100644 --- a/ReleaseGenerators/PascalABCNET_end.nsh +++ b/ReleaseGenerators/PascalABCNET_end.nsh @@ -3,9 +3,6 @@ ExecWait '"$INSTDIR\ExecHide.exe" "$INSTDIR\gacutil.exe" /u "PABCRtl"' ExecWait '"$INSTDIR\ExecHide.exe" "$INSTDIR\gacutil.exe" /i "$INSTDIR\Lib\PABCRtl.dll"' - ExecWait '"$INSTDIR\ExecHide.exe" "$INSTDIR\gacutil.exe" /u "PABCRtl32"' - ExecWait '"$INSTDIR\ExecHide.exe" "$INSTDIR\gacutil.exe" /i "$INSTDIR\Lib\PABCRtl32.dll"' - ExecWait '"$INSTDIR\ExecHide.exe" "$INSTDIR\gacutil.exe" /u "HelixToolkit.Wpf"' ExecWait '"$INSTDIR\ExecHide.exe" "$INSTDIR\gacutil.exe" /i "$INSTDIR\Lib\HelixToolkit.Wpf.dll"' diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index 4ddd5e712..c9ae336c5 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.5.0.2223' +!define VERSION '3.5.0.2226' diff --git a/ReleaseGenerators/sect_Core.nsh b/ReleaseGenerators/sect_Core.nsh index 1aaa0b422..f7382f3cd 100644 --- a/ReleaseGenerators/sect_Core.nsh +++ b/ReleaseGenerators/sect_Core.nsh @@ -133,7 +133,6 @@ File ..\bin\Lib\OpenGLABC.pcu File ..\bin\Lib\PABCRtl.dll - File ..\bin\Lib\PABCRtl32.dll File ..\bin\Lib\HelixToolkit.Wpf.dll File ..\bin\Lib\HelixToolkit.dll diff --git a/TestSuite/CompilationSamples/Timers.pas b/TestSuite/CompilationSamples/Timers.pas index 69cfff12b..033027f39 100644 --- a/TestSuite/CompilationSamples/Timers.pas +++ b/TestSuite/CompilationSamples/Timers.pas @@ -38,11 +38,11 @@ type property TimerProc: ()->() read _procedure write _procedure; end; -function CreateTimer(ms: integer; TimerProc: procedure): Timer; +function CreateTimerAndStart(ms: integer; TimerProc: procedure): Timer; implementation -function CreateTimer(ms: integer; TimerProc: procedure): Timer; +function CreateTimerAndStart(ms: integer; TimerProc: procedure): Timer; begin Result := new Timer(ms,TimerProc); Result.Start; diff --git a/VisualPascalABCNET/UserOptions.cs b/VisualPascalABCNET/UserOptions.cs index 0a641f623..1a8a89434 100644 --- a/VisualPascalABCNET/UserOptions.cs +++ b/VisualPascalABCNET/UserOptions.cs @@ -15,7 +15,7 @@ namespace VisualPascalABC public bool ConverTabsToSpaces = true; public bool deleteEXEAfterExecute = false; public bool deletePDBAfterExecute = true; - public bool UseOutputDirectory = false; + public bool UseOutputDirectory = true; public string OutputDirectory = null; public bool PauseInRunModeIfConsole = true; public string DefaultSourceFileNameFormat = "Program{0}.pas"; diff --git a/_GenerateAllSetups.bat b/_GenerateAllSetups.bat index 715622880..870362813 100644 --- a/_GenerateAllSetups.bat +++ b/_GenerateAllSetups.bat @@ -32,12 +32,6 @@ cd PABCRtl ..\sn.exe -Vu PABCRtl.dll copy PABCRtl.dll ..\..\bin\Lib -..\..\bin\pabcnetc PABCRtl32.pas /rebuild -@IF %ERRORLEVEL% NEQ 0 GOTO ERROR -..\sn.exe -Vr PABCRtl32.dll -..\sn.exe -R PABCRtl32.dll KeyPair32.snk -..\sn.exe -Vu PABCRtl32.dll -copy PABCRtl32.dll ..\..\bin\Lib cd .. ExecHide.exe gacutil.exe /u PABCRtl ExecHide.exe gacutil.exe /i ..\bin\Lib\PABCRtl.dll diff --git a/_RebuildReleaseAndBuildUnits.bat b/_RebuildReleaseAndBuildUnits.bat index 1d51b5537..1b5c79415 100644 --- a/_RebuildReleaseAndBuildUnits.bat +++ b/_RebuildReleaseAndBuildUnits.bat @@ -14,12 +14,6 @@ cd PABCRtl ..\sn.exe -Vu PABCRtl.dll copy PABCRtl.dll ..\..\bin\Lib -..\..\bin\pabcnetc PABCRtl32.pas /rebuild -@IF %ERRORLEVEL% NEQ 0 GOTO ERROR -..\sn.exe -Vr PABCRtl32.dll -..\sn.exe -R PABCRtl32.dll KeyPair32.snk -..\sn.exe -Vu PABCRtl32.dll -copy PABCRtl32.dll ..\..\bin\Lib cd .. ExecHide.exe gacutil.exe /u PABCRtl ExecHide.exe gacutil.exe /i ..\bin\Lib\PABCRtl.dll diff --git a/_RebuildReleaseAndRunTests.bat b/_RebuildReleaseAndRunTests.bat index 511de31fe..7b6b9e76e 100644 --- a/_RebuildReleaseAndRunTests.bat +++ b/_RebuildReleaseAndRunTests.bat @@ -14,12 +14,6 @@ cd PABCRtl ..\sn.exe -Vu PABCRtl.dll copy PABCRtl.dll ..\..\bin\Lib -..\..\bin\pabcnetc PABCRtl32.pas /rebuild -@IF %ERRORLEVEL% NEQ 0 GOTO ERROR -..\sn.exe -Vr PABCRtl32.dll -..\sn.exe -R PABCRtl32.dll KeyPair32.snk -..\sn.exe -Vu PABCRtl32.dll -copy PABCRtl32.dll ..\..\bin\Lib cd .. ExecHide.exe gacutil.exe /u PABCRtl ExecHide.exe gacutil.exe /i ..\bin\Lib\PABCRtl.dll diff --git a/bin/Lib/Controls.pas b/bin/Lib/Controls.pas index 73c1ef69c..28659cf7c 100644 --- a/bin/Lib/Controls.pas +++ b/bin/Lib/Controls.pas @@ -17,7 +17,7 @@ procedure AddTopPanel(Height: real := 70; c: Color := Colors.LightGray; Margin: procedure AddBottomPanel(Height: real := 70; c: Color := Colors.LightGray; Margin: real := 10); procedure AddStatusBar(Height: real := 24); -var +var ActivePanel: Panel; GlobalHMargin := 12; @@ -26,20 +26,20 @@ type GTextBlock = System.Windows.Controls.TextBlock; GTextBox = System.Windows.Controls.TextBox; GListBox = System.Windows.Controls.ListBox; - Key = System.Windows.Input.Key; + Key = System.Windows.Input.Key; ///!# CommonControl = class protected element: FrameworkElement; function GetM: real := InvokeReal(()->element.Margin.Top); procedure SetMP(m: real) := element.Margin := new Thickness(m); - procedure SetM(m: real) := Invoke(SetMP,m); + procedure SetM(m: real) := Invoke(SetMP, m); function GetW: real := InvokeReal(()->element.Width); procedure SetWP(w: real) := element.Width := w; - procedure SetW(w: real) := Invoke(SetWP,w); + procedure SetW(w: real) := Invoke(SetWP, w); function GetH: real := InvokeReal(()->element.Height); procedure SetHP(h: real) := element.Height := h; - procedure SetH(h: real) := Invoke(SetHP,h); + procedure SetH(h: real) := Invoke(SetHP, h); public property Width: real read GetW write SetW; property Height: real read GetH write SetH; @@ -54,301 +54,322 @@ type if Click <> nil then Click; end; + function GetText: string := InvokeString(()->b.Content as string); procedure SetTextP(t: string) := b.Content := t; - procedure SetText(t: string) := Invoke(SetTextP,t); - procedure CreateP(Txt: string); + procedure SetText(t: string) := Invoke(SetTextP, t); + procedure CreateP(Txt: string; fontSize: real); begin element := new GButton; - element.Margin := new Thickness(0,0,0,GlobalHMargin); + element.Margin := new Thickness(0, 0, 0, GlobalHMargin); //Margin := GlobalMargin; Text := Txt; + Self.FontSize := fontSize; b.Click += BClick; b.Focusable := False; ActivePanel.Children.Add(b); end; - procedure CreatePXY(x,y: real; Txt: string); + + procedure CreatePXY(x, y: real; Txt: string; fontSize: real); begin element := new GButton; element.SetLeft(x); element.SetTop(y); - element.Margin := new Thickness(0,0,0,GlobalHMargin); + element.Margin := new Thickness(0, 0, 0, GlobalHMargin); //Margin := GlobalMargin; Text := Txt; b.Click += BClick; b.Focusable := False; ActivePanel.Children.Add(b); end; + public Click: procedure; - constructor Create(Txt: string); + constructor Create(Txt: string; fontSize: real := 12); begin - Invoke(CreateP,Txt); + Invoke(CreateP, Txt, fontSize); end; - constructor Create(x,y: real; Txt: string); + + constructor Create(x, y: real; Txt: string; fontsize: real := 12); begin - Invoke(CreatePXY,x,y,Txt); + Invoke(CreatePXY, x, y, Txt, fontsize); end; + property Text: string read GetText write SetText; - property FontSize: real read InvokeReal(()->b.FontSize) write Invoke(procedure(t: real) -> b.FontSize := t,value); - property Enabled: boolean read InvokeBoolean(()->b.IsEnabled) write Invoke(procedure(t: boolean) -> b.IsEnabled := t,value); + property FontSize: real read InvokeReal(()->b.FontSize) write Invoke(procedure(t: real) -> b.FontSize := t, value); + property Enabled: boolean read InvokeBoolean(()->b.IsEnabled) write Invoke(procedure(t: boolean) -> b.IsEnabled := t, value); end; ///!# - TextLabelT = class(CommonControl) + TextBlockT = class(CommonControl) protected function b: GTextBlock := element as GTextBlock; procedure CreateP(Txt: string; fontsize: real); begin var tb := new GTextBlock; element := tb; - element.Margin := new Thickness(0,0,0,GlobalHMargin); + element.Margin := new Thickness(0, 0, 0, GlobalHMargin); //element.Margin := new Thickness(5,5,5,0); tb.FontSize := fontsize; Text := Txt; ActivePanel.Children.Add(b); end; - procedure CreatePXY(x,y: real; Txt: string; fontsize: real); + + procedure CreatePXY(x, y: real; Txt: string; fontsize: real); begin var tb := new GTextBlock; element := tb; - element.Margin := new Thickness(0,0,0,GlobalHMargin); + element.Margin := new Thickness(0, 0, 0, GlobalHMargin); //tb.Background := new SolidColorBrush(Colors.White); //tb.Opacity := 0.7; - Canvas.SetLeft(element,x); - Canvas.SetTop(element,y); + Canvas.SetLeft(element, x); + Canvas.SetTop(element, y); tb.FontSize := fontsize; Text := Txt; ActivePanel.Children.Add(b); end; + public - constructor Create(Txt: string; fontsize: real := 12) := Invoke(CreateP,Txt,fontsize); - constructor Create(x,y: real; Txt: string; fontsize: real := 12) := Invoke(CreatePXY,x,y,Txt,fontsize); - property Text: string read InvokeString(()->b.Text) write Invoke(procedure(t: string) -> b.Text := t,value); - property FontSize: real read InvokeReal(()->b.FontSize) write Invoke(procedure(t: real) -> b.FontSize := t,value); - end; - - IntegerLabelT = class(TextLabelT) - private - val := 0; - message: string; - procedure CreateP(message: string; fontSize: real := 12; initValue: integer := 0); - begin - inherited CreateP(message+' '+initValue,fontSize); - Self.message := message; - val := initValue; - end; - public - property Value: integer read val write begin val := value; Text := message+' '+val; end; - constructor Create(message: string; fontSize: real := 12; initValue: integer := 0) := Invoke(CreateP,message,fontSize,initValue); - end; - - RealLabelT = class(TextLabelT) - private - val := 0.0; - message: string; - procedure CreateP(message: string; fontSize: real := 12; initValue: real := 0); - begin - inherited CreateP(message+' '+initValue.ToString(FracDigits),fontSize); - Self.message := message; - val := initValue; - end; - public - property Value: real read val write begin val := value; Text := message+' '+val.ToString(FracDigits); end; - constructor Create(message: string; fontSize: real := 12; initValue: real := 0) := Invoke(CreateP,message,fontSize,initValue); - auto property FracDigits: integer := 1; - end; - - ///!# - TextBoxT = class(CommonControl) - protected - function tb: GTextBox := element as GTextBox; - procedure BTextChanged(sender: Object; e: TextChangedEventArgs); - begin - if Click <> nil then - Click; - end; - function GetText: string := InvokeString(()->tb.Text); - procedure SetTextP(t: string) := tb.Text := t; - procedure SetText(t: string) := Invoke(SetTextP,t); - procedure CreateP(Txt: string; w: real); - begin - element := new GTextBox; - element.HorizontalAlignment := HorizontalAlignment.Stretch; - element.Margin := new Thickness(0,0,0,GlobalHMargin); - Text := Txt; - if w > 0 then - Width := w; - tb.TextChanged += BTextChanged; - ActivePanel.Children.Add(tb); - end; - public - event Click: procedure; - constructor Create(Txt: string := ''; w: real := 0); - begin - Invoke(CreateP,Txt,w); - end; - property Text: string read GetText write SetText; - property FontSize: real read InvokeReal(()->tb.FontSize) write Invoke(procedure(t: real) -> tb.FontSize := t,value); - end; - - IntegerBoxT = class(TextBoxT) - function GetValue: integer; - begin - if Trim(Text) = '' then - Result := 0 - else Result := integer.Parse(Text); - end; + constructor Create(Txt: string; fontsize: real := 12):= Invoke(CreateP, Txt, fontsize); + constructor Create(x, y: real; Txt: string; fontsize: real := 12):= Invoke(CreatePXY, x, y, Txt, fontsize); +property Text: string read InvokeString(()->b.Text) write Invoke(procedure(t: string) -> b.Text := t, value); +property FontSize: real read InvokeReal(()->b.FontSize) write Invoke(procedure(t: real) -> b.FontSize := t, value); +end; - procedure SetValue(x: integer) := Text := x.ToString; - public - constructor Create(w: real := 0); - begin - inherited Create('0',w); - var tb := element as GTextBox; - tb.MouseWheel += procedure (o,e) -> begin - if e.Delta>0 then - SetValue(GetValue+1) - else if e.Delta<0 then - SetValue(GetValue-1) - end; - tb.KeyDown += procedure (o,e) -> begin - if not ((e.Key>=Key.D0) and (e.Key<=Key.D9)) then - e.Handled := True; - end; - {tb.TextInput += procedure (o,e) -> begin - Print(e.Text); - if not ((e.Key>=Key.D0) and (e.Key<=Key.D9)) then - e.Handled := True; - end;} - end; - property Value: integer read GetValue write SetValue; - property FontSize: real read InvokeReal(()->tb.FontSize) write Invoke(procedure(t: real) -> tb.FontSize := t,value); +IntegerBlockT = class(TextBlockT) +private + val := 0; + message: string; + procedure CreateP(message: string; fontSize: real := 12; initValue: integer := 0); + begin + inherited CreateP(message + ' ' + initValue, fontSize); + Self.message := message; + val := initValue; end; - - TextBoxWithLabelT = class(CommonControl) - private - l: TextBlock; - protected - function tb: GTextBox := (element as StackPanel).Children[1] as GTextBox; - procedure BTextChanged(sender: Object; e: TextChangedEventArgs); - begin - if Click <> nil then - Click; - end; - function GetText: string := InvokeString(()->tb.Text); - procedure SetTextP(t: string) := tb.Text := t; - procedure SetText(t: string) := Invoke(SetTextP,t); - procedure CreateP(LabelTxt,Txt: string; w: real); - begin - var sp := new StackPanel; - element := sp; - sp.Orientation := Orientation.Horizontal; - sp.HorizontalAlignment := HorizontalAlignment.Stretch; - l := new TextBlock(); - l.Text := LabelTxt; - sp.Children.Add(l); - var tb := new GTextBox; - tb.Width := 100; - tb.VerticalAlignment := VerticalAlignment.Stretch; - tb.Margin := new Thickness(0,0,0,GlobalHMargin); - sp.Children.Add(tb); - Text := Txt; - if w > 0 then - Width := w; - tb.TextChanged += BTextChanged; - ActivePanel.Children.Add(sp); - end; - public - event Click: procedure; - constructor Create(LabelTxt: string; Txt: string := ''; w: real := 0); - begin - Invoke(CreateP,LabelTxt,Txt,w); - end; - property Text: string read GetText write SetText; - property FontSize: real read InvokeReal(()->tb.FontSize) write Invoke(procedure(t: real) -> begin tb.FontSize := t; l.FontSize := t; end,value); + +public + property Value: integer read val write begin val := value; Text := message + ' ' + val; end; + constructor Create(message: string; fontSize: real := 12; initValue: integer := 0):= Invoke(CreateP, message, fontSize, initValue); +end; + +RealBlockT = class(TextBlockT) +private + val := 0.0; + message: string; + procedure CreateP(message: string; fontSize: real := 12; initValue: real := 0); + begin + inherited CreateP(message + ' ' + initValue.ToString(FracDigits), fontSize); + Self.message := message; + val := initValue; end; +public + property Value: real read val write begin val := value; Text := message + ' ' + val.ToString(FracDigits); end; + constructor Create(message: string; fontSize: real := 12; initValue: real := 0):= Invoke(CreateP, message, fontSize, initValue); +auto property FracDigits: integer := 1; +end; + ///!# - ListBoxT = class(CommonControl) - protected - function tb: GListBox := element as GListBox; - procedure CreateP(w,h: real); - begin - element := new GListBox; - element.HorizontalAlignment := HorizontalAlignment.Stretch; - element.Margin := new Thickness(0,0,0,GlobalHMargin); - if w > 0 then - Width := w; - Height := h; - ActivePanel.Children.Add(tb); - end; - procedure AddP(s: string); - begin - var lbi := new ListBoxItem(); - lbi.Content := s; - tb.Items.Add(lbi); - end; - procedure SortP := tb.Items.SortDescriptions.Add(new SortDescription('Content', ListSortDirection.Ascending)); - procedure SortPDescending := tb.Items.SortDescriptions.Add(new SortDescription('Content', ListSortDirection.Descending)); - public - event Click: procedure; - constructor Create(w: real := 0; h: real := 200) := Invoke(CreateP,w,h); - procedure Sort := Invoke(SortP); - procedure SortDescending := Invoke(SortPDescending); - procedure Add(s: string) := Invoke(AddP,s); - property FontSize: real read InvokeReal(()->tb.FontSize) write Invoke(procedure(t: real) -> tb.FontSize := t,value); - property Count: integer read InvokeInteger(()->tb.Items.Count); - property SelectedIndex: integer read InvokeInteger(()->tb.SelectedIndex) write Invoke(procedure(t: integer) -> tb.SelectedIndex := t,value); - property SelectedText: string read InvokeString(()->tb.SelectedItem as string) write Invoke(procedure(t: string) -> tb.SelectedItem := t,value); +TextBoxT = class(CommonControl) +protected + function tb: GTextBox := element as GTextBox; + procedure BTextChanged(sender: Object; e: TextChangedEventArgs); + begin + if Click <> nil then + Click; end; - SliderT = class(CommonControl) - private - function sl: Slider := element as Slider; - function GetMinimum: real := InvokeReal(()->sl.Minimum); - procedure SetMinimumP(r: real) := sl.Minimum := r; - procedure SetMinimum(r: real) := Invoke(SetMinimumP,r); - function GetMaximum: real := InvokeReal(()->sl.Maximum); - procedure SetMaximumP(r: real) := sl.Maximum := r; - procedure SetMaximum(r: real) := Invoke(SetMaximumP,r); - function GetValue: real := InvokeReal(()->sl.Value); - procedure SetValueP(r: real) := sl.Value := r; - procedure SetValue(r: real) := Invoke(SetValueP,r); - function GetFrequency: real := InvokeReal(()->sl.TickFrequency); - procedure SetFrequencyP(r: real) := sl.TickFrequency := r; - procedure SetFrequency(r: real) := Invoke(SetFrequencyP,r); - protected - procedure CreateP(min,max,val: real); - begin - element := new Slider; - sl.ValueChanged += procedure(o,e) -> ValueChangedP; - sl.TickPlacement := System.Windows.Controls.Primitives.TickPlacement.BottomRight; - sl.Minimum := min; - sl.Maximum := max; - sl.Value := val; - ActivePanel.Children.Add(sl); - end; - procedure ValueChangedP := if ValueChanged<>nil then ValueChanged; - public - event ValueChanged: procedure; - constructor Create(min,max,val: real); - begin - Invoke(CreateP,min,max,val); - end; - property Minimum: real read GetMinimum write SetMinimum; - property Maximum: real read GetMaximum write SetMaximum; - property Value: real read GetValue write SetValue; - property Frequency: real read GetFrequency write SetFrequency; + function GetText: string := InvokeString(()->tb.Text); + procedure SetTextP(t: string) := tb.Text := t; + procedure SetText(t: string) := Invoke(SetTextP, t); + procedure CreateP(Txt: string; w: real); + begin + element := new GTextBox; + element.HorizontalAlignment := HorizontalAlignment.Stretch; + element.Margin := new Thickness(0, 0, 0, GlobalHMargin); + Text := Txt; + if w > 0 then + Width := w; + tb.TextChanged += BTextChanged; + ActivePanel.Children.Add(tb); end; +public + event Click: procedure; + constructor Create(Txt: string := ''; w: real := 0); + begin + Invoke(CreateP, Txt, w); + end; -function Button(Txt: string): ButtonT; -function Button(x,y: integer; Txt: string): ButtonT; -function TextLabel(Txt: string; fontsize: real := 12): TextLabelT; -function TextLabel(x,y: real; Txt: string; fontsize: real := 12): TextLabelT; -function IntegerLabel(message: string; fontsize: real := 12; initValue: integer := 0): IntegerLabelT; -function RealLabel(message: string; fontsize: real := 12; initValue: real := 0): RealLabelT; + property Text: string read GetText write SetText; + property FontSize: real read InvokeReal(()->tb.FontSize) write Invoke(procedure(t: real) -> tb.FontSize := t, value); +end; + +IntegerBoxT = class(TextBoxT) + function GetValue: integer; + begin + if Trim(Text) = '' then + Result := 0 + else Result := integer.Parse(Text); + end; + + procedure SetValue(x: integer) := Text := x.ToString; +public + constructor Create(w: real := 0); + begin + inherited Create('0', w); + var tb := element as GTextBox; + tb.MouseWheel += procedure (o, e) -> begin + if e.Delta > 0 then + SetValue(GetValue + 1) + else if e.Delta < 0 then + SetValue(GetValue - 1) + end; + tb.KeyDown += procedure (o, e) -> begin + if not ((e.Key >= Key.D0) and (e.Key <= Key.D9)) then + e.Handled := True; + end; + {tb.TextInput += procedure (o,e) -> begin + Print(e.Text); + if not ((e.Key>=Key.D0) and (e.Key<=Key.D9)) then + e.Handled := True; + end;} + end; + + property Value: integer read GetValue write SetValue; + property FontSize: real read InvokeReal(()->tb.FontSize) write Invoke(procedure(t: real) -> tb.FontSize := t, value); +end; + +TextBoxWithBlockT = class(CommonControl) +private + l: TextBlock; +protected + function tb: GTextBox := (element as StackPanel).Children[1] as GTextBox; + procedure BTextChanged(sender: Object; e: TextChangedEventArgs); + begin + if Click <> nil then + Click; + end; + + function GetText: string := InvokeString(()->tb.Text); + procedure SetTextP(t: string) := tb.Text := t; + procedure SetText(t: string) := Invoke(SetTextP, t); + procedure CreateP(BlockTxt, Txt: string; w: real); + begin + var sp := new StackPanel; + element := sp; + sp.Orientation := Orientation.Horizontal; + sp.HorizontalAlignment := HorizontalAlignment.Stretch; + l := new TextBlock(); + l.Text := BlockTxt; + sp.Children.Add(l); + var tb := new GTextBox; + tb.Width := 100; + tb.VerticalAlignment := VerticalAlignment.Stretch; + tb.Margin := new Thickness(0, 0, 0, GlobalHMargin); + sp.Children.Add(tb); + Text := Txt; + if w > 0 then + Width := w; + tb.TextChanged += BTextChanged; + ActivePanel.Children.Add(sp); + end; + +public + event Click: procedure; + constructor Create(BlockTxt: string; Txt: string := ''; w: real := 0); + begin + Invoke(CreateP, BlockTxt, Txt, w); + end; + + property Text: string read GetText write SetText; + property FontSize: real read InvokeReal(()->tb.FontSize) write Invoke(procedure(t: real) -> begin tb.FontSize := t; l.FontSize := t; end, value); +end; + + ///!# +ListBoxT = class(CommonControl) +protected + function tb: GListBox := element as GListBox; + procedure CreateP(w, h: real); + begin + element := new GListBox; + element.HorizontalAlignment := HorizontalAlignment.Stretch; + element.Margin := new Thickness(0, 0, 0, GlobalHMargin); + if w > 0 then + Width := w; + Height := h; + ActivePanel.Children.Add(tb); + end; + + procedure AddP(s: string); + begin + var lbi := new ListBoxItem(); + lbi.Content := s; + tb.Items.Add(lbi); + end; + + procedure SortP := tb.Items.SortDescriptions.Add(new SortDescription('Content', ListSortDirection.Ascending)); + procedure SortPDescending := tb.Items.SortDescriptions.Add(new SortDescription('Content', ListSortDirection.Descending)); +public + event Click: procedure; + constructor Create(w: real := 0; h: real := 200):= Invoke(CreateP, w, h); +procedure Sort := Invoke(SortP); + procedure SortDescending := Invoke(SortPDescending); + procedure Add(s: string) := Invoke(AddP, s); + property FontSize: real read InvokeReal(()->tb.FontSize) write Invoke(procedure(t: real) -> tb.FontSize := t, value); + property Count: integer read InvokeInteger(()->tb.Items.Count); + property SelectedIndex: integer read InvokeInteger(()->tb.SelectedIndex) write Invoke(procedure(t: integer) -> tb.SelectedIndex := t, value); + property SelectedText: string read InvokeString(()->tb.SelectedItem as string) write Invoke(procedure(t: string) -> tb.SelectedItem := t, value); +end; + +SliderT = class(CommonControl) +private + function sl: Slider := element as Slider; + function GetMinimum: real := InvokeReal(()->sl.Minimum); + procedure SetMinimumP(r: real) := sl.Minimum := r; + procedure SetMinimum(r: real) := Invoke(SetMinimumP, r); + function GetMaximum: real := InvokeReal(()->sl.Maximum); + procedure SetMaximumP(r: real) := sl.Maximum := r; + procedure SetMaximum(r: real) := Invoke(SetMaximumP, r); + function GetValue: real := InvokeReal(()->sl.Value); + procedure SetValueP(r: real) := sl.Value := r; + procedure SetValue(r: real) := Invoke(SetValueP, r); + function GetFrequency: real := InvokeReal(()->sl.TickFrequency); + procedure SetFrequencyP(r: real) := sl.TickFrequency := r; + procedure SetFrequency(r: real) := Invoke(SetFrequencyP, r); +protected + procedure CreateP(min, max, val: real); + begin + element := new Slider; + sl.ValueChanged += procedure(o, e) -> ValueChangedP; + sl.TickPlacement := System.Windows.Controls.Primitives.TickPlacement.BottomRight; + sl.Minimum := min; + sl.Maximum := max; + sl.Value := val; + ActivePanel.Children.Add(sl); + end; + + procedure ValueChangedP := if ValueChanged <> nil then ValueChanged; +public + event ValueChanged: procedure; + constructor Create(min, max, val: real); + begin + Invoke(CreateP, min, max, val); + end; + + property Minimum: real read GetMinimum write SetMinimum; + property Maximum: real read GetMaximum write SetMaximum; + property Value: real read GetValue write SetValue; + property Frequency: real read GetFrequency write SetFrequency; +end; + + +function Button(Txt: string; fontSize: real := 12): ButtonT; +function Button(x, y: integer; Txt: string; fontSize: real := 12): ButtonT; +function TextBlock(Txt: string; fontSize: real := 12): TextBlockT; +function TextBlock(x, y: real; Txt: string; fontSize: real := 12): TextBlockT; +function IntegerBlock(message: string; fontSize: real := 12; initValue: integer := 0): IntegerBlockT; +function RealBlock(message: string; fontSize: real := 12; initValue: real := 0): RealBlockT; function TextBox(Txt: string := ''; w: real := 0): TextBoxT; function ListBox(w: real := 0; h: real := 200): ListBoxT; function IntegerBox(w: real := 0): IntegerBoxT; @@ -364,13 +385,13 @@ uses System.Windows.Controls; uses System.Windows.Controls.Primitives; uses System.Windows.Media.Imaging; -var +var StatusBarPanel: StatusBar; - LeftPanel,RightPanel,TopPanel,BottomPanel: Panel; + LeftPanel, RightPanel, TopPanel, BottomPanel: Panel; procedure AddPanel(var pp: StackPanel; wh: real; d: Dock; c: Color; Margin: real := 10); begin - if pp<>nil then + if pp <> nil then exit; var bb := new Border(); bb.Background := new SolidColorBrush(c); @@ -389,28 +410,31 @@ begin bb.Height := wh; end; p.Background := new SolidColorBrush(c); - DockPanel.SetDock(bb,d); + DockPanel.SetDock(bb, d); //MainDockPanel.children.Insert(MainDockPanel.children.Count-1,bb); - MainDockPanel.children.Insert(0,bb); + MainDockPanel.children.Insert(0, bb); //MainDockPanel.children.Add(bb); pp := p; ActivePanel := p; end; -procedure AddRightPanel(Width: real; c: Color; Margin: real) := Invoke(AddPanel,RightPanel,Width,Dock.Right,c,Margin); -procedure AddLeftPanel(Width: real; c: Color; Margin: real) := Invoke(AddPanel,LeftPanel,Width,Dock.Left,c,Margin); -procedure AddTopPanel(Height: real; c: Color; Margin: real) := Invoke(AddPanel,TopPanel,Height,Dock.Top,c,Margin); -procedure AddBottomPanel(Height: real; c: Color; Margin: real) := Invoke(AddPanel,BottomPanel,Height,Dock.Bottom,c,Margin); +procedure AddRightPanel(Width: real; c: Color; Margin: real) := Invoke(AddPanel, RightPanel, Width, Dock.Right, c, Margin); + +procedure AddLeftPanel(Width: real; c: Color; Margin: real) := Invoke(AddPanel, LeftPanel, Width, Dock.Left, c, Margin); + +procedure AddTopPanel(Height: real; c: Color; Margin: real) := Invoke(AddPanel, TopPanel, Height, Dock.Top, c, Margin); + +procedure AddBottomPanel(Height: real; c: Color; Margin: real) := Invoke(AddPanel, BottomPanel, Height, Dock.Bottom, c, Margin); procedure AddStatusBarP(Height: real); begin - if StatusBarPanel<>nil then + if StatusBarPanel <> nil then exit; var sb := new StatusBar; sb.Height := 24; - DockPanel.SetDock(sb,Dock.Bottom); + DockPanel.SetDock(sb, Dock.Bottom); // Всегда первая - MainDockPanel.children.Insert(0,sb); + MainDockPanel.children.Insert(0, sb); StatusBarPanel := sb; {var sbi := new StatusBarItem(); sbi.Content := 'sdghj'; @@ -419,24 +443,34 @@ begin sbi.Content := '222'; sb.Items.Add(sbi);} end; -procedure AddStatusBar(Height: real) := Invoke(AddStatusBarP,Height); -function Button(Txt: string): ButtonT := ButtonT.Create(Txt); -function Button(x,y: integer; Txt: string): ButtonT := ButtonT.Create(x,y,Txt); -function TextLabel(Txt: string; fontsize: real): TextLabelT := TextLabelT.Create(Txt,fontsize); -function TextLabel(x,y: real; Txt: string; fontsize: real): TextLabelT := TextLabelT.Create(x,y,Txt,fontsize); -function IntegerLabel(message: string; fontsize: real; initValue: integer): IntegerLabelT := IntegerLabelT.Create(message,fontsize,initValue); -function RealLabel(message: string; fontsize: real; initValue: real): RealLabelT := RealLabelT.Create(message,fontsize,initValue); -function TextBox(Txt: string; w: real): TextBoxT := TextBoxT.Create(Txt,w); -function ListBox(w,h: real): ListBoxT := ListBoxT.Create(w,h); +procedure AddStatusBar(Height: real) := Invoke(AddStatusBarP, Height); + +function Button(Txt: string; fontSize: real): ButtonT := ButtonT.Create(Txt,fontSize); + +function Button(x, y: integer; Txt: string; fontSize: real): ButtonT := ButtonT.Create(x, y, Txt,fontSize); + +function TextBlock(Txt: string; fontsize: real): TextBlockT := TextBlockT.Create(Txt, fontsize); + +function TextBlock(x, y: real; Txt: string; fontsize: real): TextBlockT := TextBlockT.Create(x, y, Txt, fontsize); + +function IntegerBlock(message: string; fontsize: real; initValue: integer): IntegerBlockT := IntegerBlockT.Create(message, fontsize, initValue); + +function RealBlock(message: string; fontsize: real; initValue: real): RealBlockT := RealBlockT.Create(message, fontsize, initValue); + +function TextBox(Txt: string; w: real): TextBoxT := TextBoxT.Create(Txt, w); + +function ListBox(w, h: real): ListBoxT := ListBoxT.Create(w, h); + function IntegerBox(w: real): IntegerBoxT := IntegerBoxT.Create(w); -function Slider(min,max,val: real): SliderT := SliderT.Create(min,max,val); + +function Slider(min, max, val: real): SliderT := SliderT.Create(min, max, val); procedure EmptyBlock(sz: integer); begin - var e := TextLabel(''); - e.Height:= sz; - e.Width:= sz; + var e := TextBlock(''); + e.Height := sz; + e.Width := sz; end; procedure SetActivePanelInit;