Delphi - сбориник статей
Алгоритмы
Для начала решим, как мы будем действовать. Когда-то давно я искал хорошую реализацию градиентной заливки, но у них у всех был большой недостаток - громоздкость и нечитабельность алгоритма. Кроме того, было только два вида - горизонтальная и вертикальная заливка. В моей статье вид заливки ограничится лишь вашей фантазией. Я создал библиотеку градиентных функций и забыл об этой проблеме. Позже я приобрел библиотеку 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 (длина массива). Как определить, какая длина массива нам нужна? Давайте посмотрим на примере функции горизонтальной заливки. Посмотрим, сколько нам нужно в этом случае. Для горизонтальной заливки длина массива соответствует количеству пикселей, размещенных по высоте заливаемой области:
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.
Скачать проект: (18K)
