From 18a739564194dbdc5e51e777433a28829b528738 Mon Sep 17 00:00:00 2001 From: Mikhalkovich Stanislav Date: Sun, 9 Apr 2023 19:08:54 +0300 Subject: [PATCH] Timers: TimerProc -> OnTimer Cartesian -> CartesianPower GraphWPF - Arrow --- Configuration/GlobalAssemblyInfo.cs | 2 +- Configuration/Version.defs | 2 +- Localization/DefaultLang.resources | Bin 101068 -> 101082 bytes Release/pabcversion.txt | 2 +- ReleaseGenerators/PascalABCNET_version.nsh | 2 +- TestSuite/CompilationSamples/GraphWPF.pas | 47 ++++++++++++++++++ TestSuite/CompilationSamples/PABCSystem.pas | 15 +++++- bin/Lib/GraphWPF.pas | 50 ++++++++++++++++++++ bin/Lib/PABCSystem.pas | 12 +++-- bin/Lib/Timers.pas | 10 ++-- 10 files changed, 127 insertions(+), 15 deletions(-) diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index b57aa09af..45509720e 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 = "8"; public const string Build = "3"; - public const string Revision = "3254"; + public const string Revision = "3256"; 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 9a071d781..34a639072 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ %COREVERSION%=3 -%REVISION%=3254 +%REVISION%=3256 %MINOR%=8 %MAJOR%=3 diff --git a/Localization/DefaultLang.resources b/Localization/DefaultLang.resources index 5f02f6c92e448727b8322e406657dbf58e609d44..bdadebd15cfc9fa727aa84ddb5df89a38b3d82fd 100644 GIT binary patch delta 32 qcmV+*0N?-2l?K|C29V$Z_OapKk__k|a%E|5baHQGbz`%=lMnY6#}J|b delta 19 dcmV+u0PO$Tl?Kd}29V$Z=&|A6lC#Z|4fkvp3r_$5 diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index 207702e0d..ef497afc3 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.8.3.3254 +3.8.3.3256 diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index 30d48bca3..644bc5c17 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.8.3.3254' +!define VERSION '3.8.3.3256' diff --git a/TestSuite/CompilationSamples/GraphWPF.pas b/TestSuite/CompilationSamples/GraphWPF.pas index a4e9ed2fc..79057e039 100644 --- a/TestSuite/CompilationSamples/GraphWPF.pas +++ b/TestSuite/CompilationSamples/GraphWPF.pas @@ -74,6 +74,13 @@ function GetFontFamily(name: string): FontFamily; //>> Класс BrushType # BrushType class // ----------------------------------------------------- type + ///!# + /// Параметры рисования + Parameters = static class + public + static ArrowSizeAlong: real := 10*4/5; + static ArrowSizeAcross: real := 4*4/5; + end; ///!# /// Тип кисти BrushType = class @@ -384,6 +391,16 @@ procedure Lines(a: array of (Point,Point)); /// Рисует отрезки, заданные массивом пар точек, цветом c procedure Lines(a: array of (Point,Point); c: Color); /// Устанавливает текущую позицию рисования в точку (x,y) + +/// Рисует отрезок прямой от точки (x,y) до точки (x1,y1) со стрелкой на конце +procedure Arrow(x,y,x1,y1: real); +/// Рисует отрезок прямой от точки (x,y) до точки (x1,y1) цветом c со стрелкой на конце +procedure Arrow(x,y,x1,y1: real; c: Color); +/// Рисует отрезок прямой от точки p до точки p1 со стрелкой на конце +procedure Arrow(p,p1: Point); +/// Рисует отрезок прямой от точки p до точки p1 цветом c со стрелкой на конце +procedure Arrow(p,p1: Point; c: Color); + procedure MoveTo(x,y: real); /// Рисует отрезок от текущей позиции до точки (x,y). Текущая позиция переносится в точку (x,y) procedure LineTo(x,y: real); @@ -1358,6 +1375,28 @@ begin ReleaseDC(dc); end; +function Norm(Self: Vector): Vector; extensionmethod := Self/Self.Length; +function Ortog(Self: Vector): Vector; extensionmethod := Vect(Self.Y, -Self.X); + +procedure ArrowPFull(x,y,x1,y1: real; p: GPen); +begin + var szAlong := Parameters.ArrowSizeAlong / GlobalScale; + var szAcross := Parameters.ArrowSizeACross / GlobalScale; + + var (p1,p2) := (Pnt(x,y),Pnt(x1,y1)); + var v := p2 - p1; + var (vnorm, vortognorm) := (v.Norm, v.Ortog.Norm); + + var p3 := p2 - vnorm * szAlong + vortognorm * szAcross; + var p4 := p2 - vnorm * szAlong - vortognorm * szAcross; + + var dc := GetDC(); + dc.DrawLine(p, p1, p2); + + dc.DrawPolygon(Brushes.Black,p,Arr(p2,p3,p4)); + ReleaseDC(dc); +end; + procedure SetPixel(x,y: real; c: Color) := InvokeVisual(SetPixelP, x, y, c); procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color) @@ -1400,6 +1439,9 @@ procedure LinePC(x,y,x1,y1: real; c: GColor) := LinePFull(x,y,x1,y1,ColorPen(c)) procedure PolyLineP(points: array of Point) := PolyLinePFull(points,Pen.PenConstruct); procedure PolyLinePC(points: array of Point; c: GColor) := PolyLinePFull(points,ColorPen(c)); +procedure ArrowP(x,y,x1,y1: real) := ArrowPFull(x,y,x1,y1,Pen.PenConstruct); +procedure ArrowPC(x,y,x1,y1: real; c: GColor) := ArrowPFull(x,y,x1,y1,ColorPen(c)); + procedure PolygonP(points: array of Point) := PolygonPFull(points,Brush.BrushConstruct,Pen.PenConstruct); procedure DrawPolygonP(points: array of Point) := PolygonPFull(points,nil,Pen.PenConstruct); procedure FillPolygonP(points: array of Point) := PolygonPFull(points,Brush.BrushConstruct,nil); @@ -1472,6 +1514,11 @@ procedure Line(p,p1: Point; c: Color) := Line(p.x,p.y,p1.x,p1.y,c); procedure Lines(a: array of (Point,Point)) := foreach var i in a.Indices do Line(a[i].Item1,a[i].Item2); procedure Lines(a: array of (Point,Point); c: Color) := foreach var i in a.Indices do Line(a[i].Item1,a[i].Item2,c); +procedure Arrow(x,y,x1,y1: real) := InvokeVisual(ArrowP,x,y,x1,y1); +procedure Arrow(x,y,x1,y1: real; c: GColor) := InvokeVisual(ArrowPC,x,y,x1,y1,c); +procedure Arrow(p,p1: Point) := Arrow(p.x,p.y,p1.x,p1.y); +procedure Arrow(p,p1: Point; c: Color) := Arrow(p.x,p.y,p1.x,p1.y,c); + procedure MoveTo(x,y: real) := (Pen.fx,Pen.fy) := (x,y); procedure LineTo(x,y: real); diff --git a/TestSuite/CompilationSamples/PABCSystem.pas b/TestSuite/CompilationSamples/PABCSystem.pas index 38b21e352..1d26f4711 100644 --- a/TestSuite/CompilationSamples/PABCSystem.pas +++ b/TestSuite/CompilationSamples/PABCSystem.pas @@ -12182,7 +12182,7 @@ begin end; /// Возвращает n-тую декартову степень множества элементов, заданного массивом -function Cartesian(Self: array of T; n: integer): sequence of array of T; extensionmethod; +function CartesianPower(Self: array of T; n: integer): sequence of array of T; extensionmethod; begin var r := new integer[n]; var ar1 := new T[n]; @@ -12212,9 +12212,20 @@ begin end; /// Возвращает n-тую декартову степень множества элементов, заданного последовательностью +function CartesianPower(Self: sequence of T; n: integer): sequence of array of T; extensionmethod; +begin + Result := Self.ToArray.CartesianPower(n); +end; + +// Не убирать этот комментарий! Нужен для корректного Intellisense +///-(расширение sequence of T) function Cartesian(b: sequence of T1): sequence of (T, T1); +/// Возвращает декартово произведение последовательностей в виде последовательности пар +function Cartesian(Self: array of T; n: integer): sequence of array of T; extensionmethod := Self.CartesianPower(n); + +///-- function Cartesian(Self: sequence of T; n: integer): sequence of array of T; extensionmethod; begin - Result := Self.ToArray.Cartesian(n); + Result := Self.ToArray.CartesianPower(n); end; /// Возвращает все перестановки букв в строке в виде последовательности строк diff --git a/bin/Lib/GraphWPF.pas b/bin/Lib/GraphWPF.pas index 9bf70da28..1e8b59630 100644 --- a/bin/Lib/GraphWPF.pas +++ b/bin/Lib/GraphWPF.pas @@ -74,6 +74,13 @@ function GetFontFamily(name: string): FontFamily; //>> Класс BrushType # BrushType class // ----------------------------------------------------- type + ///!# + /// Параметры рисования + Parameters = static class + public + static ArrowSizeAlong: real := 10*4/5; + static ArrowSizeAcross: real := 4*4/5; + end; ///!# /// Тип кисти BrushType = class @@ -384,6 +391,16 @@ procedure Lines(a: array of (Point,Point)); /// Рисует отрезки, заданные массивом пар точек, цветом c procedure Lines(a: array of (Point,Point); c: Color); /// Устанавливает текущую позицию рисования в точку (x,y) + +/// Рисует отрезок прямой от точки (x,y) до точки (x1,y1) со стрелкой на конце +procedure Arrow(x,y,x1,y1: real); +/// Рисует отрезок прямой от точки (x,y) до точки (x1,y1) цветом c со стрелкой на конце +procedure Arrow(x,y,x1,y1: real; c: Color); +/// Рисует отрезок прямой от точки p до точки p1 со стрелкой на конце +procedure Arrow(p,p1: Point); +/// Рисует отрезок прямой от точки p до точки p1 цветом c со стрелкой на конце +procedure Arrow(p,p1: Point; c: Color); + procedure MoveTo(x,y: real); /// Рисует отрезок от текущей позиции до точки (x,y). Текущая позиция переносится в точку (x,y) procedure LineTo(x,y: real); @@ -1358,6 +1375,31 @@ begin ReleaseDC(dc); end; +/// Нормированный вектор +function Norm(Self: Vector): Vector; extensionmethod := Self/Self.Length; + +/// Вектор, ортогональный данному +function Ortog(Self: Vector): Vector; extensionmethod := Vect(Self.Y, -Self.X); + +procedure ArrowPFull(x,y,x1,y1: real; p: GPen); +begin + var szAlong := Parameters.ArrowSizeAlong / GlobalScale; + var szAcross := Parameters.ArrowSizeACross / GlobalScale; + + var (p1,p2) := (Pnt(x,y),Pnt(x1,y1)); + var v := p2 - p1; + var (vnorm, vortognorm) := (v.Norm, v.Ortog.Norm); + + var p3 := p2 - vnorm * szAlong + vortognorm * szAcross; + var p4 := p2 - vnorm * szAlong - vortognorm * szAcross; + + var dc := GetDC(); + dc.DrawLine(p, p1, p2); + + dc.DrawPolygon(Brushes.Black,p,Arr(p2,p3,p4)); + ReleaseDC(dc); +end; + procedure SetPixel(x,y: real; c: Color) := InvokeVisual(SetPixelP, x, y, c); procedure SetPixels(x,y: real; w,h: integer; f: (integer,integer)->Color) @@ -1400,6 +1442,9 @@ procedure LinePC(x,y,x1,y1: real; c: GColor) := LinePFull(x,y,x1,y1,ColorPen(c)) procedure PolyLineP(points: array of Point) := PolyLinePFull(points,Pen.PenConstruct); procedure PolyLinePC(points: array of Point; c: GColor) := PolyLinePFull(points,ColorPen(c)); +procedure ArrowP(x,y,x1,y1: real) := ArrowPFull(x,y,x1,y1,Pen.PenConstruct); +procedure ArrowPC(x,y,x1,y1: real; c: GColor) := ArrowPFull(x,y,x1,y1,ColorPen(c)); + procedure PolygonP(points: array of Point) := PolygonPFull(points,Brush.BrushConstruct,Pen.PenConstruct); procedure DrawPolygonP(points: array of Point) := PolygonPFull(points,nil,Pen.PenConstruct); procedure FillPolygonP(points: array of Point) := PolygonPFull(points,Brush.BrushConstruct,nil); @@ -1472,6 +1517,11 @@ procedure Line(p,p1: Point; c: Color) := Line(p.x,p.y,p1.x,p1.y,c); procedure Lines(a: array of (Point,Point)) := foreach var i in a.Indices do Line(a[i].Item1,a[i].Item2); procedure Lines(a: array of (Point,Point); c: Color) := foreach var i in a.Indices do Line(a[i].Item1,a[i].Item2,c); +procedure Arrow(x,y,x1,y1: real) := InvokeVisual(ArrowP,x,y,x1,y1); +procedure Arrow(x,y,x1,y1: real; c: GColor) := InvokeVisual(ArrowPC,x,y,x1,y1,c); +procedure Arrow(p,p1: Point) := Arrow(p.x,p.y,p1.x,p1.y); +procedure Arrow(p,p1: Point; c: Color) := Arrow(p.x,p.y,p1.x,p1.y,c); + procedure MoveTo(x,y: real) := (Pen.fx,Pen.fy) := (x,y); procedure LineTo(x,y: real); diff --git a/bin/Lib/PABCSystem.pas b/bin/Lib/PABCSystem.pas index 0ada09556..1d26f4711 100644 --- a/bin/Lib/PABCSystem.pas +++ b/bin/Lib/PABCSystem.pas @@ -12211,19 +12211,21 @@ begin end; end; -///-- -function Cartesian(Self: array of T; n: integer): sequence of array of T; extensionmethod := Self.CartesianPower(n); - /// Возвращает n-тую декартову степень множества элементов, заданного последовательностью function CartesianPower(Self: sequence of T; n: integer): sequence of array of T; extensionmethod; begin - Result := Self.ToArray.Cartesian(n); + Result := Self.ToArray.CartesianPower(n); end; +// Не убирать этот комментарий! Нужен для корректного Intellisense +///-(расширение sequence of T) function Cartesian(b: sequence of T1): sequence of (T, T1); +/// Возвращает декартово произведение последовательностей в виде последовательности пар +function Cartesian(Self: array of T; n: integer): sequence of array of T; extensionmethod := Self.CartesianPower(n); + ///-- function Cartesian(Self: sequence of T; n: integer): sequence of array of T; extensionmethod; begin - Result := Self.ToArray.Cartesian(n); + Result := Self.ToArray.CartesianPower(n); end; /// Возвращает все перестановки букв в строке в виде последовательности строк diff --git a/bin/Lib/Timers.pas b/bin/Lib/Timers.pas index c1a0c03c0..9ebec7ec2 100644 --- a/bin/Lib/Timers.pas +++ b/bin/Lib/Timers.pas @@ -22,7 +22,7 @@ type function GetEnabled: boolean; procedure SetInterval(_interval: integer); function GetInterval: integer; - procedure OnTimer(sender: object; e: System.Timers.ElapsedEventArgs); + procedure TimerHandler(sender: object; e: System.Timers.ElapsedEventArgs); public /// Создает таймер с интервалом срабатывания ms миллисекунд и обработчиком TimerProc constructor Create(ms: integer; TimerProc: procedure := nil); @@ -34,8 +34,10 @@ type property Enabled: boolean read GetEnabled write SetEnabled; /// Интервал срабатывания таймера property Interval: integer read GetInterval write SetInterval; - /// Интервал срабатывания таймера + ///-- property TimerProc: ()->() read _procedure write _procedure; + /// Событие таймера + property OnTimer: ()->() read _procedure write _procedure; end; /// Создать и запустить таймер, вызывающий процедуру TimerProc каждые ms миллисекунд @@ -49,7 +51,7 @@ begin Result.Start; end; -procedure Timer.OnTimer(sender: object; e: System.Timers.ElapsedEventArgs); +procedure Timer.TimerHandler(sender: object; e: System.Timers.ElapsedEventArgs); begin _procedure; end; @@ -58,7 +60,7 @@ constructor Timer.Create(ms: integer; TimerProc: procedure); begin _timer := new System.Timers.Timer(ms); _procedure := TimerProc; - _timer.Elapsed += OnTimer; + _timer.Elapsed += TimerHandler; end; procedure Timer.Start;