'============================================================
'DrawGraduC 中心（cx,cy）の円・楕円グラデーションを描く
'------引数--------------------------------------------------
'Pic 描画領域のオブジェ
'cx,cy 描画開始位置
'radius1,radius2 描画半径領域
'gapr 描画向き、１カウントごとの飛び
'aspect 縦横比（１の時円を描く）
'------注意--------------------------------------------------
'radius10:radius1>radius2→gapr<0
'============================================================
Public Sub DrawGradCircle(Pic As Object, _
cx As Long, cy As Long, _
radius1 As Long, radius2 As Long, _
gapr As Long, aspect As Single)
Dim r As Long, g As Long, b As Long
Dim i As Long
Dim temp As Long
Dim oldDrawWid As Long
oldDrawWid = Pic.DrawWidth
'DrawWidth = 1 では描画されない部分がある
Pic.DrawWidth = 2
r = r1: g = g1: b = b1
For i = 0& To Abs(radius2 - radius1)
If Abs(r - r2) >= Abs(rm) Then r = r1 + CLng(rm * CSng(i))
If Abs(g - g2) >= Abs(gm) Then g = g1 + CLng(gm * CSng(i))
If Abs(b - b2) >= Abs(bm) Then b = b1 + CLng(bm * CSng(i))
temp = i * gapr + Abs(radius1)
'軽いエラートラップ
If temp < 0& Then Exit For
Pic.Circle (cx, cy), temp, RGB(r, g, b), , , aspect
DoEvents
Next i
Pic.DrawWidth = oldDrawWid
End Sub
|
