Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage 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 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 Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Function DrawGradientFourColour(ObjectHDC As Long, Left As Long, Top As Long, Width As Long, Height As Long, TopLeftColour As Long, TopRightColour As Long, BottomLeftColour As Long, BottomRightColour As Long)
Private Function GradateColours(cResults() As cRGB, Length As Long, Colour1 As cRGB, Colour2 As cRGB)
Dim fromR As Integer
Dim toR As Integer
Dim fromG As Integer
Dim toG As Integer
Dim fromB As Integer
Dim toB As Integer
Dim stepR As Single
Dim stepG As Single
Dim stepB As Single
Dim iLoop As Long
ReDim cResults(0 To Length)
fromR = Colour1.Red
fromG = Colour1.Green
fromB = Colour1.Blue
toR = Colour2.Red
toG = Colour2.Green
toB = Colour2.Blue
stepR = Divide(toR - fromR, Length)
stepG = Divide(toG - fromG, Length)
stepB = Divide(toB - fromB, Length)
For iLoop = 0 To Length
cResults(iLoop).Red = fromR + (stepR * iLoop)
cResults(iLoop).Green = fromG + (stepG * iLoop)
cResults(iLoop).Blue = fromB + (stepB * iLoop)
Next iLoop
End Function
Private Function Blue(Colour As Long) As Long
Blue = (Colour And &HFF0000) / &H10000
End Function
Private Function Green(Colour As Long) As Long
Green = (Colour And &HFF00&) / &H100
End Function
Private Function Red(Colour As Long) As Long
Red = (Colour And &HFF&)
End Function
Private Function Divide(Numerator, Denominator) As Single
If Numerator = 0 Or Denominator = 0 Then
Divide = 0
Else
Divide = Numerator / Denominator
End If
End Function
Public Sub GradientTwoColour(ByVal hDC As Long, ByVal Direction As GRADIENT_DIRECT, ByVal StartColor As Long, ByVal EndColor As Long, Left As Long, Top As Long, Width As Long, Height As Long)
Dim udtVert(1) As TRIVERTEX, udtGRect As GRADIENT_RECT
Dim UDTRECT As RECT
'hDCObj.ScaleMode = vbPixels
'hDCObj.AutoRedraw = True
SetRect UDTRECT, Left, Top, Width, Height
With udtVert(0)
.X = UDTRECT.Left
.Y = UDTRECT.Top
.Red = LongToSignedShort(CLng((StartColor And &HFF&) * 256))
.Green = LongToSignedShort(CLng(((StartColor And &HFF00&) \ &H100&) * 256))
.Blue = LongToSignedShort(CLng(((StartColor And &HFF0000) \ &H10000) * 256))
.Alpha = 0&
End With
With udtVert(1)
.X = UDTRECT.Right
.Y = UDTRECT.Bottom
.Red = LongToSignedShort(CLng((EndColor And &HFF&) * 256))
.Green = LongToSignedShort(CLng(((EndColor And &HFF00&) \ &H100&) * 256))
.Blue = LongToSignedShort(CLng(((EndColor And &HFF0000) \ &H10000) * 256))
.Alpha = 0&
End With
udtGRect.UpperLeft = 0
udtGRect.LowerRight = 1
GradientFillRect hDC, udtVert(0), 2, udtGRect, 1, Direction
End Sub
Private Function LongToSignedShort(ByVal Unsigned As Long) As Integer
If Unsigned < 32768 Then
LongToSignedShort = CInt(Unsigned)
Else
LongToSignedShort = CInt(Unsigned - &H10000)
End If
End Function
Private Function ColourTOGray(ByVal uColor As Long) As Long
Dim Red As Long, Blue As Long, Green As Long
Dim gray As Long
Red = uColor Mod 256
Green = (uColor Mod 65536) / 256
Blue = uColor / 65536
gray = (Red + Green + Blue) / 3
ColourTOGray = RGB(gray, gray, gray)
End Function
Private Function LightenColor(ByVal uColour As ColorConstants, Optional ByVal OffSet As Long = 1) As Long
Dim intR As Integer, intG As Integer, intB As Integer
intR = Abs((uColour Mod 256) + OffSet)
intG = Abs((((uColour And &HFF00) / 256&) Mod 256&) + OffSet)
intB = Abs(((uColour And &HFF0000) / 65536) + OffSet)
