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

fix #1810

Browse source 
GraphWPF и WPFObjects теперь можно использовать вместе!
This commit is contained in:
Mikhalkovich Stanislav 2019-03-03 00:05:26 +03:00
parent 6006d58d87
commit 39f3d28e47
13 changed files with 178 additions and 453 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 = "4";
public const string Build = "2";
public const string Revision = "1987";
public const string Revision = "1989";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

2
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%COREVERSION%=2
%REVISION%=1987
%REVISION%=1989
%MINOR%=4
%MAJOR%=3

BIN
Localization/DefaultLang.resources
View file

Binary file not shown.

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.4.2.1987'
!define VERSION '3.4.2.1989'

69
TestSuite/CompilationSamples/GraphWPF.pas
View file

@ -174,6 +174,8 @@ type
procedure Load(fname: string);
/// Очищает графическое окно белым цветом
procedure Clear; override;
/// Очищает графическое окно цветом c
procedure Clear(c: Color); override;
end;
//{{{--doc: Конец секции 2 }}}
@ -465,6 +467,10 @@ var OnResize: procedure;
//{{{--doc: Конец секции 3 }}}
// Для WPFObjects
var AdditionalInit: procedure;
function GetMouseArgs(e: MouseEventArgs): (Point,integer);
{procedure AddRightPanel(Width: real := 200; c: Color := Colors.LightGray);
procedure AddLeftPanel(Width: real := 200; c: Color := Colors.LightGray);
procedure AddTopPanel(Height: real := 100; c: Color := Colors.LightGray);
@ -1296,8 +1302,23 @@ begin
end;
end;
procedure WindowTypeClearPC(c: Color);
begin
Host.children.Clear;
if not rtbmapIsCleared then
begin
rtbmap.Clear;
rtbmapIsCleared := True;
end;
FillRectangle(0,0,Window.Width,Window.Height,c)
end;
procedure WindowTypeWPF.Clear := Invoke(WindowTypeClearP);
procedure WindowTypeWPF.Clear(c: Color) := Invoke(WindowTypeClearPC,c);
function XMin := -XOrigin/GlobalScale;
function XMax := (Window.Width-XOrigin)/GlobalScale;
function YMin := -(Window.Height-YOrigin)/GlobalScale;
@ -1397,8 +1418,8 @@ begin
end;
procedure SetStandardCoordsSharpLines(x0,y0: real) := Invoke(SetStandardCoordsSharpLinesP,x0,y0);
/// --- SystemMouseEvents
procedure SystemOnMouseDown(sender: Object; e: MouseButtonEventArgs);
function GetMouseArgs(e: MouseEventArgs): (Point,integer);
begin
var mb := 0;
var p := e.GetPosition(host);
@ -1406,30 +1427,27 @@ begin
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
Result := (p,mb);
end;
/// --- SystemMouseEvents
procedure SystemOnMouseDown(sender: Object; e: MouseButtonEventArgs);
begin
var (p,mb) := GetMouseArgs(e);
if OnMouseDown <> nil then
OnMouseDown(p.x, p.y, mb);
end;
procedure SystemOnMouseUp(sender: Object; e: MouseButtonEventArgs);
begin
var mb := 0;
var p := e.GetPosition(host);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
var (p,mb) := GetMouseArgs(e);
if OnMouseUp <> nil then
OnMouseUp(p.x, p.y, mb);
end;
procedure SystemOnMouseMove(sender: Object; e: MouseEventArgs);
begin
var mb := 0;
var p := e.GetPosition(host);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
var (p,mb) := GetMouseArgs(e);
if OnMouseMove <> nil then
OnMouseMove(p.x, p.y, mb);
end;
@ -1444,10 +1462,8 @@ procedure SystemOnKeyUp(sender: Object; e: KeyEventArgs) :=
OnKeyUp(e.Key);
procedure SystemOnKeyPress(sender: Object; e: TextCompositionEventArgs) :=
begin
if (OnKeyPress<>nil) and (e.Text<>nil) and (e.Text.Length>0) then
OnKeyPress(e.Text[1]);
end;
procedure SystemOnResize(sender: Object; e: SizeChangedEventArgs) :=
if OnResize<>nil then
@ -1455,10 +1471,6 @@ procedure SystemOnResize(sender: Object; e: SizeChangedEventArgs) :=
///----------------------------------------------------------------------
{procedure RenderFrame(s: Object; e: System.EventArgs);
begin
end;}
var OnDraw: procedure := nil;
var OnDraw1: procedure(frame: integer) := nil;
@ -1479,7 +1491,6 @@ begin
else LastUpdatedTime := e1;
FrameNum += 1;
Window.Clear;
//CountVisuals := integer.MinValue; // чтобы не было паузы после 1000 объектов
if OnDraw<>nil then
OnDraw()
else if OnDraw1<>nil then
@ -1511,19 +1522,6 @@ begin
FrameRate := 60;
end;
{procedure AddGraphWindow;
begin
host := new MyVisualHost();
host.ClipToBounds := True;
host.SizeChanged += (s,e) ->
begin
var sz := e.NewSize;
host.DataContext := sz;
end;
// Всегда последнее
MainDockPanel.children.Add(host);
end;}
var mre := new ManualResetEvent(false);
type
@ -1541,7 +1539,6 @@ public
// Всегда последнее
var g := Content as DockPanel;
var dpiXProperty := typeof(SystemParameters).GetProperty('DpiX', BindingFlags.NonPublic or BindingFlags.Static);
var dpiYProperty := typeof(SystemParameters).GetProperty('Dpi', BindingFlags.NonPublic or BindingFlags.Static);
@ -1592,12 +1589,10 @@ public
CompositionTarget.Rendering += RenderFrame;
Loaded += (o,e) -> mre.Set();
end;
end;
procedure InitApp;
begin
app := new Application;

2
TestSuite/CompilationSamples/GraphWPFBase.pas
View file

@ -106,7 +106,7 @@ type
/// Очищает графическое окно белым цветом
procedure Clear; virtual;
/// Очищает графическое окно цветом c
procedure Clear(c: GColor);
procedure Clear(c: GColor); virtual;
/// Устанавливает размеры клиентской части главного окна
procedure SetSize(w, h: real);
/// Устанавливает отступ главного окна от левого верхнего края экрана

227
TestSuite/CompilationSamples/WPFObjects.pas
View file

@ -5,7 +5,7 @@ unit WPFObjects;
interface
uses GraphWPFBase;
uses GraphWPFBase,GraphWPF;
uses System.Windows;
uses System.Windows.Controls;
@ -81,27 +81,6 @@ procedure Invoke(p: ()->());
//{{{doc: Начало секции 2 }}}
type
// -----------------------------------------------------
//>> Класс графического окна # Class GraphWindowType
// -----------------------------------------------------
/// Класс графического окна
GraphWindowType = class
private
function GetTop: real;
function GetLeft: real;
function GetWidth: real;
function GetHeight: real;
public
/// Отступ графического окна от левого края главного окна
property Left: real read GetLeft;
/// Отступ графического окна от верхнего края главного окна
property Top: real read GetTop;
/// Ширина графического окна
property Width: real read GetWidth;
/// Высота графического окна
property Height: real read GetHeight;
end;
ObjectWPF = class;
// -----------------------------------------------------
//>> Класс списка графических объектов # Class List of objects
@ -1133,7 +1112,6 @@ begin
end;
end;
type ObHelper = auto class
o1,o2: ObjectWPF;
function f: boolean := ObjectsIntersectP(o1,o2);
@ -1151,99 +1129,32 @@ function ObjectsIntersect(o1,o2: ObjectWPF)
function IntersectionList(Self: ObjectWPF): List<ObjectWPF>; extensionmethod
:= Invoke&<List<ObjectWPF>>(OLHelper.Create(Self).f);
//---------------------------------------------------------------------------
function GraphWindowTypeGetLeftP: real;
begin
Result := 0;
foreach var p in MainDockPanel.Children do
if (p is FrameworkElement) and (p<>host) then
begin
var d := DockPanel.GetDock(FrameworkElement(p));
if d=Dock.Left then
Result += FrameworkElement(p).Width;
end;
end;
var
///--
__initialized := false;
function GraphWindowTypeGetTopP: real;
begin
Result := 0;
foreach var p in MainDockPanel.Children do
if (p is FrameworkElement) and (p<>host) then
begin
var d := DockPanel.GetDock(FrameworkElement(p));
if d=Dock.Top then
Result += FrameworkElement(p).Height;
end;
end;
function GraphWindowType.GetLeft := InvokeReal(GraphWindowTypeGetLeftP);
function GraphWindowType.GetTop := InvokeReal(GraphWindowTypeGetTopP);
function GraphWindowTypeGetWidthP: real;
begin
{if host.DataContext = nil then
Result := 0
else Result := Size(host.DataContext).Width;}
Result := Window.Width;
foreach var p in MainDockPanel.Children do
if (p is FrameworkElement) and (p<>host) then
begin
var d := DockPanel.GetDock(FrameworkElement(p));
if (d=Dock.Left) or (d=Dock.Right) then
Result -= FrameworkElement(p).Width;
end;
end;
function GraphWindowType.GetWidth := InvokeReal(GraphWindowTypeGetWidthP);
function GraphWindowTypeGetHeightP: real;
begin
{if host.DataContext = nil then
Result := 0
else Result := Size(host.DataContext).Height;}
Result := Window.Height;
foreach var p in MainDockPanel.Children do
if (p is FrameworkElement) and (p<>host) then
begin
var d := DockPanel.GetDock(FrameworkElement(p));
if (d=Dock.Top) or (d=Dock.Bottom) then
Result -= FrameworkElement(p).Height;
end;
end;
function GraphWindowType.GetHeight := InvokeReal(GraphWindowTypeGetHeightP);
var
///--
__finalized := false;
/// --- SystemMouseEvents
procedure SystemOnMouseDown(sender: Object; e: MouseButtonEventArgs);
begin
var mb := 0;
var p := e.GetPosition(host);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
var (p,mb) := GetMouseArgs(e);
if OnMouseDown <> nil then
OnMouseDown(p.x, p.y, mb);
end;
procedure SystemOnMouseUp(sender: Object; e: MouseButtonEventArgs);
begin
var mb := 0;
var p := e.GetPosition(host);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
var (p,mb) := GetMouseArgs(e);
if OnMouseUp <> nil then
OnMouseUp(p.x, p.y, mb);
end;
procedure SystemOnMouseMove(sender: Object; e: MouseEventArgs);
begin
var mb := 0;
var p := e.GetPosition(host);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
var (p,mb) := GetMouseArgs(e);
if OnMouseMove <> nil then
OnMouseMove(p.x, p.y, mb);
end;
@ -1258,113 +1169,41 @@ procedure SystemOnKeyUp(sender: Object; e: KeyEventArgs) :=
OnKeyUp(e.Key);
procedure SystemOnKeyPress(sender: Object; e: TextCompositionEventArgs) :=
begin
if (OnKeyPress<>nil) and (e.Text<>nil) and (e.Text.Length>0) then
OnKeyPress(e.Text[1]);
end;
procedure SystemOnResize(sender: Object; e: SizeChangedEventArgs) :=
if OnResize<>nil then
OnResize();
var mre := new ManualResetEvent(false);
type
GraphWPFWindow = class(GMainWindow)
public
procedure InitMainGraphControl; override;
procedure __InitModule;
begin
AdditionalInit := procedure ->
begin
MainWindow.Title := 'Графика WPF';
// Свои события. Без этого не работают
MainWindow.MouseDown += SystemOnMouseDown;
MainWindow.MouseUp += SystemOnMouseUp;
MainWindow.MouseMove += SystemOnMouseMove;
MainWindow.KeyDown += SystemOnKeyDown;
MainWindow.KeyUp += SystemOnKeyUp;
MainWindow.TextInput += SystemOnKeyPress;
MainWindow.SizeChanged += SystemOnResize;
Objects := new ObjectsType;
Window := GraphWPF.Window;
GraphWindow := GraphWPF.GraphWindow;
host := new Canvas();
//host.ClipToBounds := True;
host.SizeChanged += (s,e) ->
{host.SizeChanged += (s,e) ->
begin
var sz := e.NewSize;
host.DataContext := sz;
end;
// Всегда последнее
var g := Content as DockPanel;
g.children.Add(host);
end;}
var g := MainWindow.Content as DockPanel;
g.children.Add(host); // Слой графики WPF - последний
end;
procedure InitWindowProperties; override;
begin
Title := 'WPF объекты';
var (w,h) := (800,600);
(Width, Height) := (w + wplus, h + hplus);
WindowStartupLocation := System.Windows.WindowStartupLocation.CenterScreen;
end;
procedure InitGlobals; override;
begin
Window := new WindowType;
GraphWindow := new GraphWindowType;
Objects := new ObjectsType;
end;
procedure InitHandlers; override;
begin
Closed += procedure(sender,e) -> begin Halt; end;
MouseDown += SystemOnMouseDown;
MouseUp += SystemOnMouseUp;
MouseMove += SystemOnMouseMove;
KeyDown += SystemOnKeyDown;
KeyUp += SystemOnKeyUp;
TextInput += SystemOnKeyPress;
SizeChanged += SystemOnResize;
Loaded += (o,e) -> mre.Set();
{PreviewMouseDown += (o,e) -> SystemOnMouseDown(o,e);
PreviewMouseUp += (o,e) -> SystemOnMouseUp(o,e);
PreviewMouseMove += (o,e) -> SystemOnMouseMove(o,e);
PreviewKeyDown += (o,e)-> SystemOnKeyDown(o,e);
PreviewKeyUp += (o,e)-> SystemOnKeyUp(o,e);
Closed += procedure(sender, e) -> begin Halt; end;}
end;
end;
procedure InitApp;
begin
app := new Application;
app.Dispatcher.UnhandledException += (o, e) -> begin
Println(e.Exception.Message);
if e.Exception.InnerException<>nil then
Println(e.Exception.InnerException.Message);
halt;
end;
MainWindow := new GraphWPFWindow;
mre.Set();
app.Run(MainWindow);
end;
procedure InitMainThread;
begin
var MainFormThread := new System.Threading.Thread(InitApp);
MainFormThread.SetApartmentState(ApartmentState.STA);
MainFormThread.Start;
mre.WaitOne; // Основная программа не начнется пока не будут инициализированы все компоненты приложения
end;
var
///--
__initialized := false;
var
///--
__finalized := false;
procedure __InitModule;
begin
InitMainThread;
app.Dispatcher.Invoke(AdditionalInit);
end;
///--
@ -1373,7 +1212,7 @@ begin
if not __initialized then
begin
__initialized := true;
GraphWPFBase.__InitModule__;
GraphWPF.__InitModule__;
__InitModule;
end;
end;

31
TreeConverter/TreeConversion/syntax_tree_visitor.cs
View file

@ -3519,6 +3519,37 @@ namespace PascalABCCompiler.TreeConverter
public override void visit(SyntaxTree.class_definition _class_definition)
{
if (_class_definition.keyword == class_keyword.Record && _class_definition.Parent is var_def_statement) // безымянная запись
{
if (_class_definition.class_parents != null && _class_definition.class_parents.Count>0)
AddError(new SimpleSemanticError(get_location(_class_definition), "UNNAMED_RECORD_CANNOT_IMPLEMENT_INTERFACE"));
var pds = _class_definition.DescendantNodes().OfType<procedure_definition>();
if (pds.Count()>0)
AddError(new SimpleSemanticError(get_location(pds.First()), "UNNAMED_RECORD_CANNOT_CONTAIN_METHODS"));
/*var cds = _class_definition.DescendantNodes().OfType<constructor>();
if (cds.Count() > 0)
AddError(new SimpleSemanticError(get_location(cds.First()), "UNNAMED_RECORD_CANNOT_CONTAIN_CONSTRUCTORS"));*/
if (_class_definition.body.class_def_blocks.First().access_mod.access_level != access_modifer.public_modifer)
{
var f = _class_definition.body.class_def_blocks.First();
var loc = get_location(f);
if (loc == null)
loc = get_location(_class_definition);
AddError(new SimpleSemanticError(loc, "UNNAMED_RECORD_CAN_CONTAIN_ONLY_ONE_PUBLIC_VISIBILITY_SECTION"));
}
if (_class_definition.body.class_def_blocks.Count > 1)
{
var el1 = _class_definition.body.class_def_blocks.ElementAt(1);
var loc = get_location(el1.access_mod);
if (loc == null)
loc = get_location(_class_definition);
AddError(new SimpleSemanticError(loc, "UNNAMED_RECORD_CANNOT_CONTAIN_SEVERAL_VISIBILITY_SECTIONS"));
}
}
if (_class_definition.attribute != class_attribute.None && _class_definition.body == null)
AddError(new SimpleSemanticError(get_location(_class_definition), "CLASS_ATTRIBUTE_NOT_ALLOWED_IN_CLASS_PREDEFINTIONS"));
if ((_class_definition.attribute & PascalABCCompiler.SyntaxTree.class_attribute.Sealed) == SyntaxTree.class_attribute.Sealed)

63
bin/Lib/GraphWPF.pas
View file

@ -174,6 +174,8 @@ type
procedure Load(fname: string);
/// Очищает графическое окно белым цветом
procedure Clear; override;
/// Очищает графическое окно цветом c
procedure Clear(c: Color); override;
end;
//{{{--doc: Конец секции 2 }}}
@ -465,6 +467,10 @@ var OnResize: procedure;
//{{{--doc: Конец секции 3 }}}
// Для WPFObjects
var AdditionalInit: procedure;
function GetMouseArgs(e: MouseEventArgs): (Point,integer);
{procedure AddRightPanel(Width: real := 200; c: Color := Colors.LightGray);
procedure AddLeftPanel(Width: real := 200; c: Color := Colors.LightGray);
procedure AddTopPanel(Height: real := 100; c: Color := Colors.LightGray);
@ -1296,8 +1302,23 @@ begin
end;
end;
procedure WindowTypeClearPC(c: Color);
begin
Host.children.Clear;
if not rtbmapIsCleared then
begin
rtbmap.Clear;
rtbmapIsCleared := True;
end;
FillRectangle(0,0,Window.Width,Window.Height,c)
end;
procedure WindowTypeWPF.Clear := Invoke(WindowTypeClearP);
procedure WindowTypeWPF.Clear(c: Color) := Invoke(WindowTypeClearPC,c);
function XMin := -XOrigin/GlobalScale;
function XMax := (Window.Width-XOrigin)/GlobalScale;
function YMin := -(Window.Height-YOrigin)/GlobalScale;
@ -1397,8 +1418,8 @@ begin
end;
procedure SetStandardCoordsSharpLines(x0,y0: real) := Invoke(SetStandardCoordsSharpLinesP,x0,y0);
/// --- SystemMouseEvents
procedure SystemOnMouseDown(sender: Object; e: MouseButtonEventArgs);
function GetMouseArgs(e: MouseEventArgs): (Point,integer);
begin
var mb := 0;
var p := e.GetPosition(host);
@ -1406,30 +1427,27 @@ begin
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
Result := (p,mb);
end;
/// --- SystemMouseEvents
procedure SystemOnMouseDown(sender: Object; e: MouseButtonEventArgs);
begin
var (p,mb) := GetMouseArgs(e);
if OnMouseDown <> nil then
OnMouseDown(p.x, p.y, mb);
end;
procedure SystemOnMouseUp(sender: Object; e: MouseButtonEventArgs);
begin
var mb := 0;
var p := e.GetPosition(host);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
var (p,mb) := GetMouseArgs(e);
if OnMouseUp <> nil then
OnMouseUp(p.x, p.y, mb);
end;
procedure SystemOnMouseMove(sender: Object; e: MouseEventArgs);
begin
var mb := 0;
var p := e.GetPosition(host);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
var (p,mb) := GetMouseArgs(e);
if OnMouseMove <> nil then
OnMouseMove(p.x, p.y, mb);
end;
@ -1444,10 +1462,8 @@ procedure SystemOnKeyUp(sender: Object; e: KeyEventArgs) :=
OnKeyUp(e.Key);
procedure SystemOnKeyPress(sender: Object; e: TextCompositionEventArgs) :=
begin
if (OnKeyPress<>nil) and (e.Text<>nil) and (e.Text.Length>0) then
OnKeyPress(e.Text[1]);
end;
procedure SystemOnResize(sender: Object; e: SizeChangedEventArgs) :=
if OnResize<>nil then
@ -1506,19 +1522,6 @@ begin
FrameRate := 60;
end;
{procedure AddGraphWindow;
begin
host := new MyVisualHost();
host.ClipToBounds := True;
host.SizeChanged += (s,e) ->
begin
var sz := e.NewSize;
host.DataContext := sz;
end;
// Всегда последнее
MainDockPanel.children.Add(host);
end;}
var mre := new ManualResetEvent(false);
type
@ -1586,12 +1589,10 @@ public
CompositionTarget.Rendering += RenderFrame;
Loaded += (o,e) -> mre.Set();
end;
end;
procedure InitApp;
begin
app := new Application;

2
bin/Lib/GraphWPFBase.pas
View file

@ -106,7 +106,7 @@ type
/// Очищает графическое окно белым цветом
procedure Clear; virtual;
/// Очищает графическое окно цветом c
procedure Clear(c: GColor);
procedure Clear(c: GColor); virtual;
/// Устанавливает размеры клиентской части главного окна
procedure SetSize(w, h: real);
/// Устанавливает отступ главного окна от левого верхнего края экрана

217
bin/Lib/WPFObjects.pas
View file

@ -5,7 +5,7 @@ unit WPFObjects;
interface
uses GraphWPFBase;
uses GraphWPFBase,GraphWPF;
uses System.Windows;
uses System.Windows.Controls;
@ -81,27 +81,6 @@ procedure Invoke(p: ()->());
//{{{doc: Начало секции 2 }}}
type
// -----------------------------------------------------
//>> Класс графического окна # Class GraphWindowType
// -----------------------------------------------------
/// Класс графического окна
GraphWindowType = class
private
function GetTop: real;
function GetLeft: real;
function GetWidth: real;
function GetHeight: real;
public
/// Отступ графического окна от левого края главного окна
property Left: real read GetLeft;
/// Отступ графического окна от верхнего края главного окна
property Top: real read GetTop;
/// Ширина графического окна
property Width: real read GetWidth;
/// Высота графического окна
property Height: real read GetHeight;
end;
ObjectWPF = class;
// -----------------------------------------------------
//>> Класс списка графических объектов # Class List of objects
@ -1133,7 +1112,6 @@ begin
end;
end;
type ObHelper = auto class
o1,o2: ObjectWPF;
function f: boolean := ObjectsIntersectP(o1,o2);
@ -1151,99 +1129,32 @@ function ObjectsIntersect(o1,o2: ObjectWPF)
function IntersectionList(Self: ObjectWPF): List<ObjectWPF>; extensionmethod
:= Invoke&<List<ObjectWPF>>(OLHelper.Create(Self).f);
//---------------------------------------------------------------------------
function GraphWindowTypeGetLeftP: real;
begin
Result := 0;
foreach var p in MainDockPanel.Children do
if (p is FrameworkElement) and (p<>host) then
begin
var d := DockPanel.GetDock(FrameworkElement(p));
if d=Dock.Left then
Result += FrameworkElement(p).Width;
end;
end;
var
///--
__initialized := false;
function GraphWindowTypeGetTopP: real;
begin
Result := 0;
foreach var p in MainDockPanel.Children do
if (p is FrameworkElement) and (p<>host) then
begin
var d := DockPanel.GetDock(FrameworkElement(p));
if d=Dock.Top then
Result += FrameworkElement(p).Height;
end;
end;
function GraphWindowType.GetLeft := InvokeReal(GraphWindowTypeGetLeftP);
function GraphWindowType.GetTop := InvokeReal(GraphWindowTypeGetTopP);
function GraphWindowTypeGetWidthP: real;
begin
{if host.DataContext = nil then
Result := 0
else Result := Size(host.DataContext).Width;}
Result := Window.Width;
foreach var p in MainDockPanel.Children do
if (p is FrameworkElement) and (p<>host) then
begin
var d := DockPanel.GetDock(FrameworkElement(p));
if (d=Dock.Left) or (d=Dock.Right) then
Result -= FrameworkElement(p).Width;
end;
end;
function GraphWindowType.GetWidth := InvokeReal(GraphWindowTypeGetWidthP);
function GraphWindowTypeGetHeightP: real;
begin
{if host.DataContext = nil then
Result := 0
else Result := Size(host.DataContext).Height;}
Result := Window.Height;
foreach var p in MainDockPanel.Children do
if (p is FrameworkElement) and (p<>host) then
begin
var d := DockPanel.GetDock(FrameworkElement(p));
if (d=Dock.Top) or (d=Dock.Bottom) then
Result -= FrameworkElement(p).Height;
end;
end;
function GraphWindowType.GetHeight := InvokeReal(GraphWindowTypeGetHeightP);
var
///--
__finalized := false;
/// --- SystemMouseEvents
procedure SystemOnMouseDown(sender: Object; e: MouseButtonEventArgs);
begin
var mb := 0;
var p := e.GetPosition(host);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
var (p,mb) := GetMouseArgs(e);
if OnMouseDown <> nil then
OnMouseDown(p.x, p.y, mb);
end;
procedure SystemOnMouseUp(sender: Object; e: MouseButtonEventArgs);
begin
var mb := 0;
var p := e.GetPosition(host);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
var (p,mb) := GetMouseArgs(e);
if OnMouseUp <> nil then
OnMouseUp(p.x, p.y, mb);
end;
procedure SystemOnMouseMove(sender: Object; e: MouseEventArgs);
begin
var mb := 0;
var p := e.GetPosition(host);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
var (p,mb) := GetMouseArgs(e);
if OnMouseMove <> nil then
OnMouseMove(p.x, p.y, mb);
end;
@ -1258,103 +1169,41 @@ procedure SystemOnKeyUp(sender: Object; e: KeyEventArgs) :=
OnKeyUp(e.Key);
procedure SystemOnKeyPress(sender: Object; e: TextCompositionEventArgs) :=
begin
if (OnKeyPress<>nil) and (e.Text<>nil) and (e.Text.Length>0) then
OnKeyPress(e.Text[1]);
end;
procedure SystemOnResize(sender: Object; e: SizeChangedEventArgs) :=
if OnResize<>nil then
OnResize();
var mre := new ManualResetEvent(false);
type
GraphWPFWindow = class(GMainWindow)
public
procedure InitMainGraphControl; override;
procedure __InitModule;
begin
AdditionalInit := procedure ->
begin
MainWindow.Title := 'Графика WPF';
// Свои события. Без этого не работают
MainWindow.MouseDown += SystemOnMouseDown;
MainWindow.MouseUp += SystemOnMouseUp;
MainWindow.MouseMove += SystemOnMouseMove;
MainWindow.KeyDown += SystemOnKeyDown;
MainWindow.KeyUp += SystemOnKeyUp;
MainWindow.TextInput += SystemOnKeyPress;
MainWindow.SizeChanged += SystemOnResize;
Objects := new ObjectsType;
Window := GraphWPF.Window;
GraphWindow := GraphWPF.GraphWindow;
host := new Canvas();
host.SizeChanged += (s,e) ->
{host.SizeChanged += (s,e) ->
begin
var sz := e.NewSize;
host.DataContext := sz;
end;
// Всегда последнее
var g := Content as DockPanel;
g.children.Add(host);
end;}
var g := MainWindow.Content as DockPanel;
g.children.Add(host); // Слой графики WPF - последний
end;
procedure InitWindowProperties; override;
begin
Title := 'WPF объекты';
var (w,h) := (800,600);
(Width, Height) := (w + wplus, h + hplus);
WindowStartupLocation := System.Windows.WindowStartupLocation.CenterScreen;
end;
procedure InitGlobals; override;
begin
Window := new WindowType;
GraphWindow := new GraphWindowType;
Objects := new ObjectsType;
end;
procedure InitHandlers; override;
begin
Closed += procedure(sender,e) -> begin Halt; end;
MouseDown += SystemOnMouseDown;
MouseUp += SystemOnMouseUp;
MouseMove += SystemOnMouseMove;
KeyDown += SystemOnKeyDown;
KeyUp += SystemOnKeyUp;
TextInput += SystemOnKeyPress;
SizeChanged += SystemOnResize;
Loaded += (o,e) -> mre.Set();
end;
end;
procedure InitApp;
begin
app := new Application;
app.Dispatcher.UnhandledException += (o, e) -> begin
Println(e.Exception.Message);
if e.Exception.InnerException<>nil then
Println(e.Exception.InnerException.Message);
halt;
end;
MainWindow := new GraphWPFWindow;
mre.Set();
app.Run(MainWindow);
end;
procedure InitMainThread;
begin
var MainFormThread := new System.Threading.Thread(InitApp);
MainFormThread.SetApartmentState(ApartmentState.STA);
MainFormThread.Start;
mre.WaitOne; // Основная программа не начнется пока не будут инициализированы все компоненты приложения
end;
var
///--
__initialized := false;
var
///--
__finalized := false;
procedure __InitModule;
begin
InitMainThread;
app.Dispatcher.Invoke(AdditionalInit);
end;
///--
@ -1363,7 +1212,7 @@ begin
if not __initialized then
begin
__initialized := true;
GraphWPFBase.__InitModule__;
GraphWPF.__InitModule__;
__InitModule;
end;
end;

7
bin/Lng/Eng/SemanticErrors_ms.dat
View file

@ -20,4 +20,9 @@ DEFAULT_PARAMS_IN_DELEGATE_TYPE=Procedure type cannot have default parameters
CONSTRUCTOR_CALL_FOR_DELEGATE_TYPES_IS_FORBIDDEN=Constructor call for delegate types is forbidden
SELF_NOT_ALLOWED_IN_METHOD_PARAMS=Self is not allowed as method parameter name
IMPOSSIBLE_TO_INFER_SET_TYPE=Impossible to infer set type
BAD_DIAPASON_IN_SET_TYPE=Diapason bounds in set constant must be of one type
BAD_DIAPASON_IN_SET_TYPE=Diapason bounds in set constant must be of one type
UNNAMED_RECORD_CANNOT_IMPLEMENT_INTERFACE=Unnamed records can not implement interfaces
UNNAMED_RECORD_CANNOT_CONTAIN_METHODS=Unnamed records can not contain methods
UNNAMED_RECORD_CANNOT_CONTAIN_CONSTRUCTORS=Unnamed records can not contain constructors
UNNAMED_RECORD_CAN_CONTAIN_ONLY_ONE_PUBLIC_VISIBILITY_SECTION=Unnamed records can contain only one section with public visibility
UNNAMED_RECORD_CANNOT_CONTAIN_SEVERAL_VISIBILITY_SECTIONS=Unnamed records can not contain several visibility section

7
bin/Lng/Rus/SemanticErrors_ms.dat
View file

@ -21,4 +21,9 @@ DEFAULT_PARAMS_IN_DELEGATE_TYPE=В процедурном типе не могу
CONSTRUCTOR_CALL_FOR_DELEGATE_TYPES_IS_FORBIDDEN=Для типов делегатов запрещен вызов конструктора. Вместо этого присвойте делегату имя подпрограммы или имя другого делегата
SELF_NOT_ALLOWED_IN_METHOD_PARAMS=Параметр метода не может иметь имя Self
IMPOSSIBLE_TO_INFER_SET_TYPE=Нельзя вычислить тип множества
BAD_DIAPASON_IN_SET_TYPE=Границы диапазона в константе-множестве должны иметь один тип
BAD_DIAPASON_IN_SET_TYPE=Границы диапазона в константе-множестве должны иметь один тип
UNNAMED_RECORD_CANNOT_IMPLEMENT_INTERFACE=Безымянные записи не могут реализовывать интерфейсы
UNNAMED_RECORD_CANNOT_CONTAIN_METHODS=Безымянные записи не могут содержать методы
UNNAMED_RECORD_CANNOT_CONTAIN_CONSTRUCTORS=Безымянные записи не могут содержать конструкторы
UNNAMED_RECORD_CAN_CONTAIN_ONLY_ONE_PUBLIC_VISIBILITY_SECTION=Безымянные записи могут содержать лишь одну секцию с public-видимостью
UNNAMED_RECORD_CANNOT_CONTAIN_SEVERAL_VISIBILITY_SECTIONS=Безымянные записи не могут содержать несколько секций видимости