diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index b57aa09af..d2aaf422d 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 = "3257"; 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..c0c5d6357 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%COREVERSION%=3 -%REVISION%=3254 %MINOR%=8 +%REVISION%=3257 +%COREVERSION%=3 %MAJOR%=3 diff --git a/Localization/DefaultLang.resources b/Localization/DefaultLang.resources index 5f02f6c92..bdadebd15 100644 Binary files a/Localization/DefaultLang.resources and b/Localization/DefaultLang.resources differ diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index 207702e0d..0919d6b34 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.8.3.3254 +3.8.3.3257 diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index 30d48bca3..a64b62664 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.8.3.3254' +!define VERSION '3.8.3.3257' diff --git a/TestSuite/CompilationSamples/GraphWPF.pas b/TestSuite/CompilationSamples/GraphWPF.pas index a4e9ed2fc..c41394422 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,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/TestSuite/CompilationSamples/PABCSystem.pas b/TestSuite/CompilationSamples/PABCSystem.pas index 0ada09556..1d26f4711 100644 --- a/TestSuite/CompilationSamples/PABCSystem.pas +++ b/TestSuite/CompilationSamples/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/TestSuite/CompilationSamples/Timers.pas b/TestSuite/CompilationSamples/Timers.pas index c1a0c03c0..9ebec7ec2 100644 --- a/TestSuite/CompilationSamples/Timers.pas +++ b/TestSuite/CompilationSamples/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; diff --git a/bin/Lib/GraphWPF.pas b/bin/Lib/GraphWPF.pas index 9bf70da28..2ceed24c2 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); @@ -519,48 +536,75 @@ procedure EndFrameBasedAnimation; // ----------------------------------------------------- //>> Функции для вывода текста # GraphWPF text functions // ----------------------------------------------------- -/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) +{ +// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) procedure DrawText(x, y, w, h: real; text: string; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) +// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) procedure DrawText(x, y, w, h: real; text: string; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит целое в прямоугольник к координатами левого верхнего угла (x,y) +// Выводит целое в прямоугольник к координатами левого верхнего угла (x,y) procedure DrawText(x, y, w, h: real; number: integer; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит вещественное в прямоугольник к координатами левого верхнего угла (x,y) +// Выводит вещественное в прямоугольник к координатами левого верхнего угла (x,y) procedure DrawText(x, y, w, h: real; number: real; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит строку в прямоугольник +// Выводит строку в прямоугольник procedure DrawText(r: GRect; text: string; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит целое в прямоугольник +// Выводит целое в прямоугольник procedure DrawText(r: GRect; number: integer; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит вещественное в прямоугольник +// Выводит вещественное в прямоугольник procedure DrawText(r: GRect; number: real; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит целое в прямоугольник к координатами левого верхнего угла (x,y) +// Выводит целое в прямоугольник к координатами левого верхнего угла (x,y) procedure DrawText(x, y, w, h: real; number: integer; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит вещественное в прямоугольник к координатами левого верхнего угла (x,y) +// Выводит вещественное в прямоугольник к координатами левого верхнего угла (x,y) procedure DrawText(x, y, w, h: real; number: real; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит строку в прямоугольник +// Выводит строку в прямоугольник procedure DrawText(r: GRect; text: string; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит целое в прямоугольник +// Выводит целое в прямоугольник procedure DrawText(r: GRect; number: integer; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит вещественное в прямоугольник +// Выводит вещественное в прямоугольник procedure DrawText(r: GRect; number: real; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); -/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) указанным шрифтом +// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) указанным шрифтом procedure DrawText(x, y, w, h: real; text: string; f: FontOptions; align: Alignment; angle: real); +} + +/// Выводит текстовое представление объекта в прямоугольник размера (w,h) с координатами левого верхнего угла (x,y) +procedure DrawText(x, y, w, h: real; text: object; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит текстовое представление объекта указанным цветом в прямоугольник (x,y,w,h) +procedure DrawText(x, y, w, h: real; text: object; color: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит текстовое представление объекта в указанный прямоугольник +procedure DrawText(rect: GRect; text: object; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит текстовое представление объекта в указанный прямоугольник указанным цветом +procedure DrawText(rect: GRect; text: object; color: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит строку в прямоугольник (x,y,w,h) указанным шрифтом +procedure DrawText(x, y, w, h: real; text: object; f: FontOptions; align: Alignment; angle: real); -/// Выводит строку в позицию (x,y) +{// Выводит строку в позицию (x,y) procedure TextOut(x, y: real; text: string; align: Alignment := Alignment.LeftTop; angle: real := 0.0); -/// Выводит строку в позицию (x,y) цветом c +// Выводит строку в позицию (x,y) цветом c procedure TextOut(x, y: real; text: string; c: GColor; align: Alignment := Alignment.LeftTop; angle: real := 0.0); -/// Выводит целое в позицию (x,y) +// Выводит целое в позицию (x,y) procedure TextOut(x, y: real; text: integer; align: Alignment := Alignment.LeftTop; angle: real := 0.0); -/// Выводит целое в позицию (x,y) цветом c +// Выводит целое в позицию (x,y) цветом c procedure TextOut(x, y: real; text: integer; c: GColor; align: Alignment := Alignment.LeftTop; angle: real := 0.0); -/// Выводит вещественное в позицию (x,y) +// Выводит вещественное в позицию (x,y) procedure TextOut(x, y: real; text: real; align: Alignment := Alignment.LeftTop; angle: real := 0.0); -/// Выводит вещественное в позицию (x,y) цветом c +// Выводит вещественное в позицию (x,y) цветом c procedure TextOut(x, y: real; text: real; c: GColor; align: Alignment := Alignment.LeftTop; angle: real := 0.0); -/// Выводит строку в позицию (x,y) указанным шрифтом -procedure TextOut(x, y: real; text: string; f: FontOptions; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +// Выводит строку в позицию (x,y) указанным шрифтом +procedure TextOut(x, y: real; text: string; f: FontOptions; align: Alignment := Alignment.LeftTop; angle: real := 0.0);} + +/// Выводит текстовое представление объекта в позицию (x,y) +procedure TextOut(x, y: real; text: object; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +/// Выводит текстовое представление объекта в позицию (x,y) указанным цветом +procedure TextOut(x, y: real; text: object; color: GColor; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +/// Выводит текстовое представление объекта в позицию (x,y) указанным шрифтом +procedure TextOut(x, y: real; text: object; f: FontOptions; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +/// Выводит текстовое представление объекта в позицию pos +procedure TextOut(pos: Point; text: object; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +/// Выводит текстовое представление объекта в позицию pos указанным цветом +procedure TextOut(pos: Point; text: object; color: GColor; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +/// Выводит текстовое представление объекта в позицию pos указанным шрифтом +procedure TextOut(pos: Point; text: object; f: FontOptions; align: Alignment := Alignment.LeftTop; angle: real := 0.0); + /// Ширина текста при выводе function TextWidth(text: string): real; @@ -1358,6 +1402,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 +1469,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 +1544,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); @@ -1566,41 +1643,52 @@ begin end; end; -/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) -procedure DrawText(x, y, w, h: real; text: string; align: Alignment; angle: real); -begin - var (x0,y0) := (x,y); - - var ft := FormTextFont(text,Font); - var sz := new Size(ft.Width,ft.Height); - - DrawTextHelper(x, y, x0, y0, w, h, sz, align); - TextOutHelper(x,y,text,angle,x0,y0) -end; -/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) -procedure DrawText(x, y, w, h: real; text: string; c: GColor; align: Alignment; angle: real); -begin - var (x0,y0) := (x,y); - - var ft := FormTextFont(text,Font); - var sz := new Size(ft.Width,ft.Height); - - DrawTextHelper(x, y, x0, y0, w, h, sz, align); - TextOutHelper(x,y,text,angle,c,x0,y0) -end; - -/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) данным шрифтом -procedure DrawText(x, y, w, h: real; text: string; f: FontOptions; align: Alignment; angle: real); +procedure DrawText(x, y, w, h: real; text: object; align: Alignment; angle: real); begin var (x0,y0) := (x,y); - var ft := FormTextFont(text,Font); + var textstr := text.ToString; + + var ft := FormTextFont(textstr,Font); + var sz := new Size(ft.Width,ft.Height); + + DrawTextHelper(x, y, x0, y0, w, h, sz, align); + TextOutHelper(x,y,textstr,angle,x0,y0) +end; + +procedure DrawText(x, y, w, h: real; text: object; color: GColor; align: Alignment; angle: real); +begin + var (x0,y0) := (x,y); + + var textstr := text.ToString; + + var ft := FormTextFont(textstr,Font); + var sz := new Size(ft.Width,ft.Height); + + DrawTextHelper(x, y, x0, y0, w, h, sz, align); + TextOutHelper(x,y,textstr,angle,color,x0,y0) +end; + +procedure DrawText(rect: GRect; text: object; align: Alignment; angle: real) + := DrawText(rect.x,rect.y,rect.Width,rect.Height,text,align,angle); + +procedure DrawText(rect: GRect; text: object; color: GColor; align: Alignment; angle: real) + := DrawText(rect.x,rect.y,rect.Width,rect.Height,text,align,angle); + +procedure DrawText(x, y, w, h: real; text: object; f: FontOptions; align: Alignment; angle: real); +begin + var (x0,y0) := (x,y); + + var textstr := text.ToString; + + var ft := FormTextFont(textstr,Font); var sz := new Size(ft.Width,ft.Height); DrawTextHelper(x, y, x0, y0, w, h, sz, align, f); - TextOutHelper(x,y,text,angle,x0,y0,f) + TextOutHelper(x,y,textstr,angle,x0,y0,f) end; +{ /// Выводит целое в прямоугольник к координатами левого верхнего угла (x,y) procedure DrawText(x, y, w, h: real; number: integer; align: Alignment; angle: real) := DrawText(x, y, w, h, '' + number,align,angle); /// Выводит вещественное в прямоугольник к координатами левого верхнего угла (x,y) @@ -1621,32 +1709,28 @@ procedure DrawText(r: GRect; text: string; c: GColor; align: Alignment; angle: r procedure DrawText(r: GRect; number: integer; c: GColor; align: Alignment; angle: real) := DrawText(r.x,r.y,r.Width,r.Height,number,c,align,angle); /// Выводит вещественное в прямоугольник procedure DrawText(r: GRect; number: real; c: GColor; align: Alignment; angle: real) := DrawText(r.x,r.y,r.Width,r.Height,number,c,align,angle); +} - -{function ConvertAlign(align: Alignment): Alignment; -begin - Result := align; - case align of - Alignment.LeftTop: Result := Alignment.RightBottom; - Alignment.LeftCenter: Result := Alignment.RightCenter; - Alignment.LeftBottom: Result := Alignment.RightTop; - Alignment.CenterTop: Result := Alignment.CenterBottom; - Alignment.CenterBottom: Result := Alignment.CenterTop; - Alignment.RightTop: Result := Alignment.LeftBottom; - Alignment.RightCenter: Result := Alignment.LeftCenter; - Alignment.RightBottom: Result := Alignment.LeftTop; - end; -end;} - +(* procedure TextOut(x, y: real; text: string; align: Alignment; angle: real) := DrawText(x, y, 0, 0, text,{ConvertAlign(}align{)},angle); procedure TextOut(x, y: real; text: string; c: GColor; align: Alignment; angle: real) := DrawText(x, y, 0, 0, text, c,{ConvertAlign(}align{)},angle); procedure TextOut(x, y: real; text: integer; align: Alignment; angle: real) := TextOut(x, y, ''+text,align,angle); procedure TextOut(x, y: real; text: integer; c: GColor; align: Alignment; angle: real) := TextOut(x, y, ''+text, c,align,angle); procedure TextOut(x, y: real; text: real; align: Alignment; angle: real) := TextOut(x, y, ''+text,align,angle); procedure TextOut(x, y: real; text: real; c: GColor; align: Alignment; angle: real) := TextOut(x, y, ''+text, c,align,angle); - -procedure TextOut(x, y: real; text: string; f: FontOptions; align: Alignment; angle: real) := DrawText(x, y, 0, 0, text, f, align, angle); - +*) +procedure TextOut(x, y: real; text: object; align: Alignment; angle: real) + := DrawText(x, y, 0, 0, text.ToString, align, angle); +procedure TextOut(x, y: real; text: object; color: GColor; align: Alignment; angle: real) + := DrawText(x, y, 0, 0, text.ToString, color, align, angle); +procedure TextOut(x, y: real; text: object; f: FontOptions; align: Alignment; angle: real) + := DrawText(x, y, 0, 0, text.ToString, f, align, angle); +procedure TextOut(pos: Point; text: object; align: Alignment; angle: real) + := TextOut(pos.x, pos.y, text, align, angle); +procedure TextOut(pos: Point; text: object; color: GColor; align: Alignment; angle: real) + := TextOut(pos.x, pos.y, text, color, align, angle); +procedure TextOut(pos: Point; text: object; f: FontOptions; align: Alignment; angle: real) + := TextOut(pos.x, pos.y, text, f, align, angle); type FS = auto class 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;