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

GraphWPF: DrawGraph переработана - выводится сетка и координаты

Browse source
This commit is contained in:
Mikhalkovich Stanislav 2020-04-10 23:24:29 +03:00
parent ad39acac39
commit bded93e7c7
2 changed files with 140 additions and 69 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
PABCNetHelp/LangGuide/Operations_Expressions/IfOperation.html
View file

@ -7,7 +7,7 @@
<link rel="StyleSheet" href="../../default.css">
</head>
<body><H1>Óñëîâíàÿ îïåðàöèÿ</H1>
<p>Условная операция имеет следующий вид:</p>
<p>Óñëîâíàÿ îïåðàöèÿ (<strong>ïåðâàÿ ôîðìà</strong>) èìååò ñëåäóþùèé âèä:</p>
<blockquote>
<em>óñëîâèå</em> <code>?</code> <em>âûðàæåíèå1</em> <code>:</code> <em>âûðàæåíèå2</em>
</blockquote>
@ -25,4 +25,30 @@
min := a<br><strong>else</strong> min := b;</code></p>
</blockquote>
<p>Êðîìå òîãî, èìååòñÿ <strong>âòîðàÿ ôîðìà óñëîâíîé îïåðàöèè</strong> â
ñèíòàêñèñå Ïàñêàëÿ: </p>
<blockquote>
<code><strong>if</strong><em> </em> </code>
<em>óñëîâèå</em> <code> <strong>then</strong></code> <em>âûðàæåíèå1</em> <code><strong>else</strong></code> <em>âûðàæåíèå2</em>
</blockquote>
<p>Íàïðèìåð: </p>
<blockquote>
<p><code><b>var</b> min := <strong>if</strong> a &lt; b <strong>then</strong> a
<strong>else</strong> b;</code></p>
</blockquote>
<p>Ðåêîìåíäóåòñÿ èñïîëüçîâàòü âòîðóþ ôîðìó óñëîâíîé îïåðàöèè.</p>
<p><strong>Îãðàíè÷åíèå</strong>. Âòîðóþ ôîðìó óñëîâíîé îïåðàöèè íåëüçÿ
èñïîëüçîâàòü â êà÷åñòâå âûðàæåíèÿ âåðõíåãî óðîâíÿ â ëÿìáäàõ. Ñëåäóþùèé êîä
îøèáî÷åí:</p>
<blockquote>
<p><code><b>var</b> l: real -&gt; real := x -&gt; <strong>if</strong> x&lt;0 <strong>
then</strong> 0 <strong>else</strong> x;</code></p>
</blockquote>
<p>Äëÿ ðåøåíèÿ óêàçàííîé ïðîáëåìû ìîæíî âçÿòü óñëîâíóþ îïåðàöèþ â ñêîáêè:</p>
<blockquote>
<p><code><b>var</b> l: real -&gt; real := x -&gt; (<strong>if</strong> x&lt;0 <strong>
then</strong> 0 <strong>else</strong> x);</code></p>
</blockquote>
<p>&nbsp;</p>
</body></html>

181
bin/Lib/GraphWPF.pas
View file

@ -416,8 +416,12 @@ function TextSize(text: string): Size;
// -----------------------------------------------------
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
procedure DrawGraph(f: real -> real; a, b, min, max, 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: real; XTicks: real; YTicks: real);
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике r
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect);
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике r. Два последних параметра задают шаг сетки по OX и OY
procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; XTicks, YTicks: real);
/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, на полное графическое окно
procedure DrawGraph(f: real -> real; a, b, min, max: real);
/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике, задаваемом координатами x1,y1,x2,y2,
@ -1168,86 +1172,127 @@ 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;
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);
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;
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');
w -= marginX * 2 + spaceBetweenTextAndGraph + tw;
h -= marginY * 2 + spaceBetweenTextAndGraph + TextHeight('0');
x += marginX + spaceBetweenTextAndGraph + tw;
y += marginY;
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;
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
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;
var y0 := RealToScreenY(ry0);
while y0>=y-0.000001 do
begin
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);
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);
var fso := new FS(a,b,min,max,x,y,w,h,f,real.NaN,real.NaN);
fso.Draw;
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);
begin
var fso := new FS(a,b,min,max,x,y,w,h,f,XTicks,YTicks);
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; 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) := DrawGraph(f, a, b, min, max, Window.ClientRect);
procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real);
begin
var n := Round(w / 3);
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)
end;