GradientFill API

[VBGreen]

Hello everybody!

Has anyone used the above API call before?

I notice it is not listed in the API Viewer but it exist. I have tried a program developed by someone using the above in VB and runs well. However, when I try it in my codes, VB gives me an error saying that it is not defined eventhough I have declared it. Have I missed something?

Thank you in advance

[YoungBuck]

This function is stored in the msimg32.dll file which is included with win98 / win2k or higher so depending on your version of windows you may not have the required DLL file. If you don't have it you can download it from The DLL Archive and then place the file in your Win/System folder and the function should work just fine.

[VBGreen]

Thanks YoungBuck.

However, I have the msimg32.dll file.

When I run my application using the above API call, VB give me the below error.

Run time error '453'
Can't find entry point Gradientfill in msimg32

Have any ideas how to resolve it?

Thanks!

[YoungBuck]

Are you sure your declaration is correct, this is the closest thing I could find.....

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 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

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: [email protected]
    '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

[KrishnaSantosh]

Hi,

My EMail Is : [email protected]

You Can Do This In Two Ways.

i) BY Using The GDI32 and USER32 Libraries

ii) Without Using Any APIs And Doing The Whole Thing With Pure Visual Basic Code.

Please Mail Me For Details

[KrishnaSantosh]

Hi,

My Email is : [email protected]

There are two ways to do this.

i) Using User32 and Gdi32 APIs

ii) Without using any APIs and doing this by pure VBCode

For Details Please EMail Me.

[YoungBuck]

Here is a Line Gradient method.....

Option Explicit

Private Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Function LineGradient(ByVal pDC As Long, ByVal pWidth As Long, pHeight As Long, ByVal pStartColor As Long, ByVal pEndColor As Long, Optional pVertical As Boolean = False) As Boolean
 Dim lDC As Long
 Dim lBMP As Long, lOrigBMP As Long
 Dim lPen As Long, lOrigPen As Long
 Dim bytCS(3) As Byte, bytCE(3) As Byte
 Dim nRChg As Double, nGChg As Double, nBChg As Double
 Dim ptCurLine(0 To 1) As POINTAPI
 Dim ict As Long
 Dim lEnd As Long
 
 lDC = CreateCompatibleDC(pDC)
 
 If Not lDC = 0 Then
 
    lBMP = CreateCompatibleBitmap(pDC, pWidth, pHeight)
    
    If Not lBMP = 0 Then
    
        lOrigBMP = SelectObject(lDC, lBMP)
 
        'retrieve the red, green, and blue bytes from the Color
        CopyMemory bytCS(0), pStartColor, 3
        CopyMemory bytCE(0), pEndColor, 3
 
        If pVertical = True Then lEnd = pHeight Else lEnd = pWidth

        nRChg = (CInt(bytCE(0)) - CInt(bytCS(0))) / lEnd
        nGChg = (CInt(bytCE(1)) - CInt(bytCS(1))) / lEnd
        nBChg = (CInt(bytCE(2)) - CInt(bytCS(2))) / lEnd
        
        lPen = CreatePen(0, 1, pStartColor)
        
        lOrigPen = SelectObject(lDC, lPen)
        
        For ict = 0 To lEnd
    
            If pVertical = True Then
                
                ptCurLine(0).x = 0: ptCurLine(0).y = ict
                ptCurLine(1).x = pWidth: ptCurLine(1).y = ict
        
            Else
                
                ptCurLine(0).x = ict: ptCurLine(0).y = 0
                ptCurLine(1).x = ict: ptCurLine(1).y = pHeight
    
            End If
            
            Polyline lDC, ptCurLine(0), 2
            
            lPen = CreatePen(0, 1, RGB(bytCS(0) + (nRChg * ict), bytCS(1) + (nGChg * ict), bytCS(2) + (nBChg * ict)))
        
            DeleteObject SelectObject(lDC, lPen)
            
        Next ict
        
        If BitBlt(pDC, 0, 0, pWidth, pHeight, lDC, 0, 0, vbSrcCopy) Then
            
            LineGradient = True
            
        Else
            
            LineGradient = False
            
        End If
        
        DeleteObject SelectObject(lDC, lOrigPen)
        DeleteObject SelectObject(lDC, lOrigBMP)
        DeleteDC lDC
        
    Else
        
        LineGradient = False
        
    End If
    
 Else
 
    LineGradient = False
    
 End If
            
    
End Function

Private Sub Form_Load()
    Me.AutoRedraw = False
End Sub

Private Sub Form_Paint()
    LineGradient Me.hdc, Me.Width \ Screen.TwipsPerPixelX, Me.Height \ Screen.TwipsPerPixelY, RGB(255, 0, 255), RGB(255, 255, 0), True
End Sub

Private Sub Form_Resize()
    Form_Paint
End Sub

If anybody is interested in seeing in other gradient methods (Rectangle, Circle, etc.) just show some interest and I'll post them too.