Rank: Member
Groups: Member
Joined: 12/9/2003(UTC) Posts: 4

Ok. Here it is. The comments for this code are inside. I tried to put enough comments to make it clear. ;) Main code is contained in CreateBitmapWithGradient function, so it is rather easy to reuse it in other pages. Code:
<! METADATA TYPE="typelib" UUID="{3CE48541DE7A490993149D0ED0D1CA5A}">
<%
Option Explicit
' Define constants for different types of gradients.
' First color begins at top left corner, second color begins at
' bottom right corner.
Const GradientTypeDiagonal = 0
' First color begins at bottom left corner, second color begins at
' top right corner.
Const GradientTypeBackDiagonal = 1
' First color begins at left side, second color begins at right side.
Const GradientTypeHorizontal = 2
' First color begins at top side, second color begins at bottom side.
Const GradientTypeVertical = 3
' Demonstrating how to use CreateBitmapWithGradient function.
Dim objBitmap
Set objBitmap = CreateBitmapWithGradient(120, 100, _
ColorYellow, ColorRed, 50, 25, GradientTypeDiagonal)
objBitmap.SaveToStream Response
objBitmap.SaveToFile Server.MapPath("Gradient.png")
'
' Function CreateBitmapWithGradient
'
' Generates a bitmap with specified dimensions and fills it
' with gradient with given settings.
'
' Argument list:
'
' intWidth  width of new bitmap
' intHeight  height of new bitmap
' lngColor1  first color of the gradient
' lngColor2  second color of the gradient
' dblRatio  ratio of the first to second colors (in percents).
' If it is less 50%, second color prevails, if it is
' more 50%, first color prevails. 50% means equal amount of
' both colors
' dblSharpness  specifies sharpness of the border between colors
' (in percents). 0% means maximum blur, 100% means no
' blur at all.
' intType  specifies a gradient type: diagonal, back diagonal,
' horizontal or vertical.
Function CreateBitmapWithGradient(intWidth, intHeight, _
lngColor1, lngColor2, dblRatio, dblSharpness, intType)
' Make sure, that specified arguments are in proper range.
dblRatio = ValidateValue(dblRatio, 0, 100)
dblSharpness = ValidateValue(dblSharpness, 0, 100)
intType = ValidateValue(intType, 0, 3)
' Create empty bitmap of specified dimensions and filled by
' the second color.
Dim objBitmap
Set objBitmap = Server.CreateObject("GraphicsMill.Bitmap")
objBitmap.CreateNew intWidth, intHeight, Format32bppRgb, lngColor2
' Now draw a shape specifying the first color. If we produce
' horizontal or vertical gradient, we should draw a rectangle.
' If we make a diagonal, we draw rightangled triangle.
' If you want to add another kinds of gradient, add appropriate shape
' here (e.g. ellipse for round gradient).
objBitmap.Graphics.Brush.PrimaryColor = lngColor1
Select Case intType
Case GradientTypeDiagonal
DrawTriangleOnBitmap objBitmap, 0, 0, _
intWidth*dblRatio/50, 0, _
0, intHeight*dblRatio/50
Case GradientTypeBackDiagonal
DrawTriangleOnBitmap objBitmap, 0, intHeight, _
intWidth*dblRatio/50, intHeight, _
0, intHeight*(50dblRatio)/50
Case GradientTypeHorizontal
objBitmap.Graphics.DrawRectangle 0, 0, _
intWidth*dblRatio/100, intHeight, True, False
Case GradientTypeVertical
objBitmap.Graphics.DrawRectangle 0, 0, _
intWidth, intHeight*dblRatio/100, True, False
End Select
' To achieve gradient effect, we should apply blur. The blur radius is
' calculated in the following way: get maximum possible blur radius for
' this image and reduce it according to dblSharpness argument. Under
' maximum blur radius considered a distance from the colors boundary
' to the edge of the bitmap.
Dim dblMaxBlurRadius
Select Case intType
Case GradientTypeDiagonal, GradientTypeBackDiagonal
If intWidth < intHeight Then
dblMaxBlurRadius = intWidth * (50  Abs(50  dblRatio)) / 100
Else
dblMaxBlurRadius = intHeight * (50  Abs(50  dblRatio)) / 100
End If
Case GradientTypeHorizontal
dblMaxBlurRadius = intWidth * (50  Abs(50  dblRatio)) / 100
Case GradientTypeVertical
dblMaxBlurRadius = intHeight * (50  Abs(50  dblRatio)) / 100
End Select
' Low sharpness produce blurred result. High sharpness reduces blur.
' Maximum sharpness (= 100) leads to radius = 0, so we do not apply blur
' at all.
Dim dblBlurRadius
dblBlurRadius = dblMaxBlurRadius * (100  dblSharpness) / 100
' Apply blur
If dblBlurRadius > 0 Then
objBitmap.Effects.Blur dblBlurRadius
End If
' Return the result bitmap
Set CreateBitmapWithGradient = objBitmap
Set objBitmap = Nothing
End Function
'
' Function DrawTriangleOnBitmap
'
' This helper function draws a triangle on given bitmap
'
' Argument list:
'
' objBitmap  a bitmap where to draw the triangle.
' X1, Y1  coordinates of the first triangle point.
' X2, Y2  coordinates of the second triangle point.
' X3, Y3  coordinates of the third triangle point.
'
Sub DrawTriangleOnBitmap(objBitmap, X1, Y1, X2, Y2, X3, Y3)
Dim poly(5)
poly(0) = X1
poly(1) = Y1
poly(2) = X2
poly(3) = Y2
poly(4) = X3
poly(5) = Y3
objBitmap.Graphics.DrawPolygon poly, True, False
End Sub
'
' Function ValidateValue
'
' This helper function ensures that given value fits to
' specified bounds. This implementation returns a min
' or max bound if the value exceed the boundaries.
'
' Argument list:
'
' Value  the value to check.
' Min  the lower bound.
' Max  the upper bound.
'
Function ValidateValue(Value, Min, Max)
If Value < Min Then
ValidateValue = Min
Else
If Value > Max Then
ValidateValue = Max
Else
ValidateValue = Value
End If
End If
End Function
%>
Edited by user Thursday, December 20, 2007 6:37:23 PM(UTC)
 Reason: Not specified
