Форум программистов, компьютерный форум, киберфорум
Наши страницы

PascalABC.NET

Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 5, средняя оценка - 5.00
BaboshinSD
330 / 269 / 28
Регистрация: 15.11.2012
Сообщений: 477
Записей в блоге: 1
#1

Полезные коды для PascalABC.NET - PascalABC.NET

23.03.2013, 15:03. Просмотров 169089. Ответов 119

В этой теме размещаются полезные исходники программ, различные процедуры и функции, а так же готовые решения на часто задаваемые вопросы, написанные на PascalABC.NET.

Поддержать тему и добавить свои примеры, исходники и пр. может каждый, после того, как ознакомиться с правилами темы:
Правила темы!
  1. Запрещается добавлять коды программ никак не связанные с PascalABC.NET, для этих программ есть другие темы и разделы.
  2. Не рекомендуется добавлять слишком простые примеры, типа "Как добавить текст на кнопку?" и пр.
  3. Перед тем как выложить код, подумайте будет ли он кому-то интересен или полезен.
  4. Приветствуются сложные примеры или проекты, а так же программы с интересным принципом работы.
  5. Если программа использует сторонние ресурсы (изображения, библиотеки и пр.) обязательно прикрепляйте их во вложении
  6. Обязательно подробно комментируйте свой код, чтобы другим было проще разобраться в нём.
  7. Тема ведётся в формате Вопрос-Ответ, поэтому все сообщения оформляются в таком виде:
    В: Как что-то сделать?
    О:
    Делаем что-то
    Pascal
    1
    
    // Тут код
  8. Если вы хотите отредактировать свой код, можно обратиться к модераторам раздела или к ТС.


Путеводитель по теме:


Работа с формами:

Готовые решения:
Готовые решения на часто задаваемые вопросы.

Работа с графикой:
Исходники программ, работающих с графикой и графическими библиотеками (GraphABC, OpenGL и пр.).
Проектирование игр:
Инструкции, советы и пр.:
Инструкции, касающиеся работы с PascalABC.NET, советы для новичков и пр.
Работа со строками:
Базовые алгоритмы:
23
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
23.03.2013, 15:03
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Полезные коды для PascalABC.NET (PascalABC.NET):

Модуль для PascalABC.NET - PascalABC.NET
Здравствуйте уважаемые форумчане, возник вопрос почему не работает модуль. Вот модуль unit Sockets; #reference 'System.dll' ...

В чем разница PascalABC.net и PascalABC - PascalABC.NET
Скажите в чем разница PascalABC.net И PascalABC. Помню когда-то давно программы работающие в PascalABC у меня не работали в .net

Процедура GetMem для PascalABC.NET - PascalABC.NET
Долго долго курил страницы форума, изучал динамические списки. Когда код для программы уже практически собрался в единое целое решил...

Исправить код для PascalABC.net - PascalABC.NET
как минимум, первое место которое ему не нравиться это как я обьявляю тип объект const size=10; type pvec=^vec; ...

Есть ли PascalABC.NET для Mac OS X? - PascalABC.NET
Есть ли PascalABC.NET для Mac OS X?

Создание своего модуля для PascalABC.net - PascalABC.NET
Здравствуйте уважаемые форумчане, подскажите как создать из файла Pas файл PCU. Чем и как его можно откомпилировать? Просто стоит задача...

119
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 15:43 #31
В: Нужно изображение птицы.
О:
птичка
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
uses graphABC;
var i: integer;
begin
//размер окна
setwindowsize(300,400);
//тело
setbrushcolor(clskyblue);
ellipse(30,130,150,320);
ellipse(150,130,270,320);
setbrushcolor(clblue);
ellipse(50,100,250,350);
circle(150,100,70);
setbrushcolor(clskyblue);
ellipse(70,170,230,340);
//глаза
ellipse(110,60,145,105);
ellipse(155,60,190,105);
setbrushcolor(clwhite);
ellipse(115,50,145,100);
ellipse(155,50,185,100);
setbrushcolor(clskyblue);
circle(130,80,10);
circle(170,80,10);
setbrushcolor(clblack);
circle(130,80,5);
circle(170,80,5);
//клюв
setbrushcolor(clyellow);
circle(150,130,20);
setpenwidth(3);
arc(150,142,17,0,180);
//чубчик
setpencolor(clblue);
for i:=-5 to 5 do
    line(150,50,150+(i*6),10);
//лапки
setpenwidth(1);
setpencolor(clblack);
setbrushcolor(clyellow);
for i:=-3 to 3 do
    if i<>0 then
       ellipse(145+(i*20),350,165+(i*20),370);
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

2
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 16:26 #32
В: Нужен рисунок (пейзаж): дом, дерево, забор.
О:
сельский пейзаж
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
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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
uses graphABC;
var x1,y1,x2,y2: integer;
 
//процедура рисования травы
procedure Trava;
begin
for var i:=1 to 1000 do
    begin
    x1:=random(801);
    y1:=random(251)+390;
    x2:=x1+random(10)-5;
    y2:=y1+random(20)+10;
    setpencolor(rgb(random(255),255,random(255)));
    line(x1,y1,x2,y2);
    end;
end;
 
//процедура рисования облака 
procedure Oblako(x2,y2: integer);
begin
setpencolor(clwhite);
setbrushcolor(clwhite);
rectangle(x2,y2-20,x2+100,y2);
circle(x2,y2-10,10);
circle(x2+100,y2-10,10);
circle(x2+20,y2-20,20);
circle(x2+80,y2-20,20);
circle(x2+50,y2-30,20);
end;
 
//процедура рисования забора 
procedure Zabor;
begin
x1:=00;
setbrushcolor(clyellow);
for var i:=1 to 20 do
    begin
    rectangle(x1,450,x1+20,600);
    x1:=x1+40;
    end;
rectangle(0,510,800,530);
end;
 
//процедура рисования яблок 
procedure Yabloki;
begin
for var i:=1 to 10 do
    begin
    x1:=random(141)+600;
    y1:=random(201)+200;
    setpencolor(clred);
    setbrushcolor(clred);
    circle(x1,y1,10);
    setpencolor(clyellow);
    setbrushcolor(clyellow);
    circle(x1-4,y1-4,5);
    end;
end;
//процедура рисования дыма 
procedure Dym(x1,y1,x2,y2: integer);
begin
setpencolor(clsilver);
setbrushcolor(clsilver);
ellipse(x1,y1,x2,y2);
setpencolor(clgray);
setbrushcolor(clgray);
ellipse(x1+5,y1+5,x2-15,y2-15);
end;
 
 
begin
//размер окна
setwindowsize(800,600);
//фон
setpencolor(clblue);
setbrushcolor(clblue);
rectangle(0,0,800,400);
setpencolor(clgreen);
setbrushcolor(clgreen);
rectangle(0,400,800,600);
Trava;
Oblako(-50,200);
Oblako(200,100);
Oblako(500,200);
Oblako(600,130);
//дом
setpencolor(clblack);
setbrushcolor(clSilver);
rectangle(50,300,250,500);
rectangle(250,500,500,300);
line(50,300,150,200);
line(150,200,250,300);
line(400,200,500,300);
line(150,200,400,200);
floodfill(150,250,clsilver);
floodfill(300,250,clMaroon);
setbrushcolor(clcyan);
rectangle(110,360,190,440);
rectangle(280,360,360,440);
setbrushcolor(clSilver);
rectangle(280,180,320,230);
setbrushcolor(clMaroon);
rectangle(400,350,470,500);
setbrushcolor(clcyan);
circle(150,270,20);
setbrushcolor(clBrown);
rectangle(650,400,670,500);
//яблоня
setbrushcolor(clgreen);
ellipse(570,150,750,420);
Yabloki;
Zabor;
Dym(320,130,380,170);
Dym(400,100,480,150);
Dym(490,40,600,100);
Dym(630,0,750,70);
end..
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

2
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 16:26 #33
В: Нужен рисунок: ваза с цветами.
О:
ваза с цветами
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
53
54
55
56
57
58
59
uses graphABC;
 
//процедура рисования цветка
procedure Zv (x,y: integer; cl:color);
var k: integer;
begin
//коэффициент размера лепестка
k:=0;
for var i:=1 to 10 do
    begin
//"задние" лепестки
    setpencolor(cl);
    setpenwidth(4);
    setbrushcolor(cl);
    circle(x+k div 2+k div 4,y+k div 2+k div 4,k div 2);
    circle(x+k div 2+k div 4,y-k div 2-k div 4,k div 2);
    circle(x-k div 2-k div 4,y+k div 2+k div 4,k div 2);
    circle(x-k div 2-k div 4,y-k div 2-k div 4,k div 2);
//сердцевинка
    setbrushcolor(clyellow);
    circle(x,y,k div 2);
//"передние" лепестки
    setbrushcolor(cl);
    circle(x-k,y,k div 2);
    circle(x+k,y,k div 2);
    circle(x,y-k,k div 2);
    circle(x,y+k,k div 2);
    k:=k+3;
    end;
end;
 
begin
//размер окна
setwindowsize(360,320);
//тень вазы
setpencolor(clblack);
setbrushcolor(clblack);
ellipse(100,270,250,300);
//ваза
setpencolor(clskyblue);
setbrushcolor(clskyblue);
rectangle(150,150,200,250);
circle(175,250,50);
//листва
setpencolor(clgreen);
setbrushcolor(clgreen);
circle(100,150,20);
circle(150,100,20);
circle(220,40,20);
circle(260,100,20);
circle(120,50,20);
circle(210,170,20);
//цветы
Zv (100,100,clred);
Zv (170,50,clmaroon);
Zv (210,80,clred);
Zv (230,130,clFuchsia);
Zv (160,150,clPurple);
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

2
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 17:16 #34
В: Нужна анимированная открытка С новым годом.
О:
С Новым Годом!
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
uses graphABC;
 
begin
//блокировка рисования в гр.окне, чтобы убрать мерцание при анимации
lockdrawing;
//заголовок и размер окна
SetWindowTitle('С Новым Годом!');
setwindowsize(550,400);
//бесконечный цикл анимации
repeat
//очистить окно
clearwindow;
//фон
setpencolor(clblack);
setbrushcolor(clblack);
rectangle(0,0,600,150);
setpencolor(clnavy);
setbrushcolor(clnavy);
rectangle(0,150,600,250);
setpencolor(clwhite);
setbrushcolor(clwhite);
rectangle(0,250,600,400);
//ель
setpencolor(clgreen);
line(300,350,400,50);
line(400,50,500,350);
line(500,350,300,350);
floodfill(400,100,clgreen);
floodfill(400,200,clgreen);
floodfill(400,300,clgreen);
//ствол ели
setpencolor(clbrown);
setbrushcolor(clbrown);
rectangle(380,350,420,380);
//снеговик
setpencolor(clSkyBlue);
setbrushcolor(clSkyBlue);
circle(110,290,60);
circle(110,210,40);
circle(63,232,10);
circle(156,232,10);
//мордашка снеговика
setpencolor(clblack);
setbrushcolor(clblack);
circle(110,250,10);
circle(110,280,10);
circle(90,200,5);
circle(130,200,5);
 
setpencolor(clred);
setbrushcolor(clred);
circle(110,210,10);
//текст
setbrushcolor(clblack);
SetFontColor(clyellow);
SetFontSize(30);
SetFontName('Times');
TextOut(20,20,'С Новым Годом!!!');
//снег
for var j:=1 to 100 do
    begin
    setbrushcolor(clwhite);
    setpencolor(clwhite);
    circle(random(550),random(400),3);
    end;
//задержка и перерисовка
sleep(100);
redraw;
until false;
 
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

3
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 17:16 #35
В: Часы с движущимися стрелками, анимация!
О:
Анимированные часы (на самом деле секундомер, конечно...)
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
53
54
55
56
57
58
59
60
uses GraphABC;
var x0,y0, x,y,  R, min, sec,chas: integer;
 
begin
  //блокировка рисования в гр.окне, для устранения мерцания при анимации
  lockdrawing;
  //размер окна
  SetWindowSize(700,600);
  //начальные значения: центр цифреблата, значение минут и секунд
  x0:=350; y0:=350; min:=0; sec:=0;
  //бесконечный цикл
  repeat
  //очистить окно
    ClearWindow;
    //корпус и циферблат часов
    SetPenWidth(5);
    setpencolor(clblack);
    rectangle(20,150,680,550);
    arc(350,130,100,0,180);
    line(250,130,450,130);
    circle(350,350,170);
    floodfill(30,160,clgreen);
    floodfill(350,50,clgray);
    setbrushcolor(clblack);
    rectangle(330,130,370,150);
    setbrushcolor(clgreen);
    rectangle(100,550,600,570);
    setbrushcolor(clwhite);
    rectangle(330,10,370,30);
    //надписи
    setfontsize(20);
    setfontcolor(clblack);
    setfontstyle(fsbold);
    textout(335,190,'12');
    textout(343,480,'6');
    textout(485,340,'3');
    textout(205,340,'9');
    //вычисляем положение стрелок и рисуем их
    sec:=sec+1; min:= sec div 60;chas:=min div 60;
    x:=x0+Round(120*sin(Pi*sec/30));
    y:=y0-Round(120*cos(Pi*sec/30));
    SetPenWidth(3);
    setpencolor(clblue);
    Line(x0, y0, x, y);
    x:=x0+Round(100*sin(Pi*min/30));
    y:=y0-Round(100*cos(Pi*min/30));
    SetPenWidth(7);
    setpencolor(cllime);
    Line(x0, y0, x, y);
    x:=x0+Round(60*sin(Pi*chas/30));
    y:=y0-Round(60*cos(Pi*chas/30));
    SetPenWidth(10);
    setpencolor(clred);
    Line(x0, y0, x, y);
    //задержка, перерисовка
    sleep(1000);
 
    Redraw;
  until false;
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

2
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 18:12 #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
49
50
51
52
53
54
55
56
57
58
59
uses graphABC;
var x,y,kx,ky,v: integer;
    b: boolean;
//процедура рисования фона, бильярндный стол
procedure Fon;
begin
clearwindow;
setbrushcolor(clbrown);
rectangle(10,10,490,390);
setbrushcolor(clgreen);
rectangle(20,20,480,380);
setbrushcolor(clbrown);
circle(30,30,20);
circle(470,370,20);
circle(470,30,20);
circle(30,370,20);
end;
//процедура рисования шарика и коррекции направления
procedure Shar(var xx,yy,kkx,kky: integer);
begin
if (xx<35) or (xx>465) then kkx:=kkx*(-1); //если шарик соприкоснулся с бортом, направление меняется на противоположное
if (yy<35) or (yy>365) then kky:=kky*(-1);
xx:=xx+kkx;
yy:=yy+kky;
setbrushcolor(clwhite);
circle(xx,yy,10);
end;
 
begin
lockdrawing;
//случайным образом генерирует направление и скорость шарика
v:=random(4);  
case v of
0: kx:=1;
1: kx:=2;
2: kx:=-1;
3: kx:=-2;
end;
v:=random(4);
case v of
0: ky:=1;
1: ky:=2;
2: ky:=-1;
3: ky:=-2;
end;
//начальные координаты
x:=250;
y:=200;
//цикл будет повторяться до попадания в лузу
repeat
Fon;
Shar(x,y,kx,ky);
sleep(1);
redraw;
//проверяем условие попадания в лузу
b:=((x<45) and (y<45)) or ((x<45) and (y>355))
 or ((x>455) and (y<45)) or ((x>455) and (y>355));
until b;
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

4
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 18:12 #37
В: Нужна анимация салюта.
О:
Одиночные выстрелы петардами с разноцветными осыпающимися искрами
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
53
54
55
56
57
58
59
60
61
62
63
uses graphABC;
var vx,vy: integer;
//процедура рисования взлета ракеты
procedure Vzlet(x,k: integer);
var i,y: integer;
begin
//начальные координаты петарды
y:=500;
for i:=1 to 100 do
    begin
    //рисуем петарду и след
    setbrushcolor(clwhite);
    setpencolor(clwhite);
    circle(x,y,5);
    //стираем остатки следа
    if i>10 then
       begin
       setbrushcolor(clblack);
       setpencolor(clblack);
       circle(x-(k*10),y+(4*10),6);
       end;
    y:=y-4;
    x:=x+k;
    sleep(10);
    end;
end;
//процедура взрыва петарды (6 раз перерисовываются постепенно уменьшающиеся, осыпающиеся цветные вспышки)
procedure Bach (x,y: integer);
var i,j,kx,ky: integer;
begin
for j:=1 to 6 do 
    begin
    //очистить окно
    clearwindow(clblack);
    //100 случайных вспышек в пределах круга
    for i:=1 to 100 do
        begin
        setbrushcolor(rgb(random(255),random(255),random(255)));
        setpencolor(rgb(random(255),random(255),random(255)));
        repeat
        kx:=random(200)-100;
        ky:=random(200)-100;
        until sqr(kx)+sqr(ky)<sqr(100);
        circle(x+kx,y+ky,6-j);
        sleep(1);
        end;
    y:=y+10;
    sleep(50);
    end;
end;
//основная программа
begin
//размер окна, очистить окно
setwindowsize(800,500);
clearwindow(clblack);
//бесконечный цикл
repeat
vx:=random(400)+200;
vy:=random(6)-3;
Vzlet(vx,vy);
Bach (vx+(vy*100),random(100)+100);
until false;
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

5
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 18:12 #38
В: Нужна анимация птицы.
О:
полет птицы
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
53
54
55
56
57
58
59
60
61
62
uses graphabC;
var x,y,ky: integer;
//процедура рисования облака
procedure Oblako(x,y: integer);
begin
setpencolor(clwhite);
setbrushcolor(clwhite);
rectangle(x,y-20,x+100,y);
circle(x,y-10,10);
circle(x+100,y-10,10);
circle(x+20,y-20,20);
circle(x+80,y-20,20);
circle(x+50,y-30,20);
end;
//процедура рисования птицы
procedure Ptiza (xx,yy: integer);
begin
setbrushcolor(clsilver);
rectangle(xx+35,115,xx+60,125);
rectangle(xx-80,115,xx-30,125);
rectangle(xx-70,105,xx-20,115);
rectangle(xx-70,125,xx-20,135);
ellipse(xx-40,100,xx+40,140);
line(xx+80,115,xx+100,120);
line(xx+80,125,xx+100,120);
circle(xx+70,120,15);
floodfill(xx+90,120,clred);
//крылья
setbrushcolor(clgray);
rectangle(xx-20,120,xx+20,120+yy);
setbrushcolor(clblack);
circle(xx+75,120,5);
end;
 
begin
//размер окна
setwindowsize(800,200);
//запрет рисования в гр.окне
lockdrawing;
y:=0;
ky:=-2;
//бесконечный цикл
repeat
x:=-80;
while x<=900 do
    begin
    //очистить экран
    clearwindow(clskyblue);
    //облака
    Oblako(200,50);
    Oblako(450,80);
    //птица
    Ptiza (x,y);
    //вычисление следующих координат
    y:=y+ky;
    //при необходимости - смена направления взмаха крыла
    if (y>50) or (y<-50) then ky:=ky*(-1);
    redraw;
    inc(x,5);
    end;
until false;
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

2
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 20:19 #39
В: Нужен график розы Гранди.
О:
Пятилепестковая роза Гранди
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
uses GraphABC;
begin
  SetWindowSize(800,600);
  Coordinate.Origin := Window.Center; // Координаты начала координат - в центре окна
  Coordinate.SetMathematic;           // устанавливаем обычную математическую систему координат
  line(-400,0,400,0);                 //строим оси координат
  line(0,-300,0,300);
  var a: real :=0;
  var n:=5;
 Repeat
    var r:=2*sin(n*a);             // вычисляем значение функции
      var x:=round(r*100*Cos(a));  // переводим в "экранные"
      var y:=round(r*100*Sin(a));  // координаты и округляем. Деление на 10 позволяет уменьшить радиус
      PutPixel(x,y,ClMaroon);             // рисуем точку на графике
      a:=a+0.001
  until a>=180
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

2
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 20:19 #40
В: Нужна одна из фигур Лиссажу
О:
Кликните здесь для просмотра всего текста
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
uses GraphABC;
begin
SetWindowSize(800,600);
Coordinate.Origin := Window.Center; // Координаты начала координат - в центре окна
Coordinate.SetMathematic; // устанавливаем обычную математическую систему координат
line(-400,0,400,0); //строим оси координат
line(0,-300,0,300);
var a: real :=0;
Repeat
var r:=10; 
var x:=round(r*10*sin(0.995*a)+50*Cos(15.075*a)); // вычисляем функцию и переводим в "экранные"
var y:=round(r*10*cos(0.995*a)+50*Sin(15.075*a)); // координаты и округляем. Деление на 10 позволяет уменьшить радиус
PutPixel(x,y,ClMaroon); // рисуем точку на графике
a:=a+0.001
until a>=45
end.
образец
Полезные коды для PascalABC.NET
1
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 20:19 #41
В: Нужна астроида.
О:
астроида
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
uses GraphABC;
begin
  SetWindowSize(800,600);
  Coordinate.Origin := Window.Center; // Координаты начала координат - в центре окна
  Coordinate.SetMathematic;           // устанавливаем обычную математическую систему координат
  line(-400,0,400,0);                 //строим оси координат
  line(0,-300,0,300);
  var a: real :=0;
 Repeat
    var r:=15;                   
      var x:=round(r*10*Cos(a)*Cos(a)*Cos(a));  // вычисляем функцию, переводим в "экранные"
      var y:=round(r*10*Sin(a)*Sin(a)*Sin(a));  // координаты и округляем. Деление на 10 позволяет уменьшить радиус
      PutPixel(x,y,ClMaroon);             // рисуем точку на графике
      a:=a+0.001
  until a>=180
end.
образец
Полезные коды для PascalABC.NET
2
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 20:19 #42
В: Нужна кардиоида.
О:
кардиоида
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
uses GraphABC;
begin
  SetWindowSize(800,600);
  Coordinate.Origin := Window.Center; // Координаты начала координат - в центре окна
  Coordinate.SetMathematic;           // устанавливаем обычную математическую систему координат
  line(-400,0,400,0);                 //строим оси координат
  line(0,-300,0,300);
  var a: real :=0;
 Repeat
    var r:=12*(1-cos(a));             // вычисляем значение функции
      var x:=round(r*10*Cos(a));  // переводим в "экранные"
      var y:=round(r*10*Sin(a));  // координаты и округляем. Деление на 10 позволяет уменьшить радиус
      PutPixel(x,y,ClMaroon);             // рисуем точку на графике
      a:=a+0.001
  until a>=360
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

2
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 22:47 #43

Не по теме:

лирическое отступление
всякий раз, открывая справку по цветам Pabc.NET, содрогаюсь: сейчас придется напрячь знание английского и воображение, чтобы подобрать из всего многообразия цветов те, что наиболее подходят для решения поставленной задачи... результатом одного из визитов в справку стала эта программа. ..в идеале, конечно, следовало сделать вывод в какой-нибудь label или копирование в буфер обмена.. но руки не дошли)


В: Как наглядно сопоставить названия цветов в Pabc.NET с их образцами?
О:
Палитра - справочник цветов Pabc.NET
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
53
54
55
56
57
58
59
60
61
uses graphABC;
//массив цветов 
const col: array [1..10,1..14] of color=
      ((clAquamarine,     clBisque,       clBlue,                 clBurlyWood,      clChocolate,        clCornsilk,       clDarkBlue,       clDarkGray,         clDarkMagenta,    clDarkOrchid,     clDarkSeaGreen,         clDarkViolet,     clDeepSkyBlue,    clFirebrick     ),
       (clFuchsia,        clGold,         clGreen,                clHotPink,        clIvory,            clLavenderBlush,  clLightBlue,      clLightGray,        clLightPink,      clLightSkyBlue,   clLightYellow,          clLinen,          clMediumBlue,     clMediumPurple  ),
       (clMoneyGreen,     clNavy,         clMediumSpringGreen,    clMediumTurquoise,clOliveDrab,        clOrchid,         clPaleTurquoise,  clPeachPuff,        clMediumVioletRed,clRed,            clSaddleBrown,          clSeaGreen,       clSilver,         clSlateGray     ),
       (clSteelBlue,      clThistle,      clTurquoise,            clWhite,          clYellowGreen,      clAzure,          clBlack,          clBlueViolet,       clCadetBlue,      clCoral,          clCrimson,              clDarkCyan,       clDarkGreen,      clDarkOliveGreen),
       (clDarkRed,        clDarkSlateBlue,clDeepPink,             clDimGray,        clFloralWhite,      clGainsboro,      clGoldenrod,      clGreenYellow,      clIndianRed,      clKhaki,          clLawnGreen,            clLightCoral,     clLightGreen,     clLightSalmon   ),
       (clLightSlateGray, clLime,         clMagenta,              clMediumOrchid,   clMediumSeaGreen,   clPlum,           clMidnightBlue,   clMoccasin,         clOldLace,        clOrange,         clPaleGoldenrod,        clPaleVioletRed,  clPeru,           clPowderBlue    ),
       (clRosyBrown,      clSalmon,       clSeaShell,             clSkyBlue,        clSnow,             clTan,            clTomato,         clViolet,           clWhiteSmoke,     clBeige,          clBlanchedAlmond,       clBrown,          clChartreuse,     clCornflowerBlue),
       (clCyan,           clDarkGoldenrod,clDarkKhaki,            clDarkOrange,     clDarkTurquoise,    clDarkSlateGray,  clDarkSalmon,     clDodgerBlue,       clForestGreen,    clGhostWhite,     clGray,                 clHoneydew,       clIndigo,         clLavender      ),
       (clLemonChiffon,   clLightCyan,    clLightGoldenrodYellow, clLightSeaGreen,  clLightSteelBlue,   clLimeGreen,      clMaroon,         clMediumAquamarine, clMediumSlateBlue,clMistyRose,      clMintCream,            clNavajoWhite,    clOlive,          clOrangeRed     ),
       (clPaleGreen,      clPapayaWhip,   clPink,                 clPurple,         clRoyalBlue,        clSandyBrown,     clSienna,         clSlateBlue,        clSpringGreen,    clTeal,           clTransparent,          clWheat,          clYellow,         clYellow        ));
//массив названий цветов
textcol: array [1..10,1..14] of string=
      (('clAquamarine',     'clBisque        ','clBlue                 ','clBurlyWood      ','clChocolate        ','clCornsilk       ','clDarkBlue       ','clDarkGray         ','clDarkMagenta    ','clDarkOrchid     ','clDarkSeaGreen         ','clDarkViolet     ','clDeepSkyBlue    ','clFirebrick'     ),
       ('clFuchsia',        'clGold          ','clGreen                ','clHotPink        ','clIvory            ','clLavenderBlush  ','clLightBlue      ','clLightGray        ','clLightPink      ','clLightSkyBlue   ','clLightYellow          ','clLinen          ','clMediumBlue     ','clMediumPurple'  ),
       ('clMoneyGreen',     'clNavy          ','clMediumSpringGreen    ','clMediumTurquoise','clOliveDrab        ','clOrchid         ','clPaleTurquoise  ','clPeachPuff        ','clMediumVioletRed','clRed            ','clSaddleBrown          ','clSeaGreen       ','clSilver         ','clSlateGray'     ),
       ('clSteelBlue',      'clThistle       ','clTurquoise            ','clWhite          ','clYellowGreen      ','clAzure          ','clBlack          ','clBlueViolet       ','clCadetBlue      ','clCoral          ','clCrimson              ','clDarkCyan       ','clDarkGreen      ','clDarkOliveGreen'),
       ('clDarkRed',        'clDarkSlateBlue ','clDeepPink             ','clDimGray        ','clFloralWhite      ','clGainsboro      ','clGoldenrod      ','clGreenYellow      ','clIndianRed      ','clKhaki          ','clLawnGreen            ','clLightCoral     ','clLightGreen     ','clLightSalmon'   ),
       ('clLightSlateGray', 'clLime          ','clMagenta              ','clMediumOrchid   ','clMediumSeaGreen   ','clPlum           ','clMidnightBlue   ','clMoccasin         ','clOldLace        ','clOrange         ','clPaleGoldenrod        ','clPaleVioletRed  ','clPeru           ','clPowderBlue'    ),
       ('clRosyBrown',      'clSalmon        ','clSeaShell             ','clSkyBlue        ','clSnow             ','clTan            ','clTomato         ','clViolet           ','clWhiteSmoke     ','clBeige          ','clBlanchedAlmond       ','clBrown          ','clChartreuse     ','clCornflowerBlue'),
       ('clCyan',           'clDarkGoldenrod ','clDarkKhaki            ','clDarkOrange     ','clDarkTurquoise    ','clDarkSlateGray  ','clDarkSalmon     ','clDodgerBlue       ','clForestGreen    ','clGhostWhite     ','clGray                 ','clHoneydew       ','clIndigo         ','clLavender'      ),
       ('clLemonChiffon',   'clLightCyan     ','clLightGoldenrodYellow ','clLightSeaGreen  ','clLightSteelBlue   ','clLimeGreen      ','clMaroon         ','clMediumAquamarine ','clMediumSlateBlue','clMistyRose      ','clMintCream            ','clNavajoWhite    ','clOlive          ','clOrangeRed'     ),
       ('clPaleGreen',      'clPapayaWhip    ','clPink                 ','clPurple         ','clRoyalBlue        ','clSandyBrown     ','clSienna         ','clSlateBlue        ','clSpringGreen    ','clTeal           ','clTransparent          ','clWheat          ','clYellow         ','clYellow'        ));
 
//процедура рисования образца цвета
procedure usecolor(x,y: integer; c: color);
begin
setbrushcolor(c);
rectangle(x-40,y+40,x,y);
setbrushcolor(clwhite);
end;
//обработчик нажатия кнопки мыши
procedure MouseDown(x,y,mb: integer);
begin
   if (mb=1) and (x>40) and (x<600) and (y>40) and (y<440) then  //если нажата левая кнопка в заданных координатах - вывод соответствующего значения
    begin
    //стираем прошлое значение, выводим новое
    setbrushcolor(clwhite);
    rectangle(0,460,640,550);
    textout(50,460,textcol[y div 40,x div 40]);
    end;
   if (mb=2) then closewindow; //если правая кнопка - закрять окно
end;
 
begin
//размер и заголовок окна
setwindowsize(640,550);
window.Caption:='ЗНАЧЕНИЯ ЦВЕТОВ     (1рПК-выход)';
setpencolor(clwhite);
//параметры шрифта
setfontsize(40);
setfontname('Tachoma');
//в цикле рисуем образцы цвета
for var j:=1 to 10 do
  for var i:=1 to 14 do
      usecolor(i*40+40,j*40,col[j,i]);
 
OnMouseDown := MouseDown;
end.
образец
Полезные коды для PascalABC.NET
4
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 22:47 #44
В: Нужна анимация: шарик меняет направление по щелчку мыши.
О:
Сильно хитрый бильярдный шар
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
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
uses graphABC;
var x,y,kx,ky: integer;
 
//процедура рисования кнопок
procedure keys;
begin
setbrushcolor(clwhite);
rectangle(200,150,240,190);
rectangle(260,150,300,190);
rectangle(200,210,240,250);
rectangle(260,210,300,250);
setpenwidth(4);
//левая верхняя стрелка
line(210,160,230,180);
line(210,160,210,170);
line(210,160,220,160);
//правая верхняя стрелка
line(290,160,270,180);
line(290,160,290,170);
line(290,160,280,160);
//левая нижняя стрелка
line(230,220,210,240);
line(210,240,210,230);
line(210,240,220,240);
//правая нижняя стрелка
line(270,220,290,240);
line(290,240,290,230);
line(280,240,290,240);
setpenwidth(1);
end;
//процедура рисования фона - бильярдный стол
procedure Fon;
begin
clearwindow;
setbrushcolor(clbrown);
rectangle(10,10,490,390);
setbrushcolor(clgreen);
rectangle(20,20,480,380);
setbrushcolor(clbrown);
keys;
end;
//обработка нажатия кнопки мыши
procedure MouseDown(x,y,mb: integer);
begin
  if mb=1 then //если левая кнопка
     begin
     if (x>200) and (x<240) and (y>150) and (y<190) then 
        begin
        kx:=-1; ky:=-1;
        end;
     if (x>260) and (x<300) and (y>150) and (y<190) then
        begin
        kx:=1; ky:=-1;
        end;
     if (x>200) and (x<240) and (y>210) and (y<250) then
        begin
        kx:=-1; ky:=1;
        end;
     if (x>260) and (x<300) and (y>210) and (y<250) then
        begin
        kx:=1; ky:=1;
        end;
     end;
end;
//процедура рисования шарика
procedure Shar(var xx,yy,kkx,kky: integer);
begin
if (xx<30) or (xx>470) then kkx:=kkx*(-1);
if (yy<30) or (yy>370) then kky:=kky*(-1);
xx:=xx+kkx;
yy:=yy+kky;
setbrushcolor(clwhite);
circle(xx,yy,10);
end;
 
begin
lockdrawing;
Fon;
//обработчик нажатия
OnMouseDown:=MouseDown;
x:=250;
y:=200;
//бесконечный цикл
repeat
Fon;
Shar(x,y,kx,ky);
sleep(10);
redraw;
until false;
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

4
КонецСвета
Почетный модератор
7924 / 3894 / 940
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 22:47 #45
В: Нужна программа, где автомобиль движется по нажатию клавиш на клавиатуре.
Движение автомобиля по нажатию клавиш --> <--.
О:
Кликните здесь для просмотра всего текста
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
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
uses graphABC;
 
var x0:integer;
 
//процедура рисования фона
procedure Fon;
begin
clearwindow(clskyblue);
setpencolor(clgreen);
setbrushcolor(clgreen);
rectangle(0,420,900,600);
//дорога
setpencolor(clgray);
setbrushcolor(clgray);
rectangle(0,450,900,550);
setpencolor(clyellow);
setbrushcolor(clyellow);
circle(800,100,50);
end;
//процедура рисования колес
procedure Koleso(xk1,yk1,xk2,yk2,uu: integer);
var r,i:integer;
    u:real;
begin
r:=15;u:=uu;
setbrushcolor(clblack);
setpencolor(clblack);
circle(xk1,yk1,r+10);
circle(xk2,yk2,r+10);
setbrushcolor(clwhite);
circle(xk1,yk1,r);
circle(xk2,yk2,r);
for i:=1 to 4 do
    begin
    line(xk1,yk1,xk1+round(r*cos(u)),yk1-round(r*sin(u)));
    line(xk2,yk2,xk2+round(r*cos(u)),yk2-round(r*sin(u)));
    u:=u+(pi/2);
    end;
end;
//процедура рисования автомобиля
procedure Auto(x: integer);
var uu: integer;
begin
    uu:=-(x mod 100);
    setpenwidth(3);
    setpencolor(clred);
    setbrushcolor(clred);
    ellipse(x-100,350,x+100,450);
    setbrushcolor(clwhite);
    ellipse(x-90,360,x+90,440);
    setpencolor(clred);
    setbrushcolor(clred);
    rectangle(x-150,400,x+150,450);
    rectangle(x-10,355,x+10,450);
    Koleso(x-100,450,x+100,450,uu);
    redraw;
end;
//обработка нажатия клавиш
procedure KeyDown(Key: integer);
begin
  case Key of
       VK_Left: if x0>200 then x0:=x0-2;
       VK_Right: if x0<700 then x0:=x0+2;
  end;
  clearwindow;
  Fon;
  Auto(x0);
end;
 
//основная программа
begin
//запрет на рисование в рабочем окне
lockdrawing;
//размер окна
setwindowsize(900,600);
//начальное значение позиции авто
x0:=200;
Fon;
Auto(x0);
OnKeyDown:=KeyDown;
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

небольшое послесловие
большая часть работ сделана изначально под Pabc и, следовательно, совместима с ним при небольшой переделке)

2
15.06.2013, 22:47
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
15.06.2013, 22:47
Привет! Вот еще темы с ответами:

Надо найти библиотеку для PascalABC NET - PascalABC.NET
Всем привет. Вот сейчас пишу движок для PascalABC NET. Для графики взял OpenGL. Теперь начал делать обработчик событий нажатий клавиш и тут...

Написать программу из задачника среды PascalABC.NET для задания integer8: - PascalABC.NET
Написать программу из задачника среды PascalABC.NET для задания integer8: Потрудитесь выложить задание должным образом оформленное, и с...

Установится ли PascalABC.NET на систему, где установлен только .NET 4.6.1? - PascalABC.NET
Привет всем. Вопрос, собственно, озвучен выше. Конкретнее: есть компьютер со свежеустановленной Win10 x64, на которой присутствует...

Переделайте "Старт ракеты" для PascalABC.net - PascalABC.NET
uses graph,crt; procedure raketa(x,y,c:integer); begin setcolor(c); line(x,y,x-10,y+10); line(x,y,x+10,y+10); ...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
45
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru