| |
Рисование круга с заполнением градиентными цветами |
|
| |
Следующий пример рисует круг и заполняет его градиентными цветами в реальном времени. Поместите на форму таймер и вставьте код.
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
|
|
| |
|
|
|
|