Nickolay.info. Программы. SuperBubs

Эта небольшая программка генерирует футуристические зады. Точней, все зависит от интерпретации - при доле фантазии их можно счесть пузырями жвачки или мыльной пеной.
Скриншот окна 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;

Скриншоты:
Рисунок SuperBubs 1
размер окна по умолчанию, количество сфер=2 :-)
Рисунок SuperBubs 2
здесь увеличено число сфер
Рисунок SuperBubs 3
пятипопие с другими настройками цвета :-)

Скачать:
Программа SuperBubs (архив Superbubs.zip, 122 Кб)
Исходники программы SuperBubs - проект Delphi 3 (архив Superbubs_src.zip, 5 Кб)

Программа написана в ночь на 22.12.2007 с целью отвлечься от проблем :-) Напомню, что некоторое количество других моих программ с исходниками, к которым было лень составлять описания, находится здесь.

Рейтинг@Mail.ru
вверх гостевая; E-mail