如何用vb用描点法画圆

Answer 1

Function Dpp(x, y, x1, y1)
Dpp = Sqr((x - x1) ^ 2 + (y - y1) ^ 2)
End Function
Function Ry(r, x)
If Abs(x) < r Then
Ry = Sqr(r ^ 2 - x ^ 2)
Else
Ry = 0
End If
End Function
Sub myPset(x, y, r, g, b, w, s)
r = (r - w / 2) / s + 0.5
g = (g - w / 2) / s + 0.5
b = (b - w / 2) / s + 0.5
If r >= 1 And g >= 1 And b >= 1 Then Exit Sub
If r < 0 Then r = 0
If g < 0 Then g = 0
If b < 0 Then b = 0
PSet (x, y), RGB(r * 255, g * 255, b * 255)
End Sub
Sub myCircle(x0, y0, r, Optional w, Optional s)
Dim u, x, y1, y2, h, y, cr, cg, cb
If IsMissing(w) Then w = 1 '线宽
If IsMissing(s) Then s = 1 '平滑
u = (w + s) / 2
For x = Round(x0 - r - u) To Round(x0 + r + u)
y1 = Ry(r - u, x - x0)
y2 = Ry(r + u, x - x0)
For h = -1 To 1 Step 2
For y = Round(y0 + y1 * h) To Round(y0 + y2 * h) Step h
cr = Abs(r - Dpp(x0, y0, x - 1 / 3, y))
cg = Abs(r - Dpp(x0, y0, x, y))
cb = Abs(r - Dpp(x0, y0, x + 1 / 3, y))
myPset x, y, cr, cg, cb, w, s
Next y
Next h
Next x
End Sub
Private Sub Form_Load()
AutoRedraw = True
ScaleMode = 3
BackColor = vbWhite
Width = 490 * 15
Height = 310 * 15
Show
For w = 0 To 3 Step 0.5
CurrentX = w * 120 + 80 - TextWidth("线宽" & w) / 2
CurrentY = 10
Print "线宽" & w
For s = 0.5 To 2 Step 0.5
If w = 0 Then
CurrentX = 28 - TextWidth("平滑" & s) / 2
CurrentY = 120 * s - 6
Print "平滑" & s
End If
myCircle w * 120 + 80, 120 * s - 3, 25, w, s
DoEvents
Next s
Next w
End Sub