1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function P(a,f,l:real):real;
begin
P:=a*f*f-l;
end;
procedure TForm1.Button1Click(Sender: TObject);
var x0,y0,i,x1,y1:integer;
a,f,l,max,x,m:real;
s:string;
begin
a:=0.8;
f:=0;
l:=1;
max:=abs(P(a,f,l));{найдем максимум функции для масштаба}
while f<=2*pi do
begin
f:=f+0.1;
if abs(P(a,f,l))>max then max:=abs(P(a,f,l));
end;
//центр
x0:=Image1.Width div 2;
y0:=Image1.Height div 2;
m:=(y0-20)/(max);{масштаб для перевода в экранные координаты}
with Image1.Canvas do
begin
brush.Color:=clWhite;
rectangle(0,0,width,height);
{КООРДИНАТНАЯ СЕТКА}
pen.Color:=clBlack;
font.Color:=clBlack;
brush.Style:=bsClear;
for i:=1 to trunc(max/10) do
begin
{рисуем окружности через 10}
ellipse(x0-round(i*m*10),y0-round(i*m*10),x0+round(i*m*10),y0+round(i*m*10));
{пишем шкалу}
textout(x0+round((i*m*10))+3,y0+10,IntToStr(i*10));
textout(x0-round((i*m*10))+3,y0+10,IntToStr(i*10));
end;
x:=pi/6;{шаг по кругу=30 град}
for i:=1 to 11 do{делим на 12 частей}
begin
{рисуем радиусы пунктиром}
pen.Style:=psDash;
x1:=x0+round((y0)*cos(i*x));
y1:=y0-round((y0)*sin(i*x));
moveto(x0,y0);
lineto(x1,y1);
{пишем подписи}
if y1>=y0 then textout(x1+10,y1-10,IntToStr(i*30))
else textout(x1,y1+10,IntToStr(i*30))
end;
textout(x0+y0-20,y0-20,'0');
{рисуем осевые линии сплошной линией}
pen.Style:=psSolid;
moveto(10,y0);lineto(width-10,y0);
moveto(x0,0);lineto(x0,height);
textout(x0+5,y0+10,'0');
font.Style:=[fsBold];
textout(Image1.width-20,y0-20,'P');
{ГРАФИК}
f:=0;
while f<=2*pi do //рисуем обе ветки, можно вторую убрать
begin
pixels[x0+trunc(P(a,f,l)*cos(f)*m),y0-trunc(P(a,f,l)*sin(f)*m)]:=clRed;
pixels[x0+trunc(P(a,f,l)*cos(f)*m),y0+trunc(P(a,f,l)*sin(f)*m)]:=clBlue;
f:=f+0.001;
end;
end;
end;
end. |
2-ая ссылка обломалась.
