From 0e066aac4870a63331dbadcb5bc95c20bf441fa2 Mon Sep 17 00:00:00 2001 From: Mikhalkovich Stanislav Date: Wed, 15 Oct 2025 12:36:43 +0300 Subject: [PATCH] =?UTF-8?q?=D0=92=20Coords=20-=20DrawArc=20=D0=B8=20SeoMou?= =?UTF-8?q?seDown=20...=20=D0=B4=D0=BB=D1=8F=20=D0=BE=D1=81=D0=BD=D0=BE?= =?UTF-8?q?=D0=B2=D0=BD=D1=8B=D1=85=20=D0=BE=D0=B1=D1=80=D0=B0=D0=B1=D0=BE?= =?UTF-8?q?=D1=82=D1=87=D0=B8=D0=BA=D0=BE=D0=B2=20=D0=B4=D0=BB=D1=8F=20?= =?UTF-8?q?=D0=BD=D0=B5=D0=B7=D0=B0=D0=B2=D0=B8=D1=81=D0=B8=D0=BC=D0=BE?= =?UTF-8?q?=D1=81=D1=82=D0=B8=20=D0=BE=D1=82=20GraphWPF?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Вернул пока назад CharAnsi --- .../!MainFeatures/02_Types/CharFunc.pas | 4 +- .../WhatsNew/3_11_1/ArcCoords.pas | 15 ++++ bin/Lib/Coords.pas | 83 +++++++++++++++++++ bin/Lib/PABCSystem.pas | 11 +++ 4 files changed, 111 insertions(+), 2 deletions(-) create mode 100644 InstallerSamples/WhatsNew/3_11_1/ArcCoords.pas diff --git a/InstallerSamples/!MainFeatures/02_Types/CharFunc.pas b/InstallerSamples/!MainFeatures/02_Types/CharFunc.pas index 51207761c..aceb32551 100644 --- a/InstallerSamples/!MainFeatures/02_Types/CharFunc.pas +++ b/InstallerSamples/!MainFeatures/02_Types/CharFunc.pas @@ -9,8 +9,8 @@ begin c := Chr(i); Println($'Символ с кодом {i} в кодировке Unicode - это {c}'); Println; - i := OrdAnsi(c); + i := OrdWindows(c); Println($'Код символа {c} в кодировке Windows равен {i}'); - c := ChrAnsi(i); + c := ChrWindows(i); Println($'Символ с кодом {i} в кодировке Windows - это {c}'); end. \ No newline at end of file diff --git a/InstallerSamples/WhatsNew/3_11_1/ArcCoords.pas b/InstallerSamples/WhatsNew/3_11_1/ArcCoords.pas new file mode 100644 index 000000000..c24b44fd7 --- /dev/null +++ b/InstallerSamples/WhatsNew/3_11_1/ArcCoords.pas @@ -0,0 +1,15 @@ +// Использование DrawArc и ATan2 (3.11.1) +uses Coords; + +begin + SetMouseDown((x,y,mb) -> begin + if mb <> 2 then exit; + var xr := ScreenToRealX(x); + var yr := ScreenToRealY(y); + DrawCircle(xr,yr,0.1,Colors.Red); + DrawLine(0,0,xr,yr); + var angle := RadToDeg(ATan2(yr,xr)); + DrawArc(0,0,2,0,angle); + Println(angle); + end); +end. \ No newline at end of file diff --git a/bin/Lib/Coords.pas b/bin/Lib/Coords.pas index d2565ba1b..b76dfdf55 100644 --- a/bin/Lib/Coords.pas +++ b/bin/Lib/Coords.pas @@ -310,6 +310,45 @@ begin dc.DrawEllipse(cb,cp,p,r,r); end; +procedure ArcPlay(dc: DrawingContext; x,y,r,startAngle,endAngle: real; c: Color); +begin + var cp := ColorPen(c,CurrentPenWidth); + var center := fso.RealToScreen(Pnt(x,y)); + r := r * Scale; + + var geometry := new System.Windows.Media.StreamGeometry(); + var context := geometry.Open(); + var startAngleRad := startAngle * PI / 180; + var endAngleRad := endAngle * PI / 180; + var startPoint := new Point( + center.X + r * Cos(startAngleRad), + center.Y - r * Sin(startAngleRad) + ); + var endPoint := new Point( + center.X + r * Cos(endAngleRad), + center.Y - r * Sin(endAngleRad) + ); + + context.BeginFigure(startPoint, false, false); + + var cw := endAngle - startAngle < 0; + var dir := System.Windows.Media.SweepDirection.Counterclockwise; + if cw then + dir := System.Windows.Media.SweepDirection.Clockwise; + context.ArcTo(endPoint, + new System.Windows.Size(r, r), + 0, + False, + dir, + true, + false + ); + context.Close; + + dc.DrawGeometry(nil, cp, geometry); +end; + + procedure RectanglePlay(dc: DrawingContext; x,y,w,h: real; c: Color; borderc: Color); begin var cb := ColorBrush(c); @@ -404,6 +443,12 @@ type public procedure Play(dc: DrawingContext); override := LinePlay(dc,x,y,x1,y1,c,width); end; + ArcC = auto class(Command) + x,y,radius,startAngle,endAngle: real; + c: Color; + public + procedure Play(dc: DrawingContext); override := ArcPlay(dc,x,y,radius,startAngle,endAngle,c); + end; TextC = auto class(Command) x,y: real; text: string; @@ -533,6 +578,11 @@ begin DrawPoints(points,PointRadius); end; +/// Рисует дугу +procedure DrawArc(x,y,r,startAngle,endAngle: real; Color: GColor := Colors.Black) + := ArcC.Create(x,y,r,startAngle,endAngle,Color).AddToListAndPlay; + + /// Расстояние между точками function Distance(p1,p2: Point): real := Sqrt((p2.x-p1.x)**2 + (p2.y-p1.y)**2); /// Расстояние между точками @@ -671,6 +721,39 @@ type AfterResize := True; end; end; + +procedure SetMouseDown(handler: (real,real,integer) -> ()); +begin + OnMouseDown += handler; +end; + +procedure SetMouseUp(handler: (real,real,integer) -> ()); +begin + OnMouseUp += handler; +end; + +procedure SetMouseMove(handler: (real,real,integer) -> ()); +begin + OnMouseMove += handler; +end; + +procedure SetKeyPress(handler: char -> ()); +begin + OnKeyPress += handler; +end; + +procedure SetKeyDown(handler: Key -> ()); +begin + OnKeyDown += handler; +end; + +function RealToScreenX(xx: real) := fso.RealToScreenX(xx); +function RealToScreenY(yy: real) := fso.RealToScreenY(yy); +function ScreenToRealX(xx: real) := fso.ScreenToRealX(xx); +function ScreenToRealY(yy: real) := fso.ScreenToRealY(yy); +function ScreenToReal(p: Point): Point := fso.ScreenToReal(p); +function RealToScreen(p: Point): Point := fso.RealToScreen(p); + initialization InitCoordGrid; diff --git a/bin/Lib/PABCSystem.pas b/bin/Lib/PABCSystem.pas index 62022d830..15e880143 100644 --- a/bin/Lib/PABCSystem.pas +++ b/bin/Lib/PABCSystem.pas @@ -2123,6 +2123,12 @@ function Succ(x: char): char; function ChrWindows(a: byte): char; /// Преобразует символ в код в кодировке Windows function OrdWindows(a: char): byte; + +/// Преобразует код в символ в кодировке Windows. Устарело. Используйте ChrWindows +function ChrAnsi(a: byte): char; +/// Преобразует символ в код в кодировке Windows. Устарело. Используйте OrdWindows +function OrdAnsi(a: char): byte; + /// Преобразует код в символ в кодировке Unicode function Chr(a: word): char; /// Преобразует символ в код в кодировке Unicode @@ -9960,6 +9966,11 @@ begin end; end; +function ChrAnsi(a: byte): char := ChrWindows(a); + +function OrdAnsi(a: char): byte := OrdWindows(a); + + function Ord(a: integer): integer; begin Result := a;