6.0中如何绘制如PS中的圆形渐变、菱形渐变啊！

[wuqiaowuqiao]

gradientFill好像做不到！

[laviewpbt]

PS的渐变是可以不止一种颜色的，也就是说可能中间有很多过度色，但可以认为这些颜色之间都是线形过渡的。因此可以先计算处没处的颜色值，让后用相应的图形方法绘制。
圆形渐变: 得到颜色值后用circle方法绘制，如果是内存DC就用Arc函数绘制。
线形渐变： 得到颜色值后用line方法绘制，如果是内存DC就用MoveToEx和LineTo函数绘制。
其他的渐变也类似：
至于用gradientFill实现两种颜色的渐变还是很方便和高效的，对于多种颜色的渐变就可能吧是那么方便了啊。

[laviewpbt]

gradientFill实现两种颜色的圆形渐变和矩形渐变

Private Type GRADIENT_TRIANGLE
Vertex1 As Long
Vertex2 As Long
Vertex3 As Long
End Type
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 Enum GradientFillRectType
GRADIENT_FILL_RECT_H = 0
GRADIENT_FILL_RECT_V = 1
GRADIENT_FILL_TRIANGLE = 2
End Enum

Private Const CLR_INVALID = &HFFFF


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 GradientFillTriangle Lib "msimg32" Alias "GradientFill" (ByVal hDC As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_TRIANGLE, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As Long

Private Function DrawGradientCircle(ByVal hDC As Long, ByVal CenterX As Long, ByVal CenterY As Long, ByVal Radius As Long, ByVal StartColor As Long, ByVal EndColor As Long) As Boolean
Dim i As Long
Dim X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, X3 As Long, Y3 As Long
Dim Theta As Double
Dim Vert(3) As TRIVERTEX
Dim gTRi(1) As GRADIENT_TRIANGLE

Theta = 10 * 3.1415926 / 180
With Vert(0)
.X = CenterX
.Y = CenterY
.Alpha = 0
End With
SetTriVertexColor Vert(0), StartColor
X1 = CenterX
Y1 = CenterY - Radius
For i = 0 To 36
X2 = CenterX - Cos(i * Theta) * Radius
Y2 = CenterY - Sin(i * Theta) * Radius
X3 = CenterX - Cos((i - 0.5) * Theta) * Radius
Y3 = CenterY - Sin((i - 0.5) * Theta) * Radius
With Vert(1)
.X = X1
.Y = Y1
.Alpha = 0
End With
SetTriVertexColor Vert(1), EndColor
With Vert(2)
.X = X2
.Y = Y2
.Alpha = 0
End With
SetTriVertexColor Vert(2), EndColor
With Vert(3)
.X = X3
.Y = Y3
.Alpha = 0
End With
SetTriVertexColor Vert(3), EndColor

gTRi(0).Vertex1 = 0
gTRi(0).Vertex2 = 1
gTRi(0).Vertex3 = 2
gTRi(1).Vertex1 = 3
gTRi(1).Vertex2 = 1
gTRi(1).Vertex3 = 2
GradientFillTriangle hDC, Vert(0), 4, gTRi(0), 2, GRADIENT_FILL_TRIANGLE
X1 = X2
Y1 = Y2
Next
DrawGradientCircle = True
End Function


Private Function DrawGradientRect(ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, X2 As Long, Y2 As Long, ColorStart As Long, ColorEnd As Long, Optional Mode As GradientFillRectType = GradientFillRectType.GRADIENT_FILL_RECT_H) As Boolean
Dim Vert(1) As TRIVERTEX
Dim gRect As GRADIENT_RECT
SetTriVertexColor Vert(0), TranslateColor(ColorStart)
With Vert(0)
.X = X1
.Y = Y1
.Alpha = 0
End With
SetTriVertexColor Vert(1), TranslateColor(ColorEnd)
With Vert(1)
.X = X2
.Y = Y2
.Alpha = 0
End With
gRect.UpperLeft = 0
gRect.LowerRight = 1
If Mode = GRADIENT_FILL_TRIANGLE Then Mode = GRADIENT_FILL_RECT_H
GradientFillRect hDC, Vert(0), 2, gRect, 1, Mode
DrawGradientRect = True
End Function






Private Sub SetTriVertexColor(Vert As TRIVERTEX, Color As Long)
Dim Red As Long
Dim Green As Long
Dim Blue As Long
Red = (Color And &HFF&) * &H100&
Green = (Color And &HFF00&)
Blue = (Color And &HFF0000) \ &H100&
SetTriVertexColorComponent Vert.Red, Red
SetTriVertexColorComponent Vert.Green, Green
SetTriVertexColorComponent Vert.Blue, Blue
End Sub
Private Sub SetTriVertexColorComponent(ByRef Color As Integer, ByVal Component As Long)
If (Component And &H8000&) = &H8000& Then
Color = (Component And &H7F00&)
Color = Color Or &H8000
Else
Color = Component
End If
End Sub

Private Function TranslateColor(ByVal Color As OLE_COLOR, Optional hPal As Long = 0) As Long
If OleTranslateColor(Color, hPal, TranslateColor) Then
TranslateColor = CLR_INVALID
End If
End Function

Private Sub Command1_Click()
DrawGradientCircle Me.hDC, 400, 400, 50, vbRed, vbGreen
Me.Refresh
End Sub

Private Sub Command2_Click()
DrawGradientRect Me.hDC, 10, 10, 200, 100, vbBlue, vbGreen
Me.Refresh
End Sub

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

[砸死牛顿的苹果]

mark

[homezj]

gradientFill是很强大与高效的，它也支持三角形渐变，而用三角形你可组成多种形状，包括圆形与菱形，菱形简单，四个三角形就行了，圆形需三角形的数量要多一些，最少也要12个，半径越大，三角形也需要得越多，数量越多越平滑。

为防边缘锯齿，建议结合使用圆形裁剪区，就更完美了。

[homezj]

呵呵！laviewpbt终于发现了gradientFill的强大，其实gradientFill是支持多种颜色渐变 r ，它的每个顶点都可指定不同颜色，可以说PS的各种渐变效果，基本用它都可绘出来。

不过，laviewpbt的代码效率有点问题，gradientFill是可一次传入所有顶点与三角形的，不用你这样分36次传入72个三角形，调用开销与每次重置DC的开销太大了。

过会儿，我来重写一下你这个圆形渐变函数。

[homezj]

'注意，这个顶点结构声明有点变化，这样就无需laviewpbt另几个自编函数了。其它声明与上面的一样。
Private Type TRIVERTEX
x As Long
y As Long
Red(1) As Byte
Green(1) As Byte
Blue(1) As Byte
Alpha(1) As Byte
End Type

Public Sub DrawGradientCircle(dhDC As Long, CenterX As Long, CenterY As Long, Radius As Long, _
StartColor As Long, Optional EndColor As Long = -1, Optional ByVal Alpha As Byte = 192, _
Optional Inner As Boolean, Optional TriangleCount As Long = 36)
Dim Vertex() As TRIVERTEX
Dim Triangle() As GRADIENT_TRIANGLE
Dim Red(1) As Long, Green(1) As Long, Blue(1) As Long
Dim Theta As Double
Dim i As Long, j As Long
'CenterX,CenterY 圆心坐标
'Radius 半径
'StartColor起始填充色
'EndColor结束填充色，它是可选的，若小于零时忽略此参数，使用Alpha基于StartColor算出EndColor，实现高度填充效果
'Alpha用于计算StartColor的高亮色，0-255之间，越大越亮，若设置了EndColor，则忽略此参数
'Inner为渐变方式，为True时，StartColor到EndColor（或是alpha计算出的）颜色，按从外向内渐变，False则相反
'TriangleCount为三角形数量，默认为36个
Red(0) = StartColor And &HFF
Green(0) = (StartColor And &HFF00&) \ &H100&
Blue(0) = (StartColor And &HFF0000) \ &H10000
If EndColor < 0 Then
If Alpha < 0 Then Alpha = 0
Red(1) = (Red(0) * (256 - Alpha) + 255 * Alpha) \ 256
Green(1) = (Green(0) * (256 - Alpha) + 255 * Alpha) \ 256
Blue(1) = (Blue(0) * (256 - Alpha) + 255 * Alpha) \ 256
Else
Red(1) = EndColor And &HFF
Green(1) = (EndColor And &HFF00&) \ &H100&
Blue(1) = (EndColor And &HFF0000) \ &H10000
End If
If TriangleCount < 12 Then TriangleCount = 12
'设置所有三角形共有一个位于圆心的顶点
ReDim Vertex(TriangleCount)
With Vertex(0)
.x = CenterX
.y = CenterY
If Inner Then
j = 1
Else
j = 0
End If
.Red(1) = Red(j)
.Green(1) = Green(j)
.Blue(1) = Blue(j)
j = 1 - j
End With
'设置所有位于圆周上的三角形其它顶点，因三角形一个连一个，所以圆周上顶点数与三角形数是一样的
Theta = (3.1415926 * 2 / TriangleCount)
For i = 1 To TriangleCount
With Vertex(i)
.x = CenterX + Radius * Cos((i - 1) * Theta)
.y = CenterY + Radius * Sin((i - 1) * Theta)
.Red(1) = Red(j)
.Green(1) = Green(j)
.Blue(1) = Blue(j)
End With
Next

'设置每个三角形结构，为它们指定顶点
ReDim Triangle(TriangleCount - 1)
For i = 0 To TriangleCount - 1
Triangle(i).Vertex1 = 0
j = i + 1
Triangle(i).Vertex2 = j
j = i + 2
If j > TriangleCount Then j = 1
Triangle(i).Vertex3 = j
Next
GradientFillTriangle dhDC, Vertex(0), TriangleCount + 1, Triangle(0), TriangleCount, GRADIENT_FILL_TRIANGLE
End Sub

'处理好顶点与三角形或矩形，一次性传入，GradientFillTriangle能干的事情太多了，现在各种漂亮的界面，包括水晶效果都能用它绘出来，但愿这个函数能把那些还沉迷于描点画线做渐变的朋友们唤醒。
'有兴趣的朋友可把这个函数改一改，让它支持扇形渐变，当然，若能改成基于椭圆公式填充就更好了。