Создать градиент-форму

'Этот пример создает Form/Picture Box с фоном, например как в инсталяционной
'программе. Установите свойство формы AutoRedraw в True.

'Пример 1

Private Sub Form_Paint()
Cls
ScaleHeight = 128
For i = 0 To 128 Step 2
Line (0, i)-(ScaleWidth, i + 2), RGB(i, 64 + i, 128 + i), BF
Next i
End Sub

'Пример 2

Sub Gradient(TheObject As Object, ByVal Redval As Long, ByVal Greenval As _
Long, ByVal Blueval As Long, ByVal Direction As Integer)
Dim Step As Integer, Reps As Integer, FillTop As Integer
Dim FillLeft As Integer, FillRight As Integer, FillBottom As Integer

If Direction < 1 Or Direction > 4 Then Direction = 1
FillTop = 0
FillLeft = 0
If Direction < 3 Then
Step = (TheObject.Height / 100)
If Direction = 2 Then FillTop = TheObject.Height - Step
FillBottom = FillTop + Step
FillRight = TheObject.Width
Else
Step = (TheObject.Width / 100)
If Direction = 4 Then FillLeft = TheObject.Width - Step
FillRight = FillLeft + Step
FillBottom = TheObject.Height
End If

For Reps = 1 To 100
If Direction = 2 And Reps = 100 Then FillTop = 0
If Direction = 4 And Reps = 100 Then FillLeft = 0
Redval = Redval - 3
Greenval = Greenval - 3
Blueval = Blueval - 3
If Redval <= 0 Then Redval = 0
If Greenval <= 0 Then Greenval = 0
If Blueval <= 0 Then Blueval = 0
TheObject.Line (FillLeft, FillTop)-(FillRight, FillBottom), RGB(Redval, _
Greenval, Blueval), BF

If Direction < 3 Then
If Direction = 1 Then
FillTop = FillBottom
Else
FillTop = FillTop - Step
End If
FillBottom = FillTop + Step
Else
If Direction = 3 Then
FillLeft = FillRight
Else
FillLeft = FillLeft - Step
End If
FillRight = FillLeft + Step
End If
Next Reps
End Sub

Private Sub Form_Load()
'Поэкспериментируйте над цифрами 200, 100, 300
'Замените "1" на 2, 3 или 4
Gradient Me, 200, 100, 300, 1
'Gradient Picture1, 200, 100, 300, 1
End Sub

Private Sub Form_Resize()
'Положите здесь те же номера, что и выше
Gradient Me, 200, 100, 300, 1
'Gradient Picture1, 200, 100, 300, 1
End Sub

'Пример 3
'Добавьте 2 CommandButton

Private Type TRIVERTEX
x As Long
y As Long
Red As Integer
Green As Integer
Blue As Integer
Alpha As Integer
End Type

Private Type GRADIENT_RECT
UpperLeft As Long
LowerRight As Long
End Type

Const GRADIENT_FILL_RECT_H As Long = &H0
Const GRADIENT_FILL_RECT_V As Long = &H1

Private Declare Function GradientFillRect Lib "msimg32" Alias "GradientFill" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long

Private Sub Form_Load()
Me.ScaleMode = vbPixels
End Sub

Private Function LongToUShort(ULong As Long) As Integer
LongToUShort = CInt(ULong - &H10000)
End Function

Private Function UShortToLong(Ushort As Integer) As Long
UShortToLong = (CLng(Ushort) And &HFFFF&)
End Function

Private Sub Command2_Click()
Cls
End Sub

Private Sub Command1_Click()
Dim vert(1) As TRIVERTEX
Dim gRect As GRADIENT_RECT

With vert(0)
.x = 0
.y = 0
.Red = 0&
.Green = &HFF&
.Blue = 0&
.Alpha = 0&
End With

With vert(1)
.x = Me.ScaleWidth
.y = Me.ScaleHeight
.Red = 0&
.Green = LongToUShort(&HFF00&)
.Blue = LongToUShort(&HFF00&)
.Alpha = 0&
End With

gRect.UpperLeft = 1
gRect.LowerRight = 0
'Замените GRADIENT_FILL_RECT_H на GRADIENT_FILL_RECT_V чтобы рисовать вертикальную прорисовку
GradientFillRect Me.hdc, vert(0), 2, gRect, 1, GRADIENT_FILL_RECT_H
End Sub

Обсудить статью на форуме

Если Вас заинтересовала или понравилась информация программирование на Visual Basic - "Создать градиент-форму", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:

Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи, в сообщение обязательно указывайте название или ссылку на статью!