Private Declare Function Arc Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Sub DrawArc(ByVal hdc As Long, ByVal X As Integer, ByVal Y As Integer, ByVal StartAngle As Integer, ByVal EndAngle As Integer, ByVal radius As Integer)
Dim xs As Integer, ys As Integer, xe As Integer, ye As Integer
Dim sat As Integer
sat = (StartAngle - 90) Mod 360
If (StartAngle >= 360) And (sat = 0) Then
sat = 360
End If
xs = Int(X - (radius * Sin((sat / 180) * 3.14159267)))
ys = Int(Y - (radius * Cos((sat / 180) * 3.14159267)))
sat = (EndAngle - 90) Mod 360
If (EndAngle >= 360) And (sat = 0) Then
sat = 360
End If
xe = Int(X - (radius * Sin((sat / 180) * 3.14159267)))
ye = Int(Y - (radius * Cos((sat / 180) * 3.14159267)))
If Abs(EndAngle - StartAngle) < 360 Then
Arc hdc, X - radius, Y - radius, X + radius, Y + radius, xs, ys, xe, ye
Else
: Ellipse hdc, X - radius, Y - radius, X + radius, Y + radius
End If
End Sub
Private Sub UserControl_Initialize()
UserControl.ScaleMode = vbPixels
End Sub
Private Sub UserControl_InitProperties()
UserControl_Resize
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
UserControl_Resize
End Sub
Private Sub UserControl_Resize()
Dim intMinSize As Integer
UserControl.BackColor = UserControl.MaskColor
UserControl.FillColor = lngColor 'strClickColor
If UserControl.ScaleWidth <= UserControl.ScaleHeight Then
intMinSize = UserControl.ScaleWidth \ 2
Else
intMinSize = UserControl.ScaleHeight \ 2
End If
DrawArc UserControl.hdc, UserControl.ScaleWidth \ 2, UserControl.ScaleHeight \ 2, 0, 360, intMinSize
UserControl.FillColor = UserControl.MaskColor
DrawArc UserControl.hdc, UserControl.ScaleWidth \ 2, UserControl.ScaleHeight \ 2, 0, 360, intMinSize \ 2
Set UserControl.MaskPicture = UserControl.Image
UserControl.BackColor = lngColor 'strClickColor
End Sub