Форум программистов, компьютерный форум, киберфорум
Наши страницы
PascalABC.NET
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.97/985: Рейтинг темы: голосов - 985, средняя оценка - 4.97
BaboshinSD
336 / 275 / 49
Регистрация: 15.11.2012
Сообщений: 477
Записей в блоге: 1
1

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

23.03.2013, 15:03. Просмотров 182854. Ответов 121

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

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


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


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

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

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

Модуль для PascalABC.NET
Здравствуйте уважаемые форумчане, возник вопрос почему не работает модуль. ...

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

Исправить код для PascalABC.net
как минимум, первое место которое ему не нравиться это как я обьявляю тип...

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

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

121
BaboshinSD
336 / 275 / 49
Регистрация: 15.11.2012
Сообщений: 477
Записей в блоге: 1
21.04.2013, 16:19  [ТС] 21
Цитата Сообщение от Ragnazar Посмотреть сообщение
без var в описании не будет работать
Вот с "var", без него такой ошибки нет.
0
Миниатюры
Полезные коды для PascalABC.NET  
Ragnazar
37 / 37 / 13
Регистрация: 09.03.2013
Сообщений: 114
Записей в блоге: 2
31.05.2013, 15:45 22
PictureBox.Load('Image.png') это конечно легко
Но носить все используемые картинки вне exe'шника это лишнее
Ведь PascalABC.NET использует .NET, а в .NET есть ресурсы добавляющиеся в сам файл!
Важно положить картинку рядом с файлом что-бы компилятор знал что в себя пихать
В: Как использовать картинку не копируя её к файлу?
О: Используйте ресурсы!
Директива resource
Pascal
1
2
3
4
5
{$resource MyImage.png} //Загружаем картинку в ресурсы
var MyImage:System.drawing.Image;
begin
MyImage:=Image.FromStream(GetResourceStream('MyImage.png')); //Пользуемся картинкой
end.
Viola!
Если более углубляться в технику, то можно понять что директива {$resource }
Создает поток с графическими файлами (Возможно и с текстовыми, но на офф сайте написано что только графика)
Соответственно их этого потока вы можете вытаскивать то, что вам нужно тем, чем вам нужно.
P.S. GetResourceStream возвращает System.IO.Stream
P.P.S Если кому хочется мороки, можете использовать System.Reflection.Assembly.GetEntryAssembly().GetManifestResourceStream(String)


И раз уж зашла речь про ресурсы и картинки то
В: Как поставить на каждую форму свою иконку?
О: Ресурсы-же!
Достаем иконку из потока
Pascal
1
2
3
4
5
6
7
8
9
{$resource Icon.ico} //Сначала конечно загрузим её
var 
MyIcon:System.drawing.Icon;
MyForm:System.windows.forms.form;
begin
MyForm:=new Form; //Обозначим форму
MyIcon:=new Icon(GetResourceStream('MyImage.png')); //Достанем иконку
MyForm.Icon:=MyIcon; //Поставим иконку
System.windows.forms.Application.run(MyForm); //Запустим форму
Viola!
Но заметьте, иконка приложения не сменилась, сменилась иконка только у формы для того что-бы сменить иконку приложения
Используйте инструкция из топика Как установить свою иконку приложения?
5
BaboshinSD
02.06.2013, 10:49  [ТС]
  #23

Не по теме:

Ragnazar, действительно полезные примеры, прикрепил в шапке.

0
Ragnazar
37 / 37 / 13
Регистрация: 09.03.2013
Сообщений: 114
Записей в блоге: 2
08.06.2013, 18:51 24
В: Как убрать программу с чёрным окошечком, скомпилированную в PascalABC.NET?
О:
Убираем окно консоли
Если твое приложение имеет интерфейс (Кнопки, окошки) то в самое начало файла добавь строчку
{$apptype windows}
Это директива компилятору, что твое приложение использует окна и консоль ненужна
{$apptype console}
Сообщает что консоль нужна
1
Ragnazar
37 / 37 / 13
Регистрация: 09.03.2013
Сообщений: 114
Записей в блоге: 2
09.06.2013, 09:33 25
BaboshinSD, Насчет "Делаем форму круглой (или любой другой формы)"
Там вы используете
Pascal
1
2
MainForm.BackColor := Color.HotPink
MainForm.TransparencyKey := Color.HotPink
А не проще ли
Pascal
1
MainForm.TransparencyKey := MainForm.BackColor
?
0
AltTwo
5 / 1 / 2
Регистрация: 13.06.2013
Сообщений: 20
13.06.2013, 21:45 26
В: возможно ли сделать подобие браузера на pascalabc.NET
О:
Кликните здесь для просмотра всего текста

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
#apptype windows
#reference 'System.Windows.Forms.dll'
uses
  System, 
  System.Windows.Forms,
  System.Net;
var w := new WebBrowser;
var bbr := new Form;
begin
w.Url := new System.Uri('http://www.google.ru/');
w.Dock := Dockstyle.Fill;
bbr.Controls.Add(w);
Application.Run(bbr);
end.
Подобным образом можно создавать "проводник" по отдельной папке: адрес должен иметь вид file:///путь к папке
0
Striker
Ведущий программист C#
240 / 219 / 154
Регистрация: 19.08.2012
Сообщений: 498
Записей в блоге: 1
14.06.2013, 08:03 27
AltTwo, Только правильнее будет писать вот так:

Кликните здесь для просмотра всего текста
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
{$apptype windows}
{$reference 'System.Windows.Forms.dll'}
uses
  System, 
  System.Windows.Forms,
  System.Net;
 
var
  w := new WebBrowser;
 
var
  bbr := new Form;
 
begin
  w.Url := new System.Uri('http://www.google.ru/');
  w.Dock := Dockstyle.Fill;
  bbr.Controls.Add(w);
  Application.Run(bbr);
end.


Т.к. Директивы компилятора в стиле # более не поддерживаются.
3
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 15:43 28
В: Нужен рисунок кота.
О:
мордашка кота
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 graphABC;
begin
//размер окна
setwindowsize(600,500);
//ушки
setbrushcolor(clGray);
Ellipse(320,30,490,400);
Ellipse(120,30,300,400);
setbrushcolor(clBisque);
Ellipse(335,40,480,380);
Ellipse(140,40,280,380);
//голова
setbrushcolor(clGray);
Ellipse(100,430,500,130);
//глаза
setbrushcolor(clNavy);
Ellipse(250,240,200,310);
Ellipse(350,240,400,310);
setbrushcolor(clwhite);
Ellipse(240,270,220,300);
Ellipse(360,270,380,300);
//мордочка 
setbrushcolor(clblack);
Ellipse(270,330,330,370);
line(300,370,300,400);
Arc(300,280,120,220,320);
// усы
line(50,350,200,350);
line(30,340,190,340);
line(10,330,180,330);
 
line(410,330,570,330);
line(400,340,560,340);
line(390,350,550,350);
//брови 
line(240,230,220,150);
line(230,230,180,80);
line(220,230,180,150);
 
line(360,230,380,150);
line(370,230,430,80);
line(380,230,430,150);
 
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

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

2
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 15:43 29
В: Нужен рисунок шахматной доски.
О:
шахматная доска, ленивый вариант
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
uses graphabc;
var i,j: byte;
 
begin
setwindowsize(400,400);
for i:=1 to 8 do
  for j:=1 to 8 do
   //если счетчик для i и для j четен, или и тот и другой нечетны одновременно - черная клетка 
   if (odd(i) and odd(j)) 
    or ((not (odd(i))) and (not (odd(j)))) then
      begin
      setbrushcolor(clblack);
      rectangle(i*50-50,j*50-50,i*50,j*50);
      end;
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

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

1
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 30.10.2011
Сообщений: 5,379
15.06.2013, 15:43 30
В: Нужен рисунок кролика.
О:
кролик и морковка
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;
begin
//размер окна
setwindowsize(500,400);
 
setbrushcolor(clgray);
//хвост
circle(450,300,20);
//тело
ellipse(250,200,450,350);
//уши
ellipse(190,50,250,200);
ellipse(260,50,320,200);
 
setbrushcolor(clsilver);
ellipse(200,60,240,200);
ellipse(270,60,310,200);
//лапки и голова
setbrushcolor(clgray);
circle(260,210,70);
circle(260,340,25);
circle(300,340,25);
circle(410,320,45);
ellipse(350,370,440,340);
//мордочка
setbrushcolor(clsilver);
circle(275,240,20);
circle(235,240,20);
setbrushcolor(clblack);
circle(255,230,10);
//глаза
setbrushcolor(clwhite);
circle(280,200,15);
circle(230,200,15);
setbrushcolor(clblack);
circle(275,200,7);
circle(225,200,7);
//морковь
line(20,150,80,350);
line(150,150,80,350);
line(20,150,150,150);
floodfill(80,200,clred);
line(20,20,60,150);
line(160,20,120,150);
line(20,20,82,100);
line(160,20,80,100);
floodfill(80,140,clgreen);
end.
образец
Полезные коды для PascalABC.NET

Не по теме:

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

2
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 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
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 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
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 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
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 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
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 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 и, следовательно, совместима с ним при небольшой переделке)

3
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 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
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 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
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 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
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 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
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
КонецСвета
Почетный модератор
7930 / 3901 / 2464
Регистрация: 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:=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
15.06.2013, 20:19
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
15.06.2013, 20:19

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

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

Ошибка при создании меню в PascalABC.net для игры
ПОМОГИТЕ СРОЧНО!Я хочу заключить процедуры в одну процедуру для меню, для того...


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

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

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