Nickolay.info. Программы. 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 с целью отвлечься от проблем :-) Напомню, что некоторое количество других моих программ с исходниками, к которым было лень составлять описания, находится здесь.
гостевая; E-mail |