diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index ae45d6c85..d58db5292 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 = "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; diff --git a/Configuration/Version.defs b/Configuration/Version.defs index 43f4b8109..95f1c4934 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ %COREVERSION%=2 -%REVISION%=1987 +%REVISION%=1989 %MINOR%=4 %MAJOR%=3 diff --git a/Localization/DefaultLang.resources b/Localization/DefaultLang.resources index 4c674e0ac..7891df898 100644 Binary files a/Localization/DefaultLang.resources and b/Localization/DefaultLang.resources differ diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index a1fa3cdfe..c8e9b85f6 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.4.2.1987' +!define VERSION '3.4.2.1989' diff --git a/TestSuite/CompilationSamples/GraphWPF.pas b/TestSuite/CompilationSamples/GraphWPF.pas index 2b340ab12..69c4e09f3 100644 --- a/TestSuite/CompilationSamples/GraphWPF.pas +++ b/TestSuite/CompilationSamples/GraphWPF.pas @@ -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; diff --git a/TestSuite/CompilationSamples/GraphWPFBase.pas b/TestSuite/CompilationSamples/GraphWPFBase.pas index 9c8ee8ffa..62fa7ad88 100644 --- a/TestSuite/CompilationSamples/GraphWPFBase.pas +++ b/TestSuite/CompilationSamples/GraphWPFBase.pas @@ -106,7 +106,7 @@ type /// Очищает графическое окно белым цветом procedure Clear; virtual; /// Очищает графическое окно цветом c - procedure Clear(c: GColor); + procedure Clear(c: GColor); virtual; /// Устанавливает размеры клиентской части главного окна procedure SetSize(w, h: real); /// Устанавливает отступ главного окна от левого верхнего края экрана diff --git a/TestSuite/CompilationSamples/WPFObjects.pas b/TestSuite/CompilationSamples/WPFObjects.pas index 39ab91b01..6ece7414f 100644 --- a/TestSuite/CompilationSamples/WPFObjects.pas +++ b/TestSuite/CompilationSamples/WPFObjects.pas @@ -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; extensionmethod := Invoke&>(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; diff --git a/TreeConverter/TreeConversion/syntax_tree_visitor.cs b/TreeConverter/TreeConversion/syntax_tree_visitor.cs index 8dcdd7f3a..fb748cd55 100644 --- a/TreeConverter/TreeConversion/syntax_tree_visitor.cs +++ b/TreeConverter/TreeConversion/syntax_tree_visitor.cs @@ -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(); + if (pds.Count()>0) + AddError(new SimpleSemanticError(get_location(pds.First()), "UNNAMED_RECORD_CANNOT_CONTAIN_METHODS")); + + /*var cds = _class_definition.DescendantNodes().OfType(); + 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) diff --git a/bin/Lib/GraphWPF.pas b/bin/Lib/GraphWPF.pas index ada3dcd74..69c4e09f3 100644 --- a/bin/Lib/GraphWPF.pas +++ b/bin/Lib/GraphWPF.pas @@ -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; diff --git a/bin/Lib/GraphWPFBase.pas b/bin/Lib/GraphWPFBase.pas index 9c8ee8ffa..62fa7ad88 100644 --- a/bin/Lib/GraphWPFBase.pas +++ b/bin/Lib/GraphWPFBase.pas @@ -106,7 +106,7 @@ type /// Очищает графическое окно белым цветом procedure Clear; virtual; /// Очищает графическое окно цветом c - procedure Clear(c: GColor); + procedure Clear(c: GColor); virtual; /// Устанавливает размеры клиентской части главного окна procedure SetSize(w, h: real); /// Устанавливает отступ главного окна от левого верхнего края экрана diff --git a/bin/Lib/WPFObjects.pas b/bin/Lib/WPFObjects.pas index 6d77937e6..6ece7414f 100644 --- a/bin/Lib/WPFObjects.pas +++ b/bin/Lib/WPFObjects.pas @@ -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; extensionmethod := Invoke&>(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; diff --git a/bin/Lng/Eng/SemanticErrors_ms.dat b/bin/Lng/Eng/SemanticErrors_ms.dat index e26582f98..ade058dbe 100644 --- a/bin/Lng/Eng/SemanticErrors_ms.dat +++ b/bin/Lng/Eng/SemanticErrors_ms.dat @@ -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 \ No newline at end of file +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 \ No newline at end of file diff --git a/bin/Lng/Rus/SemanticErrors_ms.dat b/bin/Lng/Rus/SemanticErrors_ms.dat index 646098964..f2fc4d346 100644 --- a/bin/Lng/Rus/SemanticErrors_ms.dat +++ b/bin/Lng/Rus/SemanticErrors_ms.dat @@ -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=Границы диапазона в константе-множестве должны иметь один тип \ No newline at end of file +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=Безымянные записи не могут содержать несколько секций видимости \ No newline at end of file