Forgetting to set that fillstyle

[cafeenman]

So I'm considering adding "retro" buttons to my app because anything like radio buttons and checkboxes just looks out of place.

I started making an Off/On switch a few hours ago and no matter how many times I checked my math it just didn't scootch.

Turns out that when it did work I had a line of code in there to set the fillstyle to solid.

But I removed it when I was moving things around.

Pulled my hair out until I figured that one out.

Code is very rough-drafty. It has nothing that figures out if the buttons overlap and honesty I don't plan to do anything about that until I need to.

Also haven't completed the horizontal orientation part yet but this is where I'm at.

Anyway, point is that too much of my life gets wasted tracking down mistakes like this and I wish I'd stop making them.

No questions but feedback is always appreciated.

If you want to try it then I'm using a picturebox.

Width = 465
Height = 795

Flat style.

Everything in the form:

Option Explicit


Private WithEvents mw_Switch1 As cSwitch1
Private WithEvents mw_Switch2 As cSwitch1
Private WithEvents mw_Switch3 As cSwitch1

Private Sub Form_Load()

Set mw_Switch1 = New cSwitch1
Set mw_Switch1.Picturebox = picSwitch1

Set mw_Switch2 = New cSwitch1
Set mw_Switch2.Picturebox = picSwitch2

Set mw_Switch3 = New cSwitch1
Set mw_Switch3.Picturebox = picSwitch3

End Sub

Bas module.

Option Explicit

Public Enum ON_BUTTON_LOCATION

  idx_On_Button_Location_LeftTop = 0
  idx_On_Button_Location_RightBottom = 1

End Enum

Public Enum SWITCH_ORIENTATION

  idx_Switch_Orientation_Vertical = 0
  idx_Switch_Orientation_Horizontal = 1

End Enum

Public Enum SWITCH_STATUS

  idx_Switch_Status_Off = vbUnchecked
  idx_Switch_Status_On = vbChecked

End Enum

Public Const ON_ON As Long = &HFF00&
Public Const ON_OFF As Long = &H8000&
Public Const OFF_ON As Long = &HFF&
Public Const OFF_OFF As Long = &H80&


Public Function InCircle(ByRef xCenter As Long, ByRef yCenter As Long, ByRef xPos As Single, ByRef yPos As Single, ByRef Radius As Long) As Boolean
Dim rLength As Double
Dim rX As Double
Dim rY As Double

' Determines if point (xPos, yPos) falls within a circle described by a center point and radius.

rX = xPos - xCenter
rY = yPos - yCenter

rLength = Sqr((rX * rX) + (rY * rY)) ' Measures distance from point to center of circle.
                                     ' If distance is larger than radius then point is not in circle.

If rLength <= Radius Then InCircle = True

End Function
Public Function ValidObject(ByRef Object As Object) As Boolean

ValidObject = Not Object Is Nothing

End Function

Switch Class:

Option Explicit

Private WithEvents mw_Picturebox As VB.Picturebox

Public Event Changed(ByRef ValueChanged As CheckBoxConstants)

Private nBackcolor As Long
Private nOnButtonLocation As ON_BUTTON_LOCATION
Private nOrientation As SWITCH_ORIENTATION
Private nValue As SWITCH_STATUS
Private nCenterX_On As Long
Private nCenterX_Y As Long
Private nCenterX_Off As Long
Private nCenterY_Off As Long


Public Property Get Backcolor() As Long

Backcolor = nBackcolor

End Property
Public Property Let Backcolor(ByRef Color As Long)

nBackcolor = Color

End Property
Public Property Get ButtonRadius() As Long
Dim nRadius As Long

With mw_Picturebox

  If .ScaleWidth < .ScaleHeight Then

    ButtonRadius = 0.25 * .ScaleWidth
  
  Else

    ButtonRadius = 0.25 * .ScaleHeight

  End If

End With

End Property
Private Sub DrawSwitch()

With mw_Picturebox

  If Orientation = idx_Switch_Orientation_Vertical Then

    If OnButtonLocation = idx_On_Button_Location_LeftTop Then

      .FillColor = vbBlack

      mw_Picturebox.Circle (CenterX_On, CenterY_On), ButtonRadius + 15

      .FillColor = IIf(Value = idx_Switch_Status_On, ON_ON, ON_OFF)

      mw_Picturebox.Circle (CenterX_On - 5, CenterY_On - 5), ButtonRadius

      .FillColor = vbBlack

      mw_Picturebox.Circle (CenterX_Off, CenterY_Off), ButtonRadius + 15

      .FillColor = IIf(Value = idx_Switch_Status_Off, OFF_ON, OFF_OFF)

      mw_Picturebox.Circle (CenterX_Off - 5, CenterY_Off - 5), ButtonRadius

    Else 'idx_On_Button_Location_RightBottom

    End If

  End If

End With

End Sub
Public Property Get OnButtonLocation() As ON_BUTTON_LOCATION

OnButtonLocation = nOnButtonLocation

End Property
Friend Property Let OnButtonLocation(ByRef Location As ON_BUTTON_LOCATION)

nOnButtonLocation = Location

End Property
Public Property Get CenterX_Off() As Long

Select Case Orientation

  Case idx_Switch_Orientation_Vertical

    CenterX_Off = mw_Picturebox.ScaleWidth / 2

  Case idx_Switch_Orientation_Horizontal

    CenterX_Off = mw_Picturebox.ScaleWidth - mw_Picturebox.ScaleHeight / 2

End Select

End Property
Public Property Get CenterY_Off() As Long

Select Case Orientation

  Case idx_Switch_Orientation_Vertical

    CenterY_Off = mw_Picturebox.ScaleHeight - CenterX_On

  Case idx_Switch_Orientation_Horizontal

    CenterY_Off = mw_Picturebox.ScaleHeight - mw_Picturebox.ScaleWidth / 2

End Select

End Property
Public Property Get CenterX_On() As Long

Select Case Orientation

  Case idx_Switch_Orientation_Vertical

    CenterX_On = mw_Picturebox.ScaleWidth / 2

  Case idx_Switch_Orientation_Horizontal

    CenterX_On = mw_Picturebox.ScaleHeight / 2

End Select

End Property
Public Property Get CenterY_On() As Long

Select Case Orientation

  Case idx_Switch_Orientation_Vertical

    CenterY_On = mw_Picturebox.ScaleWidth / 2

  Case idx_Switch_Orientation_Horizontal

    CenterY_On = mw_Picturebox.ScaleHeight / 2

End Select

End Property
Public Property Get Orientation() As SWITCH_ORIENTATION

Orientation = nOrientation

End Property
Friend Property Let Orientation(ByRef SwitchOrientation As SWITCH_ORIENTATION)

nOrientation = SwitchOrientation

End Property
Public Property Get Picturebox() As VB.Picturebox

If ValidObject(mw_Picturebox) Then

  Set Picturebox = mw_Picturebox

End If

End Property
Friend Property Set Picturebox(ByRef Picture As VB.Picturebox)

If Not ValidObject(Picture) Then Exit Property

Set mw_Picturebox = Picture

DrawSwitch

End Property
Public Property Get Value() As SWITCH_STATUS

Value = nValue

End Property
Private Sub mw_Picturebox_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim nCurrentValue As SWITCH_STATUS

If InCircle(CenterX_On, CenterY_On, X, Y, ButtonRadius) Then

  nValue = idx_Switch_Status_On

ElseIf InCircle(CenterX_Off, CenterY_Off, X, Y, ButtonRadius) Then

  nValue = idx_Switch_Status_Off

Else

  Exit Sub

End If

DrawSwitch

If Value <> nCurrentValueThen RaiseEvent Changed

End Sub
Private Sub Class_Initialize()

OnButtonLocation = idx_On_Button_Location_LeftTop
'OnButtonLocation = idx_On_Button_Location_RightBottom

End Sub