VBCoding Библиотека кодов Visual Basic 6 Мультимедиа Рисование круга с заполнением градиентными цветами

Visual Basic 6
Рисование круга с заполнением градиентными цветами

Следующий пример рисует круг и заполняет его градиентными цветами в реальном времени. Поместите на форму таймер и вставьте код.

Option Explicit
Private Type RGBColor
    Red As Byte
    Green As Byte
    Blue As Byte
End Type

Private Palete(360) As Long
Private Mask As Long, Mask1 As Long
Private Frame As Integer
Private Mix As Integer, MaxMix As Integer, Direct As Boolean

Private Const Intensity = 50 '0 - только палитра (черный цвет)
' 100 - только маска
Private Const CenterX = 150 'центр круга по X
Private Const CenterY = 105 'центр круга по Y
Private Const Radius = 100 'радиус круга

'Переводит градусы в радианы
Function DtoR(ByVal Degree As Integer) As Double
    DtoR = Degree * 3.14159265358979 / 180
End Function

'Разлагает цвет на составляющие
Private Function ColorToRgb(tColor As Long) As RGBColor
    With ColorToRgb
        .Red = tColor And 255
        .Green = (tColor And 65280) \ 256
        .Blue = (tColor And 16711680) \ 65536
    End With
End Function

'Выдает смешанный цвет из двух других
Function MixColor(ByVal tColor1 As Long, ByVal tColor2 As Long, ByVal Intensity As Integer) As Long
    'Объявляем переменные
    Dim c1 As RGBColor
    Dim c2 As RGBColor
    Dim gr As Byte
    Dim bl As Byte
    Dim re As Byte
    'Разлагаем цвет на составляющие
    c1 = ColorToRgb(tColor1)
    c2 = ColorToRgb(tColor2)
    'Вычисляем число, нужное для изменения цвета и
    'делаем конечный результат
    re = c1.Red - (((CLng(c1.Red) - CLng(c2.Red)) / 100) * Intensity)
    bl = c1.Blue - (((CLng(c1.Blue) - CLng(c2.Blue)) / 100) * Intensity)
    gr = c1.Green - (((CLng(c1.Green) - CLng(c2.Green)) / 100) * Intensity)
    MixColor = RGB(re, gr, bl)
End Function

Private Sub Form_Activate()
    Me.DrawWidth = 2
    Me.ScaleMode = 3
    Timer1.Interval = 10
    MaxMix = 70
    Mix = 1
End Sub

Private Sub Timer1_Timer()
    If Frame = 360 Then Frame = 0
    'Смешать цвет палитры с маской
    Palete(Frame) = MixColor(Palete(Frame), _
        MixColor(Mask, Mask1, 100 / MaxMix * Mix), Intensity)
    'Рисуем линию
    Me.Line (Cos(DtoR(Frame)) * Radius + CenterX, _
        Sin(DtoR(Frame)) * Radius + CenterY)- _
        (CenterX, CenterY), Palete(Frame)
    Mix = Mix + 1
    If Mix = MaxMix Then 'Если цвет поменялся до конца...
        Randomize
        If Direct Then
            Mask1 = Rnd * 16777215 'Случайный цвет второй маски
        Else
            Mask = Mask1
        End If
        Direct = Not Direct
        Mix = 1
        MaxMix = Rnd * 80 + 20 'Длина цикла смены цвета масок
    End If
    Frame = Frame + 1 'Угол наклона следующей линии
End Sub

 

Источник: http://www.vbnet.ru/ 
 

Добавить комментарий


Защитный код
Обновить

 
VBCoding Библиотека кодов Visual Basic 6 Мультимедиа Рисование круга с заполнением градиентными цветами  
Powered by Exponenta -