Как залить форму градиентом?

[timsoft]

Подскажите, как залить форму (background) горизонтальным градиентом?
Слышал про GradientFillRect, но не могу найти к ней описания

[alibek]

Код: Выделить всё

Private Type TRIVERTEX
    x As Long
    y As Long
    Red As Integer 'Ushort value
    Green As Integer 'Ushort value
    Blue As Integer 'ushort value
    Alpha As Integer 'ushort
End Type
Private Type GRADIENT_RECT
    UpperLeft As Long  'In reality this is a UNSIGNED Long
    LowerRight As Long 'In reality this is a UNSIGNED Long
End Type

Const GRADIENT_FILL_RECT_H As Long = &H0 'In this mode, two endpoints describe a rectangle. The rectangle is
'defined to have a constant color (specified by the TRIVERTEX structure) for the left and right edges. GDI interpolates
'the color from the top to bottom edge and fills the interior.
Const GRADIENT_FILL_RECT_V  As Long = &H1 'In this mode, two endpoints describe a rectangle. The rectangle
' is defined to have a constant color (specified by the TRIVERTEX structure) for the top and bottom edges. GDI interpolates
' the color from the top to bottom edge and fills the interior.
Const GRADIENT_FILL_TRIANGLE As Long = &H2 'In this mode, an array of TRIVERTEX structures is passed to GDI
'along with a list of array indexes that describe separate triangles. GDI performs linear interpolation between triangle vertices
'and fills the interior. Drawing is done directly in 24- and 32-bpp modes. Dithering is performed in 16-, 8.4-, and 1-bpp mode.
Const GRADIENT_FILL_OP_FLAG As Long = &HFF

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 Function LongToUShort(Unsigned As Long) As Integer
    'A small function to convert from long to unsigned short
    LongToUShort = CInt(Unsigned - &H10000)
End Function
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    'API uses pixels
    Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
    Dim vert(1) As TRIVERTEX
    Dim gRect As GRADIENT_RECT

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

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

    gRect.UpperLeft = 0
    gRect.LowerRight = 1

    GradientFillRect Me.hdc, vert(0), 2, gRect, 1, GRADIENT_FILL_RECT_H
End Sub


[Dzhon]

Не подойдет?
http://www.vbnet.ru/faq/showtopic.asp?id=53

[timsoft]

alibek спасибо!

[timsoft]

Не подойдет?
http://www.vbnet.ru/faq/showtopic.asp?id=53

Спасибо, но не совсем то
Код alibek'a быстрее и качественнее

[alibek]

Это не мой код, это API-Guide...

[ScorpionX]

Код: Выделить всё

AutoRedraw = False

Dim lY As Long
Dim lScaleHeight As Long
Dim lScaleWidth As Long

Private Sub Form_Paint()
ScaleMode = vbPixels 'Единицу измерения устанавливаем равной пикселу
lScaleHeight = ScaleHeight 'Получаем кол-во пикселов по высоте
lScaleWidth = ScaleWidth 'Получаем кол-во пикселов по ширине
DrawStyle = vbInvisible 'Устанавливаем стиль заливки и рисования
FillStyle = vbFSSolid
For lY = 0 To lScaleHeight 'Запускаем цикл закраски
'Закрашиваем
FillColor = RGB(0, 0, 255 - (lY * 255) \ lScaleHeight)
Line (-1, lY - 1)-(lScaleWidth, lY + 1), , B
Next lY
End Sub


Как на счёт такого способа?

[PATRIOT_kz]

Многие забыли про свойство 'AutoRedraw'.
Это свойство при, котором 'WM_UPDATE' игнорируется,
его надо использовать когда вы что то нарисовали через
Line и не хотите что оно стиралось.

[alibek]

А с чего ты решил, что кто-то забыл свойство AutoRedraw?