Статьи

Опыт создания мультиградиентной заливки

Впервые я столкнулся с градиентной заливкой еще на заре своей молодости :-), инсталлируя Windows 3.1. С тех пор сине-черный переход фонового цвета в инсталляционных программах стал стандартом де-факто. Многие стали применять плавный переход из одного цвета в другой в своих программах, всячески колдуя с палитрами. Сейчас эта мода постепенно сходит на нет, и все же...
Использование градиентной заливки может существенно сократить объем программы, исключив тяжелые картинки, практически без потери привлекательности.

В данной статье описывается создание модуля, который может быть использован в любой программе. Используя API-функции, мы можем сократить объем кодов в программе. Поэтому начнем, пожалуй, с них.
NB! Все API-функции, используемые в модуле, объявляются как Private. Это связано с тем, что все они используются внутри процедур самого модуля. Однако, если Вы используете их в своей программе еще и вне данного модуля - никто Вам не запрещает объявить их как Public.

Вся сложность при работе с цветом заключается в преобразовании цветов. Т.е. получаем мы цвет в формате OLE_COLOR, а для преобразования внутри процедуры нам необходима его раскладка на составляющие (красный, зеленый, синий). Для этой ситуации очень хорошо подходит функция OleTranslateColor.
Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" _
    (ByVal OLE_COLOR As Long, _
    ByVal HPALETTE As Long, _
    pccolorref As Long) _
    As Long

Кроме этого нам потребуются еще 3 API-функции для заливки части прямоугольника, это:
Private Declare Function FillRect Lib "user32" _
    (ByVal hDC As Long, _
    lpRect As RECT, _
    ByVal hBrush As Long) _
    As Long
Private Declare Function CreateSolidBrush Lib "gdi32" _
    (ByVal crColor As Long) _
    As Long
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) _
    As Long

Как Вы заметили, функция FillRect для одного из своих аргументов требует тип RECT, который мы и объявим в разделе деклараций перед всеми вышеуказанными функциями:
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Прежде, чем мы перейдем написанию самих процедур, еще раз внимательно взглянем на функцию FillRect. Первым аргументом ее является hDC, а это значит, что мы сможем применить градиентную заливку только к объектам, которые имеют это свойство. К сожалению, таких немного: это сама форма, элемент PictureBox и UserControl.
NB! С помощью UserControl, Вы сами сможете создавать различные ЭУ (кнопки, списки, радиокнопки и т.п.), обладающих градиентной заливкой, включив создаваемый модуль в их состав.

Итак, начнем с простого, создадим процедуру, рисующую градиентную заливку от одного цвета к другому. В качестве параметров процедуры определим объект приложения (мы помним что он может быть как формой, так и картинкой), стартовый и конечный цвета и тип заливки (вертикальный или горизонтальный). Для последнего аргумента, в разделе деклараций объявим нумерованную константу:
Public Enum constOrientation
Horizontal = 0
Vertical = 1
End Enum

Там же объявим два массива, для хранения, разложенного на составляющие, цвета.
Private RGBStart(1 To 3) As Integer 'массивы цвета
Private RGBEnd(1 To 3) As Integer 'массивы цвета

Вначале, с помощью функции OleTranslateColor, получим раскладку на составляющие для начального и конечного цветов:
Public Sub DrawGradient(ObjDestGradient As Object, _
    ColorStart As OLE_COLOR, _
    ColorEnd As OLE_COLOR, _
    eOrientation As constOrientation)

Dim lColor As Long
Dim lHeight As Long, lWidth As Long
Dim lYStep As Long, lXStep As Long
Dim i As Long
Dim iRGB(1 To 3) As Integer
Dim dR(1 To 3) As Double
Dim rct As RECT
Dim hBr As Long, lhDC As Long

OleTranslateColor ColorEnd, 0, lColor
RGBEnd(1) = lColor And &HFF&
RGBEnd(2) = ((lColor And &HFF00&) \ &H100)
RGBEnd(3) = ((lColor And &HFF0000) \ &H10000)

OleTranslateColor ColorStart, 0, lColor
RGBStart(1) = lColor And &HFF&
RGBStart(2) = ((lColor And &HFF00&) \ &H100)
RGBStart(3) = ((lColor And &HFF0000) \ &H10000)

Далее очищаем объект от предыдущей графики и переводим его размеры в пикселы:
ObjDestGradient.Cls

lhDC = ObjDestGradient.hDC
lHeight = ObjDestGradient.Height \ Screen.TwipsPerPixelY
lWidth = ObjDestGradient.Width \ Screen.TwipsPerPixelX
rct.Right = lWidth
rct.Bottom = lHeight

Передаем, разложенные на составные части цвета внутренним переменным:
iRGB(1) = RGBStart(1)
iRGB(2) = RGBStart(2)
iRGB(3) = RGBStart(3)
dR(1) = RGBEnd(1) - RGBStart(1)
dR(2) = RGBEnd(2) - RGBStart(2)
dR(3) = RGBEnd(3) - RGBStart(3)

Ну а теперь займемся собственно рисованием. Для начала вычислим шаг изменения заливки. Это должно быть целое число и не меньше 1 пиксела
Select Case eOrientation
Case 0
    lYStep = lHeight \ 255
    If (lYStep = 0) Then
        lYStep = 1
    End If

В цикле, по убывающей, рисуем градиент снизу вверх. Создаем кисть, склеивая промежуточный цвет в формат OLE_COLOR, делаем заливку выбранной части
For i = lHeight To 0 Step -lYStep
    rct.Top = rct.Bottom - lYStep
    hBr = CreateSolidBrush(iRGB(3) * &H10000 + iRGB(2) * &H100& + iRGB(1))
    FillRect lhDC, rct, hBr
    DeleteObject hBr
и в конце переписываем координаты для рисования следующего промежуточного цвета:
    rct.Bottom = rct.Top
    iRGB(1) = RGBStart(1) + dR(1) * (lHeight - i) / lHeight
    iRGB(2) = RGBStart(2) + dR(2) * (lHeight - i) / lHeight
    iRGB(3) = RGBStart(3) + dR(3) * (lHeight - i) / lHeight
Next

Если выбран вертикальный тип заливки градиентом, то все делается идентично, только применительно к ширине:
Case 1
    lXStep = lWidth \ 255
    If (lXStep = 0) Then
        lXStep = 1
    End If

    For i = lWidth To 0 Step -lXStep
        rct.Left = rct.Right - lXStep
        hBr = CreateSolidBrush(iRGB(3) * &H10000 + iRGB(2) * &H100& + iRGB(1))
        FillRect lhDC, rct, hBr
        DeleteObject hBr
        rct.Right = rct.Left
        iRGB(1) = RGBStart(1) + dR(1) * (lWidth - i) / lWidth
        iRGB(2) = RGBStart(2) + dR(2) * (lWidth - i) / lWidth
        iRGB(3) = RGBStart(3) + dR(3) * (lWidth - i) / lWidth
    Next
End Select

Вот, собственно говоря, и все. Перейдите на форму и примените данную процедуру к самой форме и двум PictureBox. Лучше всего заливку расположить в событии Form_Resise. Кроме того, чтобы избежать "моргания" цвета, необходимо установить AutoRedraw = True.
NB! Мы можем объявлять цвета любым из пяти доступных в бейсике способов:
- как целое десятичное число (713060 - зеленый)
- как шестнацетиричное число (&H4F00FF - фиолетовый)
- как VB-константы (vbRed - красный)
- как функция RGB (RGB(100, 225, 10) - синий)
- как функция QBColor (QBColor(6) - желтый)

Ну вот, с двумя цветами разобрались. Используя те же самые приемы можно создать градиентную заливку, включающую три и более цветов. Ничего сверхсложного в этом нет и подробно расписывать в статье эту процедуру я не буду, она представлена в Примере. Хочу обратить внимание лишь на несколько ключевых моментов, которые облегчат Вам восприятие кодов:

При объявлении процедуры мы не знаем, сколько цветов будет использоваться. Поэтому, используем ключевое слово ParamArray. Исходя из этого, данный аргумент должен стоять последним, а аргумент, описывающий направление заливки - предпоследним.
В связи с неограниченным количеством цветов, вместо ColorEnd и ColorStart удобнее использовать одну переменную, но массив. В связи с этим заменяются внутренние переменные RGBStart и RGBEnd на RGBColor, который становится двумерным массивом. Также двумерным массивом становятся внутренние переменные iRGB и dR.
Естественно, и раскладка на цвета и сама заливка должна производиться внутри цикла для каждого цвета.
И последнее, при заливке мы используем не всю ширину (или высоту) объекта, а только часть, равную количеству цветов -1.

Удачного использования!

Скачать пример