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

fix #2223

Browse source 
TryRead с доппараметром - message
GraphWPF - DrawGraph - доппараметр - заголовок
This commit is contained in:
Mikhalkovich Stanislav 2020-04-13 23:33:20 +03:00
parent bded93e7c7
commit fcf04d7c99
13 changed files with 2469 additions and 2346 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 = "6";
public const string Build = "2";
public const string Revision = "2392";
public const string Revision = "2403";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

4
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%COREVERSION%=2
%REVISION%=2392
%MINOR%=6
%REVISION%=2403
%COREVERSION%=2
%MAJOR%=3

6
Parsers/PascalABCParserNewSaushkin/ABCPascal.cs
View file

@ -1,9 +1,9 @@
//
// This CSharp output file generated by Gardens Point LEX
// Version: 1.1.3.301
// Machine: DESKTOP-P4NLNB1
// DateTime: 3/9/2020 1:37:31 PM
// UserName: fatco
// Machine: DESKTOP-G8V08V4
// DateTime: 13.04.2020 23:05:41
// UserName: ?????????
// GPLEX input file <ABCPascal.lex>
// GPLEX frame file <embedded resource>
//

10
Parsers/PascalABCParserNewSaushkin/ABCPascal.y
View file

@ -3335,6 +3335,10 @@ relop_expr
{
$$ = new bin_expr($1, $3, $2.type, @$);
}
| relop_expr relop new_question_expr
{
$$ = new bin_expr($1, $3, $2.type, @$);
}
| is_type_expr tkRoundOpen pattern_out_param_list tkRoundClose
{
var isTypeCheck = $1 as typecast_node;
@ -3727,6 +3731,10 @@ term1
{
$$ = new bin_expr($1, $3, $2.type, @$);
}
| term1 addop new_question_expr
{
$$ = new bin_expr($1, $3, $2.type, @$);
}
;
addop
@ -3795,6 +3803,8 @@ term
{ $$ = new bin_expr($1,$3,($2).type, @$); }
| term mulop power_expr
{ $$ = new bin_expr($1,$3,($2).type, @$); }
| term mulop new_question_expr
{ $$ = new bin_expr($1,$3,($2).type, @$); }
| as_is_expr
{ $$ = $1; }
;

4395
Parsers/PascalABCParserNewSaushkin/ABCPascalYacc.cs
View file

File diff suppressed because it is too large Load diff

1
Parsers/PascalABCParserNewSaushkin/PABC.ymc
View file

@ -264,5 +264,6 @@ script=

2
Release/pabcversion.txt
View file

@ -1 +1 @@
3.6.2.2392
3.6.2.2403

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.6.2.2392'
!define VERSION '3.6.2.2403'

231
TestSuite/CompilationSamples/GraphWPF.pas
View file

@ -415,21 +415,25 @@ function TextSize(text: string): Size;
//>> Функции для вывода графиков # GraphWPF graph functions
// -----------------------------------------------------
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real);
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом параметрами x,y,w,h. Два последних параметра задают шаг сетки по OX и OY
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real; XTicks: real; YTicks: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике r
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect);
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике r. Два последних параметра задают шаг сетки по OX и OY
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; XTicks, YTicks: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, на полное графическое окно
procedure DrawGraph(f: real -> real; a, b, min, max: real);
procedure DrawGraph(f: real -> real; a, b, min, max: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real);
procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике r
procedure DrawGraph(f: real -> real; a, b: real; r: GRect);
procedure DrawGraph(f: real -> real; a, b: real; r: GRect; title: string := '');
/// Рисует график функции f, заданной на отрезке [-5,5], в прямоугольнике r
procedure DrawGraph(f: real -> real; r: GRect);
procedure DrawGraph(f: real -> real; r: GRect; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b], на полное графическое окно
procedure DrawGraph(f: real -> real; a, b: real);
procedure DrawGraph(f: real -> real; a, b: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [-5,5], на полное графическое окно
procedure DrawGraph(f: real -> real);
procedure DrawGraph(f: real -> real; title: string := '');
// -----------------------------------------------------
//>> Функции для настройки системы координат # GraphWPF coordinate system functions
@ -1168,97 +1172,152 @@ procedure TextOut(x, y: real; text: real; c: GColor; align: Alignment; angle: re
type
FS = auto class
mx, my, a, min, max: real;
x1, y1: real;
f: real-> real;
mx, my, a, b, min, max: real;
x, y, w, h, XTicks, YTicks: real;
f: real -> real;
title: string;
marginY := 6;
marginX := 6;
spaceBetweenTextAndGraph := 4;
function Apply(x: real) := Pnt(x1 + mx * (x - a), y1 + my * (max - f(x)));
function RealToScreenX(x: real) := x1 + mx * (x - a);
function RealToScreenY(y: real) := y1 - my * (y + min);
constructor (a, b, min, max, x, y, w, h: real; f: real -> real; XTicks: real := 1; YTicks: real := 1; title: string := '');
begin
Self.a := a.Round(5); Self.b := b.Round(5);
Self.min := min.Round(5); Self.max := max.Round(5);
Self.x := x; Self.y := y; Self.w := w; Self.h := h;
Self.f := f; Self.XTicks := XTicks; Self.YTicks := YTicks;
Self.title := title;
end;
function Ticks(d: real): real;
begin
var n := floor(log10(d));
var p := Power(10,n);
var r := d / p;
// r = 1 .. 10
if r >= 5 then
Result := p
else if r >= 2 then
Result := p/2
else Result := p/5
end;
procedure CorrectBounds;
begin
//var digits := 5;
var tw := TextWidth('-99.9');
var th := TextHeight('0');
w -= marginX * 2 + spaceBetweenTextAndGraph + tw;
h -= marginY * 2 + spaceBetweenTextAndGraph + th;
x += marginX + spaceBetweenTextAndGraph + tw;
y += marginY;
if title<>'' then
begin
y += spaceBetweenTextAndGraph + th;
h -= spaceBetweenTextAndGraph + th;
end;
mx := w / (b - a);
my := h / (max - min);
if real.IsNaN(XTicks) then
XTicks := Ticks(b-a);
if real.IsNaN(YTicks) then
YTicks := Ticks(max-min);
end;
function Apply(xx: real) := Pnt(x + mx * (xx - a), y + my * (max - f(xx)));
function RealToScreenX(xx: real) := x + mx * (xx - a);
function RealToScreenY(yy: real) := y + h - my * (yy - min); // ?
function ScreenToRealX(xx: real) := (xx - x) / mx + a;
function ScreenToRealY(yy: real) := (y + h - yy) / my + min;
procedure Draw;
var AxisColor := GrayColor(112);
begin
FillRectangle(x, y, w, h, Colors.White);
CorrectBounds;
Pen.Color := Colors.LightGray;
var sx := mx * XTicks;
var xt := XTicks * Trunc(Abs(a)/XTicks);
var rx0: real;
if a <= 0 then
rx0 := -xt
else rx0 := xt + XTicks;
//var rx0 := a;
var x0 := RealToScreenX(rx0);
while x0<=x+w+0.000001 do
begin
if Abs(rx0)<0.000001 then
Line(x0,y,x0,y+h,AxisColor)
else Line(x0,y,x0,y+h);
TextOut(x0,y+h+4,rx0.Round(3),Alignment.CenterTop);
x0 += sx;
rx0 += XTicks;
end;
var sy := my * YTicks;
var yt := YTicks * Trunc(Abs(min)/YTicks);
var ry0: real;
if min <= 0 then
ry0 := -yt
else ry0 := yt + YTicks;
//var ry0 := min;
//var y0 := y + h;
if title<>'' then
TextOut(x+w/2,y-spaceBetweenTextAndGraph,Title,Alignment.CenterBottom);
var y0 := RealToScreenY(ry0);
while y0>=y-0.000001 do
begin
if Abs(ry0)<0.000001 then
Line(x,y0,x+w,y0,AxisColor)
else Line(x,y0,x+w,y0);
TextOut(x-4,y0,ry0.Round(5),Alignment.RightCenter);
y0 -= sy;
ry0 += YTicks;
end;
DrawRectangle(x, y, w, h,Colors.Black);
Pen.Color := Colors.Black;
var n := Round(w / 1);
var pp := PartitionPoints(a, b, n);
var fff: real -> Point := xx -> Pnt(x + mx * (xx - a), y + my * (max - f(xx).Clamp(min,max)));
Polyline(pp.Select(fff).ToArray);
end;
end;
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом параметрами x,y,w,h,
procedure DrawGraph(f: real-> real; a, b, min, max, x, y, w, h: real);
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом параметрами x,y,w,h
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real; title: string);
begin
var coefx := w / (b - a);
var coefy := h / (max - min);
var fso := new FS(coefx, coefy, a, min, max, x, y, f);
// Линии
{Pen.Color := Color.LightGray;
var hx := 1.0;
var xx := hx;
while xx<b do
begin
var x0 := fso.RealToScreenX(xx);
Line(x0,y1,x0,y2);
xx += hx
end;
xx := -hx;
while xx>a do
begin
var x0 := fso.RealToScreenX(xx);
Line(x0,y1,x0,y2);
xx -= hx
end;
var hy := 1.0;
var yy := hy;
while yy<max do
begin
var y0 := fso.RealToScreenY(yy);
Line(x1,y0,x2,y0);
yy += hy
end;
yy := -hy;
while yy>min do
begin
var y0 := fso.RealToScreenY(yy);
Line(x1,y0,x2,y0);
yy -= hy
end;
// Оси
Pen.Color := Color.Blue;
var x0 := fso.RealToScreenX(0);
var y0 := fso.RealToScreenY(0);
Line(x0,y1,x0,y2);
Line(x1,y0,x2,y0);}
// График
Pen.Color := Colors.Black;
Rectangle(x, y, w, h);
Pen.Color := Colors.Black;
var n := Round(w / 3);
Polyline(PartitionPoints(a, b, n).Select(fso.Apply).ToArray);
DrawGraph(f,a,b,min,max,x,y,w,h,real.NaN,real.NaN,title);
end;
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect) := DrawGraph(f, a, b, min, max, r.X, r.Y, r.Width, r.Height);
procedure DrawGraph(f: real -> real; a, b, min, max: real) := DrawGraph(f, a, b, min, max, Window.ClientRect);
procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real);
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом параметрами x,y,w,h. Два последних параметра задают шаг сетки по OX и OY
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h, XTicks, YTicks: real; title: string);
begin
var n := Round(w / 3);
var fso := new FS(a,b,min,max,x,y,w,h,f,XTicks,YTicks,title);
fso.Draw;
end;
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; title: string) := DrawGraph(f, a, b, min, max, r.X, r.Y, r.Width, r.Height, title);
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; XTicks, YTicks: real; title: string) := DrawGraph(f, a, b, min, max, r.X, r.Y, r.Width, r.Height, XTicks, YTicks, title);
procedure DrawGraph(f: real -> real; a, b, min, max: real; title: string) := DrawGraph(f, a, b, min, max, Window.ClientRect, title);
procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real; title: string);
begin
var n := Round(w / 1);
var q := PartitionPoints(a, b, n);
DrawGraph(f, a, b, q.Min(f), q.Max(f), x, y, w, h)
DrawGraph(f, a, b, q.Min(f), q.Max(f), x, y, w, h, title)
end;
procedure DrawGraph(f: real -> real; a, b: real; r: GRect) := DrawGraph(f, a, b, r.X, r.Y, r.Width, r.Height);
procedure DrawGraph(f: real -> real; a, b: real; r: GRect; title: string) := DrawGraph(f, a, b, r.X, r.Y, r.Width, r.Height, title);
procedure DrawGraph(f: real -> real; r: GRect) := DrawGraph(f, -5, 5, r);
procedure DrawGraph(f: real -> real; r: GRect; title: string) := DrawGraph(f, -5, 5, r, title);
procedure DrawGraph(f: real -> real; a, b: real) := DrawGraph(f, a, b, 0, 0, Window.Width - 1, Window.Height - 1);
procedure DrawGraph(f: real -> real; a, b: real; title: string) := DrawGraph(f, a, b, 0, 0, Window.Width - 1, Window.Height - 1, title);
procedure DrawGraph(f: real -> real) := DrawGraph(f, -5, 5);
procedure DrawGraph(f: real -> real; title: string) := DrawGraph(f, -5, 5, title);
function GraphWindowTypeGetLeftP: real;
begin

75
TestSuite/CompilationSamples/PABCSystem.pas
View file

@ -771,30 +771,31 @@ procedure Readln;
///- function TryRead(var x: число): boolean;
/// Вводит числовое значение x с клавиатуры. Возвращает False если при вводе произошла ошибка
function TryRead(var x: integer): boolean;
function TryRead(var x: integer; message: string := ''): boolean;
///- function TryRead(var x: число; message: string): boolean;
/// Выводит приглашение к вводу и вводит числовое значение x с клавиатуры. Возвращает False если при вводе произошла ошибка
function TryRead(var x: real; message: string := ''): boolean;
///--
function TryRead(var x: real): boolean;
function TryRead(var x: byte; message: string := ''): boolean;
///--
function TryRead(var x: byte): boolean;
function TryRead(var x: shortint; message: string := ''): boolean;
///--
function TryRead(var x: shortint): boolean;
function TryRead(var x: smallint; message: string := ''): boolean;
///--
function TryRead(var x: smallint): boolean;
function TryRead(var x: word; message: string := ''): boolean;
///--
function TryRead(var x: word): boolean;
function TryRead(var x: longword; message: string := ''): boolean;
///--
function TryRead(var x: longword): boolean;
function TryRead(var x: int64; message: string := ''): boolean;
///--
function TryRead(var x: int64): boolean;
function TryRead(var x: uint64; message: string := ''): boolean;
///--
function TryRead(var x: uint64): boolean;
function TryRead(var x: single; message: string := ''): boolean;
///--
function TryRead(var x: single): boolean;
///--
function TryRead(var x: BigInteger): boolean;
function TryRead(var x: BigInteger; message: string := ''): boolean;
/// Вводит логическое значение x с клавиатуры. Возвращает False если при вводе произошла ошибка
function TryRead(var x: boolean): boolean;
function TryRead(var x: boolean; message: string := ''): boolean;
/// Возвращает значение типа integer, введенное с клавиатуры
function ReadInteger: integer;
@ -5578,120 +5579,144 @@ begin
CurrentIOSystem.read(x)
end;
function TryRead(var x: integer): boolean;
function TryRead(var x: integer; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;
end
end;
function TryRead(var x: BigInteger): boolean;
function TryRead(var x: BigInteger; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;
end
end;
function TryRead(var x: real): boolean;
function TryRead(var x: real; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;
end
end;
function TryRead(var x: byte): boolean;
function TryRead(var x: byte; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;
end
end;
function TryRead(var x: shortint): boolean;
function TryRead(var x: shortint; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;
end
end;
function TryRead(var x: smallint): boolean;
function TryRead(var x: smallint; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;
end
end;
function TryRead(var x: word): boolean;
function TryRead(var x: word; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;
end
end;
function TryRead(var x: longword): boolean;
function TryRead(var x: longword; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;
end
end;
function TryRead(var x: int64): boolean;
function TryRead(var x: int64; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;
end
end;
function TryRead(var x: uint64): boolean;
function TryRead(var x: uint64; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;
end
end;
function TryRead(var x: single): boolean;
function TryRead(var x: single; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;
end
end;
function TryRead(var x: boolean): boolean;
function TryRead(var x: boolean; message: string): boolean;
begin
Result := True;
try
if message<>'' then
Print(message);
Read(x)
except
Result := False;

10
TestSuite/CompilationSamples/mouse2.pas
View file

@ -1,10 +0,0 @@
uses GraphWPF;
begin
Window.Title := 'Рисование мышью';
Pen.Color := Colors.Blue;
Pen.Width := 3;
OnMouseDown := (x,y,mb) -> MoveTo(x,y);
OnMouseMove := (x,y,mb) -> if mb=1 then LineTo(x,y);
OnKeyDown := k -> if k = Key.Space then Window.Save('a.png');
end.

5
TestSuite/PlusIfOp.pas Normal file
View file

@ -0,0 +1,5 @@
begin
var a := 2 + if true then 2 else 3;
var b := 2 * if true then 2 else 3;
var c := 2 < if true then 2 else 3;
end.

72
bin/Lib/GraphWPF.pas
View file

@ -415,25 +415,25 @@ function TextSize(text: string): Size;
//>> Функции для вывода графиков # GraphWPF graph functions
// -----------------------------------------------------
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real);
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом параметрами x,y,w,h. Два последних параметра задают шаг сетки по OX и OY
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real; XTicks: real; YTicks: real);
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real; XTicks: real; YTicks: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике r
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect);
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике r. Два последних параметра задают шаг сетки по OX и OY
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; XTicks, YTicks: real);
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; XTicks, YTicks: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, на полное графическое окно
procedure DrawGraph(f: real -> real; a, b, min, max: real);
procedure DrawGraph(f: real -> real; a, b, min, max: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real);
procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике r
procedure DrawGraph(f: real -> real; a, b: real; r: GRect);
procedure DrawGraph(f: real -> real; a, b: real; r: GRect; title: string := '');
/// Рисует график функции f, заданной на отрезке [-5,5], в прямоугольнике r
procedure DrawGraph(f: real -> real; r: GRect);
procedure DrawGraph(f: real -> real; r: GRect; title: string := '');
/// Рисует график функции f, заданной на отрезке [a,b], на полное графическое окно
procedure DrawGraph(f: real -> real; a, b: real);
procedure DrawGraph(f: real -> real; a, b: real; title: string := '');
/// Рисует график функции f, заданной на отрезке [-5,5], на полное графическое окно
procedure DrawGraph(f: real -> real);
procedure DrawGraph(f: real -> real; title: string := '');
// -----------------------------------------------------
//>> Функции для настройки системы координат # GraphWPF coordinate system functions
@ -1175,16 +1175,18 @@ type
mx, my, a, b, min, max: real;
x, y, w, h, XTicks, YTicks: real;
f: real -> real;
title: string;
marginY := 6;
marginX := 6;
spaceBetweenTextAndGraph := 4;
constructor (a, b, min, max, x, y, w, h: real; f: real -> real; XTicks: real := 1; YTicks: real := 1);
constructor (a, b, min, max, x, y, w, h: real; f: real -> real; XTicks: real := 1; YTicks: real := 1; title: string := '');
begin
Self.a := a.Round(5); Self.b := b.Round(5);
Self.min := min.Round(5); Self.max := max.Round(5);
Self.x := x; Self.y := y; Self.w := w; Self.h := h;
Self.f := f; Self.XTicks := XTicks; Self.YTicks := YTicks;
Self.title := title;
end;
function Ticks(d: real): real;
@ -1202,12 +1204,18 @@ type
procedure CorrectBounds;
begin
var digits := 5;
//var digits := 5;
var tw := TextWidth('-99.9');
var th := TextHeight('0');
w -= marginX * 2 + spaceBetweenTextAndGraph + tw;
h -= marginY * 2 + spaceBetweenTextAndGraph + TextHeight('0');
h -= marginY * 2 + spaceBetweenTextAndGraph + th;
x += marginX + spaceBetweenTextAndGraph + tw;
y += marginY;
if title<>'' then
begin
y += spaceBetweenTextAndGraph + th;
h -= spaceBetweenTextAndGraph + th;
end;
mx := w / (b - a);
my := h / (max - min);
if real.IsNaN(XTicks) then
@ -1223,6 +1231,7 @@ type
function ScreenToRealY(yy: real) := (y + h - yy) / my + min;
procedure Draw;
var AxisColor := GrayColor(112);
begin
FillRectangle(x, y, w, h, Colors.White);
CorrectBounds;
@ -1237,7 +1246,9 @@ type
var x0 := RealToScreenX(rx0);
while x0<=x+w+0.000001 do
begin
Line(x0,y,x0,y+h);
if Abs(rx0)<0.000001 then
Line(x0,y,x0,y+h,AxisColor)
else Line(x0,y,x0,y+h);
TextOut(x0,y+h+4,rx0.Round(3),Alignment.CenterTop);
x0 += sx;
rx0 += XTicks;
@ -1251,10 +1262,14 @@ type
else ry0 := yt + YTicks;
//var ry0 := min;
//var y0 := y + h;
if title<>'' then
TextOut(x+w/2,y-spaceBetweenTextAndGraph,Title,Alignment.CenterBottom);
var y0 := RealToScreenY(ry0);
while y0>=y-0.000001 do
begin
Line(x,y0,x+w,y0);
if Abs(ry0)<0.000001 then
Line(x,y0,x+w,y0,AxisColor)
else Line(x,y0,x+w,y0);
TextOut(x-4,y0,ry0.Round(5),Alignment.RightCenter);
y0 -= sy;
ry0 += YTicks;
@ -1271,39 +1286,38 @@ type
end;
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом параметрами x,y,w,h
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real);
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real; title: string);
begin
var fso := new FS(a,b,min,max,x,y,w,h,f,real.NaN,real.NaN);
fso.Draw;
DrawGraph(f,a,b,min,max,x,y,w,h,real.NaN,real.NaN,title);
end;
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом параметрами x,y,w,h. Два последних параметра задают шаг сетки по OX и OY
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h, XTicks, YTicks: real);
procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h, XTicks, YTicks: real; title: string);
begin
var fso := new FS(a,b,min,max,x,y,w,h,f,XTicks,YTicks);
var fso := new FS(a,b,min,max,x,y,w,h,f,XTicks,YTicks,title);
fso.Draw;
end;
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect) := DrawGraph(f, a, b, min, max, r.X, r.Y, r.Width, r.Height);
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; title: string) := DrawGraph(f, a, b, min, max, r.X, r.Y, r.Width, r.Height, title);
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; XTicks, YTicks: real) := DrawGraph(f, a, b, min, max, r.X, r.Y, r.Width, r.Height, XTicks, YTicks);
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; XTicks, YTicks: real; title: string) := DrawGraph(f, a, b, min, max, r.X, r.Y, r.Width, r.Height, XTicks, YTicks, title);
procedure DrawGraph(f: real -> real; a, b, min, max: real) := DrawGraph(f, a, b, min, max, Window.ClientRect);
procedure DrawGraph(f: real -> real; a, b, min, max: real; title: string) := DrawGraph(f, a, b, min, max, Window.ClientRect, title);
procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real);
procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real; title: string);
begin
var n := Round(w / 1);
var q := PartitionPoints(a, b, n);
DrawGraph(f, a, b, q.Min(f), q.Max(f), x, y, w, h)
DrawGraph(f, a, b, q.Min(f), q.Max(f), x, y, w, h, title)
end;
procedure DrawGraph(f: real -> real; a, b: real; r: GRect) := DrawGraph(f, a, b, r.X, r.Y, r.Width, r.Height);
procedure DrawGraph(f: real -> real; a, b: real; r: GRect; title: string) := DrawGraph(f, a, b, r.X, r.Y, r.Width, r.Height, title);
procedure DrawGraph(f: real -> real; r: GRect) := DrawGraph(f, -5, 5, r);
procedure DrawGraph(f: real -> real; r: GRect; title: string) := DrawGraph(f, -5, 5, r, title);
procedure DrawGraph(f: real -> real; a, b: real) := DrawGraph(f, a, b, 0, 0, Window.Width - 1, Window.Height - 1);
procedure DrawGraph(f: real -> real; a, b: real; title: string) := DrawGraph(f, a, b, 0, 0, Window.Width - 1, Window.Height - 1, title);
procedure DrawGraph(f: real -> real) := DrawGraph(f, -5, 5);
procedure DrawGraph(f: real -> real; title: string) := DrawGraph(f, -5, 5, title);
function GraphWindowTypeGetLeftP: real;
begin