Logo Море(!) аналитической информации!
IT-консалтинг Software Engineering Программирование СУБД Безопасность Internet Сети Операционные системы Hardware
VPS/VDS серверы. 30 локаций на выбор

Серверы VPS/VDS с большим диском

Хорошие условия для реселлеров

4VPS.SU - VPS в 17-ти странах

2Gbit/s безлимит

Современное железо!

Бесплатный конструктор сайтов и Landing Page

Хостинг с DDoS защитой от 2.5$ + Бесплатный SSL и Домен

SSD VPS в Нидерландах под различные задачи от 2.6$

✅ Дешевый VPS-хостинг на AMD EPYC: 1vCore, 3GB DDR4, 15GB NVMe всего за €3,50!

🔥 Anti-DDoS защита 12 Тбит/с!

2005 г.

Градиентная фантазия

Сергей Галездинов, «Королевство Delphi»

Вступление.

Частенько приходится задумываться над тем, на сколько скуден стандартный интерфейс, насколько он безжизненнен (я не говорю про ХР - там все меняется к лучшему, но и там есть ляпы). Хочется сделать что-нибудь эдакое, грандиозное, чтобы глаз радовался. Представляю на ваш суд один из инструментов, который позволит скрасить серые будни программиста. Статья не претендует на фундаментальность - это просто зарисовка, эскиз к вашим будущим работам. Итак, начнем.

Немного теории.

Все цвета в двоичном коде представляются в виде трехбайтовых (или более) последовательностей. Есть различные схемы представления цвета - RGB, HLS, CMYK и некоторые другие, (например OpenGL) которые используются исключительно в системах компьютерной графики, нас они не очень интересуют. Итак, все по порядку. RGB (Red, Green, Blue) представляет цвет следующим образом: это трех байтовая последовательность вида $GGBBRR. Каждый байт представляет определенный оттенок (от 0 до 255) цветов: красный, зеленый, синий. Например, $FF0000 означает чистый синий цвет полной интенсивности, $00FF00 - чистый зеленый, $0000FF - чистый красный, $FFFFFF - черный цвет, $000000 - белый. Таким образом, задав определенное числовое значение, можно добиться того или иного оттенка искомого цвета. Но это в формате RGB. Чаще всего в Делфи мы пользуемся типом TColor, в котором добавлен еще 1 байт -указатель на замену цвета. Этот байт может принимать три различных значения - ноль ($00), единицу ($01) или двойку ($02). Что это значит:

  • Ноль ($00) - цвет, который не может быть воспроизведен точно, заменяется ближайшим цветом из системной палитры.
  • Единица ($01) - цвет, который не может быть воспроизведен точно, заменяется ближайшим цветом из палитры, которая установлена сейчас.
  • Двойка ($02) - цвет, который не может быть воспроизведен точно, заменяется ближайшим цветом из палитры, которую поддерживает текущее устройство вывода (в нашем случае - монитор).

Видимо, всегда лучше устанавливать значение первого байта равным нулю ($00), по крайней мере, так происходит при получении типа TColor при помощи функции RGB.

Схемой RGB пользоваться удобнее и привычнее, чем остальные, но расскажем немного и о них. Схема HLS(Hue, Light, Saturation) - Оттенок, Яркость, Насыщенность. Как видно из аббревиатуры, цвет представляется несколько иначе - через оттенок определенного цвета, его яркость и насыщенность. К сожалению, никогда этой схемой не пользовался, поэтому пример привести не могу:(. CMYK - Cyan-Magenta-Yellow-blacK палитра (голубой-сиреневый-желтый-черный), используется в издательских системах как более четко передающая цвета, чем палитра RGB. Также ничего не могу сказать, кроме того, что уже сказано. В моей статье мы будем рассматривать только модель RGB.

Теперь, что же такое градиент? Градиент - это плавный переход от одного цвета к другому. Очень хорошо градиент можно показать на примере радуги.

Допустим, вам нужно получить промежуточный цвет между красным и синим. Для этого просто находим среднее арифметическое отдельных координат RGB.

(255, 0, 0) + (0, 0, 255) =
((255+0)div 2, (0+0)div 2, (0+255)div 2) = (127, 0, 127). 

То есть получили сиреневый цвет. Для случая многих цветов нужно будет сложить координаты всех цветов и разделить на их количество. Как же можно сделать этот плавный переход? Итак, пусть заданы 2 цвета своими координатами ((A1, A2, A3) и (B1, B2, B3)) и линия (длиной h пикселов), по которой нужно залить.

Тогда каждый цвет каждого пиксела, находящегося на расстоянии x пикселов от начала будет равен

(A1-(A1-B1)/h*x, A2-(A2-B2)/h*x, A3-(A3-B3)/h*x)
.

Теперь, наконец, перейдем, собственно, к реализации градиентной заливки.

Алгоритмы

Для начала решим, как мы будем действовать. Когда-то давно я искал хорошую реализацию градиентной заливки, но у них у всех был большой недостаток - громоздкость и нечитабельность алгоритма. Кроме того, было только два вида - горизонтальная и вертикальная заливка. В моей статье вид заливки ограничится лишь вашей фантазией. Я создал библиотеку градиентных функций и забыл об этой проблеме. Позже я приобрел библиотеку RX и увидел там почти аналогичную реализацию, но опять таки только 2-3 вида заливки. ДАЕШЬ ТВОРЧЕСКУЮ РЕАЛИЗАЦИЮ!

Итак, начнем с того, что чтобы не быть зависимым от вида заливки, нужно цвета держать в массиве. Единожды заполнив массив плавным переходом цветов, его можно использовать для разных видов заливки. Кроме того, используя массив гораздо легче будет сделать множественную заливку - скажем, от синего к красному, потом от красного к зеленому и от зеленого к синему. Давайте рассмотрим алгоритм заполнения массива.

Сразу оговоримся о типе TColorArray.

type
TColorArray = array of TColor;

procedure SimpleFillArray(FromColor, ToColor: TColor;
                          var ColorArray: TColorArray;
                          ArrayWidth: Integer);
var
  i: Integer;
  R1,G1,B1,
  R2,G2,B2: Byte;
begin
  R1 := GetRValue(ColorToRGB(FromColor));
  G1 := GetGValue(ColorToRGB(FromColor));
  B1 := GetBValue(ColorToRGB(FromColor));
  R2 := GetRValue(ColorToRGB(ToColor));
  G2 := GetGValue(ColorToRGB(ToColor));
  B2 := GetBValue(ColorToRGB(ToColor));

  for i := 0 to ArrayWidth do
ColorArray[i] := RGB(R1 - i*(R1 - R2) div ArrayWidth,
                             G1 - i*(G1 - G2) div ArrayWidth,
                             B1 - i*(B1 - B2) div ArrayWidth);
end;

Объясним все по порядку. Для начала, нам нужно извлечь отдельные RGB-координаты из цветов FromColor, ToColor. Делается это с помощью функций GetXValue(X=R,G,B). Однако, это не единственный способ получения RGB-координат. Не забудем, что цвет - это обычное целочисленное число. Поэтому, координаты можно достать и так:

R := Color mod $100;
G := Color div $100 mod $100;
B := Color div $10000;

и так:

R := Color and $FF;
G := (Color and $FF00) shr 8;
B := (Color and $FF0000) shr 16;

и так:

R := Lo(Color); 
G := Lo(Color shr 8);
B := Lo((Color shr 8) shr 8); 

Что вы выберете - ваше дело. Мне удобнее через GetXValue.

Итак, координаты извлечены, затем, согласно алгоритму, заполняются ячейки массива. (х - расстояние от начала массива, в цикле это счетчик i).

В этой процедуре мы заполняем массив простым переходом цветов. Но можно сделать и круче - переход с несколькими цветами, заданными массивом:

procedure ComplexFillArray(Colors: array of TColor;
                           var ColorArray: TColorArray;
                           ArrayWidth: Integer);
var ColArray: TColorArray;
       i,j,Temp: Integer;
       Equal: Boolean;
begin
//Вначале проверим число цветов
//Если массив пуст:
if High(Colors) < 0 then
   begin
     raise Exception.Create('Specify at least one color!');
     Exit;
   end;

//Если только один элемент, то
//просто заполняем массив этим цветом:
if High(Colors) = 0 then
   begin
    for i := 0 to ArrayWidth do
        ColorArray[i] := Colors[0];
    Exit;
   end;

  //ширина одной полосы, необходимой для перехода от
  //одного цвета массива к другому. Естественно, ширина
  //кратна числу цветов в массиве.
  Temp := ArrayWidth div (High(Colors));
  SetLength(ColArray, Temp + 1);
  
  Equal := (ArrayWidth mod Temp)=0; //булевая переменная
  //- наличие остатка после деления - сигнализирует о том,
  //укладываются ли полосы в массив полностью, или нет

  for i := 0 to High(Colors) - 1 do
   begin
     SimpleFillArray(Colors[i],
                                Colors[i + 1],
                                ColArray,
                                Temp);
     for j := 0 to Temp do
         ColorArray[j + i*Temp] := ColArray[j];
   end;
  //если имеет место неполное заполнение, то делаем следующее:
  //отступаем от конца на расстояние ArrayWidth
  //mod Temp и закрашиваем от
  //цвета на этом расстоянии до последнего цвета (см. рисунок )

  


  * = ArrayWidth mod Temp
  
if not Equal then begin
SimpleFillArray(ColorArray[ArrayWidth - ArrayWidth mod Temp],
                           Colors[High(Colors)],
                           ColArray,
                           ArrayWidth mod Temp);
    j := 0;
for i := ArrayWidth - ArrayWidth mod Temp   to ArrayWidth do
   begin
         ColorArray[i] := ColArray[j];
         inc(j);
   end;
                             end;
Finalize(ColArray);
end;

Теперь мы можем заполнять массив несколькими цветами. Теперь что касается входного параметра ArrayWidth (длина массива). Как определить, какая длина массива нам нужна? Давайте посмотрим на примере функции горизонтальной заливки. Посмотрим, сколько нам нужно в этом случае. Для горизонтальной заливки длина массива соответствует количеству пикселей, размещенных по высоте заливаемой области:

function HorizontalArrayWidth(FillRect: TRect): Integer;
 begin
    Result := abs(FillRect.Bottom - FillRect.Top);
 end;

Теперь, зная длину, можно и заливать. Мой принцип - лучше медленно в начале, но быстро потом, чем наоборот. Всегда рисуйте на временном битмапе, а потом отображайте этот битмап на канву. Тем более это касается сложных нелинейных видов заливки (рассмотрим позже).

procedure HorizontalGradient(Canvas: TCanvas;
                             FillRect: TRect;
                             Colors: TColorArray);
var i: Integer;
      TempBmp: TBitmap;
begin
TempBmp             := TBitmap.Create;
TempBmp.Width  := abs(FillRect.Right - FillRect.Left);
TempBmp.Height := abs(FillRect.Bottom - FillRect.Top);

try
    With TempBmp do
    for i := 0 to TempBmp.Height do
       begin
         Canvas.Pen.Color := Colors[i];
         Canvas.MoveTo( - 1, i);
         Canvas.LineTo(TempBmp.Width + 1, i);
       end;
    Canvas.StretchDraw(FillRect, TempBmp);
finally
  TempBmp.Free;
end;
end;

Пример использования:

procedure TForm1.HorizontalClick(Sender: TObject);
var ColArr:TColorArray;
begin
SetLength(ColArr, HorizontalArrayWidth(BMP.Canvas.ClipRect) + 1);
// не забудем, что индексация
// идет от нуля
ComplexFillArray([clBlack,clRed, $004080FF,
                  clYellow,clGreen,clBlue,
                  clNavy, clPurple, clBlack],
                  ColArr,
                  HorizontalArrayWidth(BMP.Canvas.ClipRect));
HorizontalGradient(BMP.Canvas,
                                BMP.Canvas.ClipRect,
                                ColArr);
Canvas.StretchDraw(Clientrect,BMP);
Finalize(ColArr);
end;

Я разделил процесс создания - заполнения массива цветами с процессом градиентной заливки потому, что этот массив может повторно использоваться, но в принципе, процесс создания - заполнения можно занести внутрь процедуры заливки в случае единичного использования массива.

По поводу объекта BMP - это глобальный битмап, который я создаю в FormCreate, чтобы не создавать каждый раз временный битмап и форма не мерцала при каждой отрисовке. Полностью демо можно будет скачать.

Аналогично выглядит функция вертикальной заливки. Длина массива соответствует ширине заливаемой области:

function VerticalArrayWidth(FillRect: TRect): Integer;
begin
 Result := abs(FillRect.Right - FillRect.Left);
end;

procedure VerticalGradient(Canvas: TCanvas;
                           FillRect: TRect;
                           Colors: TColorArray);
var i: Integer;
      TempBmp: TBitmap;
begin
TempBmp             := TBitmap.Create;
TempBmp.Width  := abs(FillRect.Right - FillRect.Left);
TempBmp.Height := abs(FillRect.Bottom - FillRect.Top);

try
    With TempBmp do
    for i := 0 to TempBmp.Width do
       begin
         Canvas.Pen.Color := Colors[i];
         Canvas.MoveTo(i, - 1);
         Canvas.LineTo(i, TempBmp.Height);
       end;
    Canvas.StretchDraw(FillRect, TempBmp);
finally
TempBmp.Free;
end;
end;

До этого, мы рассматривали лишь простые варианты заливки. Теперь перейдем, собственно, к творчеству. Давайте посмотрим, как можно сделать что-нибудь другое. Например, диагональную заливку с левого верхнего к правому нижнему углу. Все, что нужно сделать - это заполнить массив и рисовать линии по диагонали. Длина массива должна быть равна сумме высоты и ширины заполняемой области. Почему? Давайте посмотрим. Процедура заполнения должна выполниться в два приема - вначале закрашиваем левый верхний треугольник, то есть спускаемся по левой стороне области, продолжая линии до верхней стороны области. По достижении нижнего левого угла направление закрашивания меняется. Теперь идем по нижней стороне, продолжая линии до правой стороны (при условии квадратной области), если же область неквадратная, то часть линий будет касаться верхней стороны. Проблема с неквадратностью может быть решена, если создать временный квадратный битмап, стороны которого равны максимальной стороне прямоугольной области. Затем этот битмап закрасить и растянуть на закрашиваемую область с помощью метода StretchDraw (или стандартной функции из модуля Windows - StretchBlt). Аналогично будет проходить закрашивание по диагонали из правого верхнего в левый нижний угол, изменится лишь направление закрашивания.

Что еще? Да хоть килограмм! Давайте посмотрим заливку "веером". Смысл веера в том, что все линии проводятся из одного угла на стороны, противоположные ему. Длина массива здесь та же, что и в случае диагонально заливки.

Теперь посмотрим круговые виды: полуокружности сверху-снизу, слева-справа, заливка концентрическими окружностями от краев к центру.




В случаях полуокружностей длина массива под цвета должна быть равна половине ширины (в случае слева-справа) и половине высоты (в случае сверху-снизу). В случае с концентрическими окружностями - половине минимальной стороны заливаемой области, т.к. радиус окружности (или дуги) изменяется от нуля до центра заливаемой области. Надо сказать, что предварительно нужно залить область начальным цветом, чтобы была иллюзия того, что переход действительно плавен.

Вот функции:

function LeftRightPiesArrayWidth(FillRect: TRect): Integer;
begin
 Result := VerticalArrayWidth(FillRect) div 2;
end;

function TopBottomPiesArrayWidth(FillRect: TRect): Integer;
begin
 Result := HorizontalArrayWidth(FillRect) div 2;
end;

function CirclesArrayWidth(FillRect: TRect): Integer;
var Width, Height, minus: Integer;
begin
Width  := abs(FillRect.Right - FillRect.Left);
Height := abs(FillRect.Bottom - FillRect.Top);
minus  := 15*(Width + Height) div Min(Width, Height);
//величина minus определена чисто эмпирически,
//возможно вы найдете лучше
Result := Min(Width, Height) div 2+minus;
end;

procedure TopBottomPiesGradient(Canvas: TCanvas;
                                FillRect: TRect;
                                Colors: TColorArray);
var i: Integer;
      TempBmp: TBitmap;
begin
TempBmp             := TBitmap.Create;
TempBmp.Width  := abs(FillRect.Right - FillRect.Left);
TempBmp.Height := abs(FillRect.Bottom - FillRect.Top);

try
With TempBmp do begin
Canvas.Brush.Color := Colors[0];
Canvas.FillRect(FillRect);
for i := 0 to TempBmp.Height div 2  do
  begin
    Canvas.Pen.Color     := Colors[i];
    Canvas.Brush.Color := Colors[i];
    Canvas.Pie(0,
               - (TempBmp.Height div 2),
               TempBmp.Width,
               (TempBmp.Height div 2) - i,
               0,
               0,
               TempBmp.Width,
               0);

    Canvas.Pie(0,
               (TempBmp.Height div 2)+i,
               TempBmp.Width,
               3*(TempBmp.Height div 2),
               0,
               0,
               0,
               0);
  end;
                                  end;
Canvas.StretchDraw(FillRect,TempBmp);
finally
TempBmp.Free;
end;
end;

procedure LeftRightPiesGradient(Canvas: TCanvas;
                                FillRect: TRect;
                                Colors: TColorArray);
var i: Integer;
      TempBmp: TBitmap;
begin
TempBmp             := TBitmap.Create;
TempBmp.Width  := abs(FillRect.Right - FillRect.Left);
TempBmp.Height := abs(FillRect.Bottom - FillRect.Top);

try
With TempBmp do begin
Canvas.Brush.Color := Colors[0];
Canvas.FillRect(FillRect);

for i := 0 to TempBmp.Width div 2  do
  begin
    Canvas.Pen.Color     := Colors[i];
    Canvas.Brush.Color := Colors[i];
    Canvas.Pie(- TempBmp.Width div 2,
               0,
               (TempBmp.Width div 2) - i,
               TempBmp.Height,
               0,
               TempBmp.Height,
               0,
               0);
    Canvas.Pie((TempBmp.Width div 2) + i,
               0,
               3*TempBmp.Width div 2,
               TempBmp.Height,
               TempBmp.Width,
               0,
               TempBmp.Width,
               TempBmp.Height);
  end;
                end;
Canvas.StretchDraw(FillRect, TempBmp);
finally
TempBmp.Free;
end;
end;

procedure CirclesGradient(Canvas: TCanvas;
                          FillRect: TRect;
                          Colors: TColorArray);
var i,Minus: Integer;
      TempBmp:TBitmap;
begin
TempBmp             := TBitmap.Create;
TempBmp.Width  := abs(FillRect.Right - FillRect.Left);
TempBmp.Height := abs(FillRect.Bottom - FillRect.Top);
Minus := 15*(TempBmp.Width + TempBmp.Height)
         div Min(TempBmp.Width, TempBmp.Height);
try
    With TempBmp do begin
        Canvas.Brush.Color := Colors[0];
        Canvas.FillRect(FillRect);
        for i := 0 to CirclesArrayWidth(FillRect) do
           begin
        Canvas.Pen.Color   := Colors[i];
        Canvas.Brush.Color := Colors[i];
        Canvas.Ellipse(Rect(i - Minus,
                            i - Minus,
                            TempBmp.Width - i + Minus,
                            TempBmp.Height - i + Minus));
           end;
                     end;
    Canvas.StretchDraw(FillRect, TempBmp);
finally
  TempBmp.Free;
end;
end;

Давайте теперь посмотрим заливку "конверт". Суть ее в том, что область закрашивается сходящимися в центр прямоугольниками. Длина массива здесь, также, должна быть равна половине минимальной стороны заливаемой области. Это нужно для того, чтобы был действительно эффект конверта. Кстати, мой любимый вид заливки :)

Вот эта процедура:

function EnvelopeArrayWidth(FillRect: TRect): Integer;
var Width, Height: Integer;
begin
Width  := abs(FillRect.Right - FillRect.Left);
Height := abs(FillRect.Bottom - FillRect.Top);
Result := Min(Width,Height) div 2;
end;

procedure EnvelopeGradient(Canvas: TCanvas;
                           FillRect: TRect;
                           Colors: TColorArray);
var i: Integer;
      TempBmp: TBitmap;
begin
TempBmp             := TBitmap.Create;
TempBmp.Width  := abs(FillRect.Right - FillRect.Left);
TempBmp.Height := abs(FillRect.Bottom - FillRect.Top);

try
With TempBmp do
for i := 0 to EnvelopeArrayWidth(FillRect) do
    begin
      Canvas.Brush.Color := Colors[i];
      Canvas.FillRect(Rect(i,
i,
TempBmp.Width - i,
TempBmp.Height - i));
    end;
Canvas.StretchDraw(FillRect, TempBmp);
finally
  TempBmp.Free;
end;
end;

Ну, не будем раздувать и без того большую статью... Быстренько пробежимся по другим видам, которые я реализовал в своем модуле.

Заливка волнами. Длина массива - ширина (в случае горизонтальных волн) или высота (в случае вертикальных волн) заливаемой области. Кстати, частоту также можно задать. Но формула подобрана также эмпирически. Кстати, волны реализованы очень легко - заливаете битмап-полоску и потом в цикле рисуете градиентные полоски на i-ом расстоянии, равном синусу: Round(50*sin(Frequency*i). (Frequency - частота синусоиды).

Заливка звездой. Длина массива - чисто эмпирически подобрано - 2/3 минимальной из сторон. Ну, это сделано, чтобы звезда была побольше. В принципе, 2/3 можете убрать. Для построения звезды достаточно вспомнить геометрию;)

Заливка ромбом. Длина массива - такая же, что и в случае заливки конвертом.

Предела фантазии нет - все зависит только от вас. Можно комбинировать из уже имеющихся или придумать что-то новое. Мне после 16ти видов просто надоело... Надеюсь, статья не показалась вам скучной и подтолкнула на творческие поиски:)).

С уважением, Sega-Zero.

Скачать проект: Gradient.zip (18K)

VPS в России, Европе и США

Бесплатная поддержка и администрирование

Оплата российскими и международными картами

🔥 VPS до 5.7 ГГц под любые задачи с AntiDDoS в 7 локациях

💸 Гифткод CITFORUM (250р на баланс) и попробуйте уже сейчас!

🛒 Скидка 15% на первый платеж (в течение 24ч)

Скидка до 20% на услуги дата-центра. Аренда серверной стойки. Colocation от 1U!

Миграция в облако #SotelCloud. Виртуальный сервер в облаке. Выбрать конфигурацию на сайте!

Виртуальная АТС для вашего бизнеса. Приветственные бонусы для новых клиентов!

Виртуальные VPS серверы в РФ и ЕС

Dedicated серверы в РФ и ЕС

По промокоду CITFORUM скидка 30% на заказ VPS\VDS

Новости мира IT:

Архив новостей

IT-консалтинг Software Engineering Программирование СУБД Безопасность Internet Сети Операционные системы Hardware

Информация для рекламодателей PR-акции, размещение рекламы — adv@citforum.ru,
тел. +7 495 7861149
Пресс-релизы — pr@citforum.ru
Обратная связь
Информация для авторов
Rambler's Top100 TopList This Web server launched on February 24, 1997
Copyright © 1997-2000 CIT, © 2001-2019 CIT Forum
Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. Подробнее...