Информационный сервер для программистов: Исходники со всего света. Паскальные исходники со всего света
  Powered by Поисковый сервер Яndex: Найдется ВСЁ!
На Главную Исходники Форум Информер Страны мира
   Demo Making    >>    flame3
   
 
 Flame 3   Victor Shantar 07.05.1997

Огонечек



1k 
 

{- 4INT ------------------------------------------ It's interesting - Msg : 21 of 110 Addr Date From : Victor Shantar 2:5054/26 07.05.97 Subj : Flame --------------------------------------------------------------------- -=Ё> Привет тебе DENnIS. <Ё=- Однажды (03 May 97) DENnIS PR0nin писал(а) к All, а я вмешался: Dn> Hужно исходник: Dn> Полыхающего пламени с пояснениями алгоpитма! Dn> Плиз Хелп! Hу очень тpеба! Вот тебе огонечек Покедова... -=Ё> Пишите письма. Они дойдут ( в обоих смыслах ;) <Ё=- ... [ HEDGEHOG HOUSE ] +7-3422-622044,PERM [ Team Daemon's Hedgehog ] --- Work Time 01:00-07:00 Local. Freq ONLY [ Team Coca-Cola ] * Origin: ~Для кого ночь, а для кого - темное время суток.~ (2:5054/26) {> Cut here. FileName= FLAME3.PAS } { Огонек } uses crt; var ftable : array [1..30,1..60] of byte; { Массив области с огонечком } x,y,i : word; { Координаты и просто переменная для циклов } v:integer; { переменная для инициализации графики } { Установка цветов } procedure SetPalette; var N : Integer; procedure SetRGBColor(color,r,g,b: Byte); Assembler; asm mov dx,3C8h mov al,color out dx,al inc dx mov al,r out dx,al mov al,g out dx,al mov al,b out dx,al end; { Функция вычисления цвета в зависимости от коэфициента X } function f(x:real):integer; begin if (x>=0) and (x<=1) then f:=round(63*x*(2-x)); if x<0 then f:=0; if x>1.0 then f:=63; end; begin {SetPalette} for N := 1 to 100 do setrgbcolor(n,f(n/50),f(n/50-0.2), f(n/50-0.5)+f(0.1-n/50)*n div 7+5); { Установка цветовой палитры : SetRGBColor( num, Red, Green, Blue ); где num - номер за которым сохранить этот цвет. Red - кол-во красного ( 0-63 ) Green - кол-во зеленого ( 0-63 ) Blue - кол-во синего ( 0-63 ) } end; begin asm mov ax,13h; int 10h end; { Установка режима 320x200x256 } setpalette; { Установка нашего набора цветов } { Обнуление массива с огоньком } for x:=1 to 30 do for y:=1 to 60 do ftable[x,y]:=0; repeat { Рисование исходной линии ( самой нижней ) } for x:=10 to 20 do if random(100)<50 then ftable[x,60]:=100 else ftable[x,60]:=0; { За счет резкого случайного перепада цвета идет колебание огонька } { Изменение цвета точки, в зависимости от точек снизу и с боков } for y:=1 to 59 do for x:=2 to 28 do { ахождение среднего цвета относительно 9-ти точек } ftable[x,y]:=(ftable[x-1, y ]+ftable[ x , y ]+ftable[x+1, y ]+ ftable[x-1,y+1]+ftable[ x ,y+1]+ftable[x+1,y+1]+ ftable[x-1,y+2]+ftable[ x ,y+2]+ftable[x+1,y+2]) div 9; { Вывод массива } for y:=1 to 57 do for x:=1 to 30 do mem[$a000:x+144+(y+69)*320]:=ftable[x,y]; until keypressed; asm mov ax,3; int 10h end; end.