Перевести из Turbo Pascal в Pascal ABC

@antonio_querte · Регистрация: 02.07.2019

Студворк — интернет-сервис помощи студентам

Добрый вечер. Необходимо перевести этот код из Turbo Pascal в Pascal ABC. Заранее спасибо.

Pascal
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
uses crt,graph;
function F(x:real):real; 
begin 
F:=2*sin(x)+0.5*cos(x);
end; 
const xn=0; 
xk=2*pi; 
h=0.001; 
var x,y,mx,my:real; 
n,i,gd,gm,x0,y0:integer; 
st:string; 
begin 
gd:=0; 
initgraph(gd,gm,''); 
x0:=40; 
y0:=getmaxY div 2; 
mx:=(getmaxX-60)/(xk-xn); 
my:=100; 
line(20,y0,getmaxX-20,y0); 
outtextXY(getmaxX-15,y0-15,'X'); 
for i:=1 to round(xk)+1 do 
begin 
line(x0+round(i*mx),y0+3,x0+round(i*mx),y0-3); 
line(x0-round(i*mx),y0+3,x0-round(i*mx),y0-3); 
line(x0+3,y0+round(i*my),x0-3,y0+round(i*my)); 
line(x0+3,y0-round(i*my),x0-3,y0-round(i*my)); 
str(i,st); 
outtextXY(x0+round(i*mx),y0+10,st); 
outtextXY(x0-round(i*mx),y0+10,'-'+st); 
outtextXY(x0-20,y0-round(i*my),st); 
outtextXY(x0-20,y0+round(i*my),'-'+st); 
end; 
line(x0,getmaxY-20,x0,20); 
outtextXY(x0-15,10,'Y'); 
x:=xn; 
while x<=xk do 
begin 
if (x>=pi)and(x<=1.5*pi)and(F(x)<0) then y:=1
else y:=F(x); 
putpixel(x0+round(x*mx),y0-round(y*my),12); 
x:=x+h; 
end; 
readln 
end.

@Pvt · 02.07.2019, 21:10

странный график

Pascal
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
uses  graphABC; 
 
procedure KeyDown(key: integer);
begin
  Window.Close;
end;  
   
function F(x:real):real; 
begin 
  F:=2*sin(x)+0.5*cos(x);
end; 
const xn=0; 
      xk=2*pi; 
      h=0.001; 
var x,y,mx,my:real; 
    i,x0,y0:integer; 
    st:string; 
begin 
  x0:=40; 
  y0:=Window.Height div 2; 
  mx:=(Window.Width-60)/(xk-xn); 
  my:=100; 
  line(20,y0,Window.Width-20,y0); 
  textout(Window.Width-15,y0-15,'X'); 
  for i:=1 to round(xk)+1 do 
  begin 
    line(x0+round(i*mx),y0+3,x0+round(i*mx),y0-3); 
    line(x0-round(i*mx),y0+3,x0-round(i*mx),y0-3); 
    line(x0+3,y0+round(i*my),x0-3,y0+round(i*my)); 
    line(x0+3,y0-round(i*my),x0-3,y0-round(i*my)); 
    str(i,st); 
    textout(x0+round(i*mx),y0+10,st); 
    textout(x0-round(i*mx),y0+10,'-'+st); 
    textout(x0-20,y0-round(i*my),st); 
    textout(x0-20,y0+round(i*my),'-'+st); 
  end; 
  line(x0,Window.Width-20,x0,20); 
  textout(x0-15,10,'Y'); 
  x:=xn; 
  while x<=xk do 
  begin 
    if (x>=pi)and(x<=1.5*pi)and(F(x)<0) then y:=1
    else y:=F(x); 
    putpixel(x0+round(x*mx),y0-round(y*my),Color.Red); 
    x:=x+h; 
  end; 
  OnKeyDown:=KeyDown;
end.

@antonio_querte · 02.07.2019, 21:36 **[ТС]**

Да, график интересный)
Не подскажите, каким образом при таком шаге можно добавить адекватные линии между точками?

Pascal
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
uses  graphABC; 
 
procedure KeyDown(key: integer);
begin
  Window.Close;
end;  
   
function F(x:real):real; 
begin 
  F:=2*sin(x)+0.5*cos(x);
end; 
const xn=0; 
      xk=2*pi; 
      h=pi/18; 
var x,y,mx,my:real; 
    i,x0,y0:integer; 
    st:string; 
begin 
  x0:=40; 
  y0:=Window.Height div 2; 
  mx:=(Window.Width-60)/(xk-xn); 
  my:=100; 
  line(20,y0,Window.Width-20,y0); 
  textout(Window.Width-15,y0-15,'X'); 
  for i:=1 to round(xk)+1 do 
  begin 
    line(x0+round(i*mx),y0+3,x0+round(i*mx),y0-3); 
    line(x0-round(i*mx),y0+3,x0-round(i*mx),y0-3); 
    line(x0+3,y0+round(i*my),x0-3,y0+round(i*my)); 
    line(x0+3,y0-round(i*my),x0-3,y0-round(i*my)); 
    str(i,st); 
    textout(x0+round(i*mx),y0+10,st); 
    textout(x0-round(i*mx),y0+10,'-'+st); 
    textout(x0-20,y0-round(i*my),st); 
    textout(x0-20,y0+round(i*my),'-'+st); 
  end; 
  line(x0,Window.Width-20,x0,20); 
  textout(x0-15,10,'Y'); 
  x:=xn; 
  while x<=xk do 
  begin 
    if (x>=pi)and(x<=1.5*pi)and(F(x)<0) then y:=1
    else y:=F(x); 
    putpixel(x0+round(x*mx),y0-round(y*my),Color.Red); 
    x:=x+h; 
  end; 
  OnKeyDown:=KeyDown;
end.

@Pvt · 02.07.2019, 21:37

какими точками?

@antonio_querte · 02.07.2019, 21:45 **[ТС]**

При таком шаге (h = pi/18) график отображается точками, т.е. нужны линии между ними, а у меня получается как-то так...

Pascal
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
uses graphABC; 
 
procedure KeyDown(key: integer); 
begin 
Window.Close; 
end; 
 
function F(x:real):real; 
begin 
F:=2*sin(x)+0.5*cos(x); 
end; 
const xn=0; 
xk=2*pi; 
h=pi/18; 
var x,y,mx,my:real; 
i,x0,y0, px,py:integer; 
st:string; 
begin 
x0:=40; 
y0:=Window.Height div 2; 
mx:=(Window.Width-60)/(xk-xn); 
my:=100; 
line(20,y0,Window.Width-20,y0); 
textout(Window.Width-15,y0-15,'X'); 
for i:=1 to round(xk)+1 do 
begin 
line(x0+round(i*mx),y0+3,x0+round(i*mx),y0-3); 
line(x0-round(i*mx),y0+3,x0-round(i*mx),y0-3); 
line(x0+3,y0+round(i*my),x0-3,y0+round(i*my)); 
line(x0+3,y0-round(i*my),x0-3,y0-round(i*my)); 
str(i,st); 
textout(x0+round(i*mx),y0+10,st); 
textout(x0-round(i*mx),y0+10,'-'+st); 
textout(x0-20,y0-round(i*my),st); 
textout(x0-20,y0+round(i*my),'-'+st); 
end; 
line(x0,Window.Width-20,x0,20); 
textout(x0-15,10,'Y'); 
x:=xn; 
while x<=xk do 
begin 
if (x>=pi)and(x<=1.5*pi)and(F(x)<0) then y:=1 
else y:=F(x); 
x:=x+h; 
px:=x0+round(x*mx); 
py:=y0-round(y*my); 
lineto(px,py); 
end; 
setfontsize(14); 
 
OnKeyDown:=KeyDown; 
end.

@Pvt · 02.07.2019, 21:58

внизу

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
..............
x:=xn; 
setpencolor(Color.Red);
while x<=xk do 
begin 
if (x>=pi)and(x<=1.5*pi)and(F(x)<0) then y:=1 
else y:=F(x); 
px:=x0+round(x*mx); 
py:=y0-round(y*my); 
if x=xn then moveto(px,py);
lineto(px,py); 
x:=x+h; 
end;
...........

@antonio_querte · 02.07.2019, 22:03 **[ТС]**

Большое спасибо за помощь. Сейчас всё красиво.

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Desktop (MinGW): Рисуем цветные прямоугольники с помощью рисовальщика SDL3 на Си и C++ 8Observer8 17.03.2026 Содержание блога Финальные проекты на Си и на C++: finish-rectangles-sdl3-c. zip finish-rectangles-sdl3-cpp. zip	Символические и жёсткие ссылки в Linux. algri14 15.03.2026 Существует два типа ссылок — символические и жёсткие. Ссылка в Linux — это запись в каталоге, которая может указывать либо на inode «файла-ИСТОЧНИКА», тогда это будет «жёсткая ссылка» (hard link),. . .	[Owen Logic] Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ФедосеевПавел 14.03.2026 Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ВВЕДЕНИЕ Выполняя задание на управление насосной группой заполнения резервуара,. . .	делаю науч статью по влиянию грибов на сукцессию anaschu 13.03.2026 прикрепляю статью
SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:	Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE 8Observer8 10.03.2026 Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .	Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки Neotwalker 08.03.2026 Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .	Модульная разработка через nuget packages DevAlt 07.03.2026 Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .

Перевести из Turbo Pascal в Pascal ABC

Решение

Решение

@Pvt Заблокирован
	02.07.2019, 21:37
	какими точками? 0

@antonio_querte 0 / 0 / 0 Регистрация: 02.07.2019 Сообщений: 4
	02.07.2019, 22:03 [ТС]
	Большое спасибо за помощь. Сейчас всё красиво. 0

Опции темы