|
Pers.narod.ru. Программы. SuperBubs |
Эта небольшая программка генерирует футуристические зады. Точней, все зависит от
интерпретации - при доле фантазии их можно счесть пузырями жвачки или мыльной пеной.
Панель справа позволяет управлять параметрами генератора. Переменная "Шаг" задает размер элемента изображения (от 1 пиксела до 9), очевидно, что наилучшее качесто достигается при шаге=1. Переменная "Количество" определяет общее число сфер, оно может изменяться от 1 до 99 включительно. Назначение кнопок "Рисовать" и "Выход" понятно, а "Сохранить" позволяет увековечить получившийся шедевр в формате BMP. Размер окна программы можно менять произвольно, однако, для обеспечения лучшего быстродействия в исходнике стоит ограничение на максимальный размер, равное 800*600 пикселов. Это непринципиально, можно изменить и перекомпилировать. Кстати, написана программа на старом добром Delphi 3. Я не вижу смысла стрелять из пушки по воробьям, используя сверхмощные среды разработки там, где задача этого не требует.
Под бегунком, показывающим прогресс генерации очередного рисунка и текстовой меткой, выводящей его линейные размеры, находятся еще 3 поля, предназначенные для управления коэффициентами преобразования красной, зеленой и синей цветовых компонент. В исходнике нетрудно заметить, как используются эти коэффициенты, а также то, что их легко поменять и поэкспериментировать.
Основная идея приложения тривиальна - мы генерируем Kol случайных центров на канве, а затем для каждой точки канвы выбираем ближайший к ней центр, уменьшая интенсивность цветов в этой точке на величины, прямо зависящие от расстояния до этого ближайшего центра. Вот исходник процедуры, выполняющей всю работу:
procedure TForm1.Button1Click(Sender: TObject); //Кнопка Рисовать
var BitMap1 : TBitMap;
var xMax,yMax:Integer; //Размеры канвы
kol,step:Integer; //Количество и шаг с формы
xc,yc: Array [1..99] of Real; //Массивы экранных координат
var k,x,y,Red,Green,Blue:Integer; all:longint;
rmin,r,rCoef,gCoef,bCoef:real;
Color1:TColor;
begin
//Размеры рисунка:
xMax:=Image1.Width;
yMax:=Image1.Height;
Image1.SetBounds (0,0,xMax,yMax);
BitMap1 := TBitMap.Create;
Bitmap1.Width := xMax;
Bitmap1.Height := yMax;
Image1.Picture.Graphic := Bitmap1; //Иначе не будет нормально масштабироваться
//Коэффициенты преобразования цвета:
rCoef:=1+(Scrollbar3.Position-1)*0.1; //1 по умолч.
gCoef:=1+(Scrollbar4.Position-1)*0.1; //1.3 по умолч.
bCoef:=1+(Scrollbar5.Position-1)*0.1; //1.1 по умолч.
//Шаг и количество сфер:
step:=ScrollBar1.Position;
kol:=ScrollBar2.Position;
For k:=1 to kol do begin //Инициализация массивов
xc[k]:=Random * xMax;
yc[k]:=Random * yMax;
end;
ProgressBar1.Position:=0;
ProgressBar1.Max:=(xmax div step)*(ymax div step);
all:=0; //2 строки - только для бегунка прогресса
x:=0;
while x<xmax do begin //Для каждой точки рисунка
y:=0;
while y<ymax do begin
rmin:=32767;
For k:=1 to kol do begin //Нужны расстояния до всех центров, чтоб выбрать ближайший
r:=sqrt(sqr(xc[k]-x)+sqr(yc[k]-y));
if r<rmin then rmin:=r;
end;
Red:=Round(255-rmin*rCoef); //определяем интенсивности цветов
Diap (Red,0,255); //ограничить диапазоном [0,255]
Green:=Round(255-rmin*gCoef);
Diap (Green,0,255);
Blue:=Round(255-rmin*bCoef);
Diap (Blue,0,255);
Color1:=StringToColor(
'$00'+IntToHex(Red,2)+IntToHex(Green,2)+IntToHex(Blue,2));
If step>1 Then begin
Image1.Canvas.Brush.Color:=Color1; //формируем цвет
Image1.Canvas.FillRect(Rect(x,y,x+step,y+step)); //и рисуем
end
else if step=1 then begin
Image1.Canvas.Pen.Color:=Color1;
Image1.Canvas.Pixels[x,y]:=Color1;
end;
Inc(y,step);
//ниже - только для бегунка прогресса
Inc(all);
if all mod 10=0 then ProgressBar1.Position:=ProgressBar1.Position+10;
end;
Inc(x,step);
end;
Bitmap1.Free;
end;
Скриншоты:
размер окна по умолчанию, количество сфер=2 :-)
здесь увеличено число сфер
пятипопие с другими настройками цвета :-)
Скачать:
Программа SuperBubs (архив Superbubs.zip, 122 Кб)
Исходники программы SuperBubs - проект Delphi 3 (архив Superbubs_src.zip, 5 Кб)
Программа написана в ночь на 22.12.2007 с целью отвлечься от проблем :-) Напомню, что некоторое количество других моих программ с исходниками, к которым было лень составлять описания, находится здесь.
|
|