IPB
ЛогинПароль:

> Внимание!

Давайте пожалуйста своим демо названия!
В названии темы указывайте название!

 
 Ответить  Открыть новую тему 
> Заставка. Снег.
Alesha_GA
сообщение 19.05.2003 3:19
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 56
Пол: Мужской

Репутация: -  0  +


Писалось к новому году.  :D

Код
program god;
uses graph,crt,snegmod;
const
sn=630;
var
mass:array[1..sn] of sneg;
d,r,k,ll,i,f:integer;
begin
d:=Detect;
initgraph(d,r,'');
k:=graphresult;
if k<>grok then
writeln(GraphErrorMsg(k))
ELSE
begin
k:=0;
f:=0;
ll:=0;
for i:=1 to sn do mass[i].kk:=0;
repeat
for i:=1 to sn do
 begin
 if ll=0 then
begin
 if (mass[i].kk=0) then
  begin
  f:=mass[i].start(f);
  k:=mass[i].k;
  mass[i].kk:=1;
  if k=1 then ll:=20;
  end else
  begin
  mass[i].engine;
  end;
end else
 begin
 for d:=1 to sn do
 begin
 mass[d].engine;
 end;
 ll:=ll-1;
 end;
 end;
until keypressed;
end;
closegraph;
end.


Код

unit snegmod;
interface
uses graph,crt;
type
sneg=object
k,kk,x1,y1,ll,f:integer;
constructor init;
function start(y0:integer):integer;
procedure engine;
end;
implementation
constructor sneg.init;
begin
line(x1+4,y1,x1+1,y1);
line(x1-4,y1,x1-1,y1);
line(x1,y1+4,x1,y1+1);
line(x1,y1-4,x1,y1-1);
line(x1+1,y1+1,x1+3,y1+3);
line(x1+1,y1-1,x1+3,y1-3);
line(x1-1,y1-1,x1-3,y1-3);
line(x1-1,y1+1,x1-3,y1+3);
end;
function sneg.start(y0:integer):integer;
var smesh:integer;
begin
k:=0;
smesh:=random(4);
y1:=5;
x1:=y0+smesh+4;
if (y0+smesh+9)>getmaxx then begin k:=1; start:=0; end else
begin
start:=y0+20+random(10);
end;
sneg.init;
kk:=1;
end;
procedure sneg.engine;
begin
ll:=random(5);
if kk=1 then begin
if y1<(getmaxy) then begin
setwritemode(xorput);
sneg.init;
setwritemode(copyput);
case ll of
0:begin y1:=y1+1; x1:=x1-2;end;
1:begin y1:=y1+1; x1:=x1-1;end;
2:begin y1:=y1+2; x1:=x1;end;
3:begin y1:=y1+1; x1:=x1+1;end;
4:begin y1:=y1+1; x1:=x1+2;end;
end;
sneg.init;
end else kk:=0;
end;
end;
end.


--------------------
Deleting...

All RESET
[Return]
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Alesha_GA
сообщение 17.07.2003 4:21
Сообщение #2


Пионер
**

Группа: Пользователи
Сообщений: 56
Пол: Мужской

Репутация: -  0  +


Кому-то помнится хотелось дождя. Вот вам дождь:

Прога остаётся таже. В модуле меняется содержание constructor sneg.init;
На:
Код
begin
line(x1,y1-4,x1,y1+4);
end;

smile.gif
Позже будет на новом движке.


--------------------
Deleting...

All RESET
[Return]
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
**KONDOR**
сообщение 25.02.2005 23:55
Сообщение #3


Гость






У меня какая-то ошибка... не найден файл SNEGMOD.TPU. Что за глюк??? angry.gif
 К началу страницы 
+ Ответить 
Altair
сообщение 26.02.2005 0:06
Сообщение #4


Ищущий истину
******

Группа: Модераторы
Сообщений: 4 824
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


смотри первый пост. я его подправил. там 2 программы. Модуль и сама программа.
Скомпилируй мдуль сначала.


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Гость
сообщение 9.01.2009 19:51
Сообщение #5


Гость






что делает модуль в данном случае?*
 К началу страницы 
+ Ответить 
Lapp
сообщение 9.01.2009 22:24
Сообщение #6


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(Гость @ 9.01.2009 19:51) *
что делает модуль в данном случае?*
Практически бОльшую часть основной работы. Рисует снежинки, и не только. Сам посмотри, он же есть в первом посте.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Гость
сообщение 10.01.2009 3:38
Сообщение #7


Гость






спасибо, я уже разобрался, как избавиться от проблемы наложения(когда снежинки пересекаются функция их не затирает и оставляет следы)
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 28.03.2024 14:50
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"