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

Убран PabcRtl32.dll

Browse source
This commit is contained in:
Mikhalkovich Stanislav 2019-08-18 00:16:39 +03:00
parent 0a0bb394ae
commit c7a3beec39
17 changed files with 341 additions and 319 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Compiler/Compiler.cs
View file

@ -3615,7 +3615,7 @@ namespace PascalABCCompiler
public static Dictionary<string, string> standart_assembly_dict = new Dictionary<string, string>();
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);
}

2
Configuration/GlobalAssemblyInfo.cs
View file

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

4
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%MINOR%=5
%REVISION%=2223
%COREVERSION%=0
%REVISION%=2226
%MINOR%=5
%MAJOR%=3

2
InstallerSamples/Games/DeleteByMouse.pas
View file

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

2
InstallerSamples/Graphics/WPFObjects/MovingFrameBasedTime.pas
View file

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

50
InstallerSamples/Graphics/WPFObjects/Shooter.pas
View file

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

4
NETGenerator/NETGenerator.cs
View file

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

2
Release/pabcversion.txt
View file

@ -1 +1 @@
3.5.0.2223
3.5.0.2226

3
ReleaseGenerators/PascalABCNET_end.nsh
View file

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

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.5.0.2223'
!define VERSION '3.5.0.2226'

1
ReleaseGenerators/sect_Core.nsh
View file

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

4
TestSuite/CompilationSamples/Timers.pas
View file

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

2
VisualPascalABCNET/UserOptions.cs
View file

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

6
_GenerateAllSetups.bat
View file

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

6
_RebuildReleaseAndBuildUnits.bat
View file

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

6
_RebuildReleaseAndRunTests.bat
View file

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

562
bin/Lib/Controls.pas
View file

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