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 (http://solo.abac.com/dllarchive/) 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: 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

[KrishnaSantosh]

Hi,

My EMail Is : santoshkrishna@santoshsmail.com

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 : santoshkrishna@santoshsmail.com

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. :)