Code:
Private Declare Function Arc Lib "gdi32" (ByVal hDc As Long, ByVal nLeftRect As Long, ByVal nTopRect As Long, ByVal nRightRect As Long, ByVal nBottomRect As Long, ByVal nXStartArc As Long, ByVal nYStartArc As Long, ByVal nXEndArc As Long, ByVal nYEndArc As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hDc As Long, ByVal nLeftRect As Long, ByVal nTopRect As Long, ByVal nRightRect As Long, ByVal nBottomRect As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nDrawStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, Col As Long) As Long
' Sub Circle(Step As Integer, iX As Single, iY As Single, Radius As Single, Color As Long, StartArc As Single, EndArc As Single, Aspect As Single)
' When an arc or a partial circle or ellipse is drawn, StartArc and EndArc specify (in radians) the beginning and end positions of the arc.
' The range for both is 2 pi radians to 2 pi radians. The default value for StartArc is 0 radians; the default for EndArc is 2 * pi radians.
Sub DrawCircle(x As Single, y As Single, Radius As Single, Optional Color, Optional Aspect As Single = 1, Optional StartArc, Optional EndArc, Optional Step As Boolean)
Dim iXStartArc As Long, iYStartArc As Long, iXEndArc As Long, iYEndArc As Long
Dim iAspectX As Single
Dim iAspectY As Single
Dim iStartArc As Single
Dim iEndArc As Single
Dim iDontDraw As Boolean
Dim iFilledFigure As Boolean
Dim iColor As Long
Dim iPen As Long
Dim iPenPrev As Long
Dim iX As Long
Dim iY As Long
If Step Then
iX = Picture2.CurrentX + x
iY = Picture2.CurrentY + y
Else
iX = x
iY = y
End If
Picture2.Cls
If IsMissing(Color) Then
iColor = Picture2.ForeColor
Else
iColor = Color
End If
TranslateColor iColor, 0, iColor
If IsMissing(StartArc) And IsMissing(EndArc) Then
If Picture2.FillStyle = vbSolid Then
iFilledFigure = True
End If
End If
If Aspect > 1 Then
iAspectX = 1 / Aspect
iAspectY = 1
Else
iAspectX = 1
iAspectY = 1 * Aspect
End If
If IsMissing(StartArc) Then
iStartArc = 0
Else
iStartArc = StartArc
End If
If IsMissing(EndArc) Then
iEndArc = 0
' Note: 0 (zero) for EndArc seems to be handled as 2 * Pi by the API (in fact they are the same point)
Else
iEndArc = EndArc
End If
If Not IsMissing(EndArc) Then ' VB's Circle behaves like this: if StartArc and EndArc parameters are supplied and define an entire circle or ellipse, VB does not draw it
End If
If Not iDontDraw Then
iXStartArc = Radius * iAspectX * Cos(iStartArc) + iX
iYStartArc = Radius * iAspectY * Sin(iStartArc) * -1 + iY
iXEndArc = Radius * iAspectX * Cos(iEndArc) + iX
iYEndArc = Radius * iAspectY * Sin(iEndArc) * -1 + iY
If iColor <> Picture2.ForeColor Then
iPen = CreatePen(Picture2.DrawStyle, Picture2.DrawWidth, iColor)
iPenPrev = SelectObject(Picture2.hDc, iPen)
End If
If iFilledFigure Then
Ellipse Picture2.hDc, iX - Radius * iAspectX, iY - Radius * iAspectY, iX + Radius * iAspectX, iY + Radius * iAspectY
Else
Arc Picture2.hDc, iX - Radius * iAspectX, iY - Radius * iAspectY, iX + Radius * iAspectX, iY + Radius * iAspectY, iXStartArc, iYStartArc, iXEndArc, iYEndArc
End If
Picture2.Refresh
If iPenPrev <> 0 Then
Call SelectObject(Picture2.hDc, iPenPrev)
End If
If iPen <> 0 Then
DeleteObject iPen
End If
End If
Picture2.CurrentX = iX
Picture2.CurrentY = iY
End Sub