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

[Peter Swinkels]

Perhaps you could attach a project? That is a lot of code to copy-paste. :-)

[cafeenman]

Switch.zip

Not a screenshot from above attached. But this is the project I'm making these for.



These are Indicators and Switches (different classes).

The Switches (Red) are Toggles. When clicked Value = Not Value.

The Indicators (Blue) show status but don't respond to clicks.

Also too, I haven't hooked up the label to do anything when they click. I'm not sure that I want to.

They would do the same thing as clicking the Indicator/Switch.

But I think I like having to click the actual button better.

I could add a Method AllowLabelClicks (that is overridden by IgnoreClicks).

Edit again. Also, also too, I keep forgetting to add a thing to check for which mouse button gets clicks.

E.g. if Button <> 1 Then Exit Sub.

I really need to do that because right now any mouse button will toggle the switch and that's just not how things are done.

Easy fix. I just need to remember to do it.

So much to do...

I'm glad I'm immortal.

[cafeenman]

The location of the fasteners in the corners could be improved a lot.

I think the way to do it would be to calculate a line from the center of the circle to a corner then (first try) split the difference between the corner and the circumference of the circle. Adjust according to how it looks.

As is I'm just plopping them down there where they're good at small sizes but if the indicator gets bigger then they're too far in the corner because I used magic numbers instead of doing the work.

Again, this is all in development so getting it working right is first priority. Then churching it up as I go along.

[cafeenman]

For reference purposes, this is what that same region looked like two days ago:

[cafeenman]

This is the code I'm using to create the Indicators in the main project.

' Declarations

Private colIndicators As Collection
Private colSwitches As Collection

Private WithEvents mw_Indicator_ANN As cIndicator
Private WithEvents mw_Indicator_ATT As cIndicator
Private WithEvents mw_Indicator_DED As cIndicator
Private WithEvents mw_Indicator_DND As cIndicator
Private WithEvents mw_Indicator_ET As cIndicator
Private WithEvents mw_Indicator_GEAR As cIndicator
Private WithEvents mw_Indicator_HACK As cIndicator
Private WithEvents mw_Indicator_MEM As cIndicator
Private WithEvents mw_Indicator_RHI As cIndicator
Private WithEvents mw_Indicator_RHII As cIndicator
Private WithEvents mw_Indicator_RHIII As cIndicator
Private WithEvents mw_Indicator_RHIV As cIndicator
Private WithEvents mw_Indicator_RPT As cIndicator

Private WithEvents mw_Indicator_SH As cIndicator
Private WithEvents mw_Indicator_SND As cIndicator
Private WithEvents mw_Indicator_TFR As cIndicator

Private WithEvents mw_Indicator_DEC As cIndicator
Private WithEvents mw_Indicator_EWS As cIndicator
Private WithEvents mw_Indicator_FW As cIndicator

Public Enum LABEL_POSITION

  idx_LabelPosition_Top = 0
  idx_LabelPosition_Bottom = 1
  idx_LabelPosition_Left
  idx_LabelPosition_Right

End Enum

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 = False
  idx_Switch_Status_On = True

End Enum

Public Const DEFAULT_ON_OFF_COLOR As Long = &H8000&
Public Const DEFAULT_ON_ON_COLOR As Long = &HC000&
Public Const DEFAULT_OFF_OFF_COLOR As Long = &HC0&
Public Const DEFAULT_OFF_ON_COLOR As Long = &H80&

Creation.

Private Sub CreateIndicators()
Dim m_Indicator As cIndicator

' // Indicators.

Set colIndicators = New Collection

Set mw_Indicator_DND = CreateSwitch(picIndicator_DnD, lblIndicator_DnD, idx_LabelPosition_Left, "Do Not Disturb.", colIndicators)
Set mw_Indicator_MEM = CreateSwitch(picIndicator_MEM, lblIndicator_MEM, idx_LabelPosition_Right, "Memory.", colIndicators)
Set mw_Indicator_ATT = CreateSwitch(picIndicator_ATT, lblIndicator_ATT, idx_LabelPosition_Left, "Attribute Point.", colIndicators)
Set mw_Indicator_ET = CreateSwitch(picIndicator_ET, lblIndicator_ET, idx_LabelPosition_Right, "Aliens.", colIndicators)
Set mw_Indicator_ANN = CreateSwitch(picIndicator_ANN, lblIndicator_ANN, idx_LabelPosition_Left, "Announcement.", colIndicators)
Set mw_Indicator_HACK = CreateSwitch(picIndicator_HACK, lblIndicator_HACK, idx_LabelPosition_Right, "System Security.", colIndicators)
Set mw_Indicator_GEAR = CreateSwitch(picIndicator_GEAR, lblIndicator_GEAR, idx_LabelPosition_Left, "Gear.", colIndicators)
Set mw_Indicator_SND = CreateSwitch(picIndicator_SND, lblIndicator_SND, idx_LabelPosition_Right, "Photorealistic Sound.", colIndicators)
Set mw_Indicator_DED = CreateSwitch(picIndicator_DED, lblIndicator_DED, idx_LabelPosition_Right, "Dead.", colIndicators)
Set mw_Indicator_TFR = CreateSwitch(picIndicator_TFR, lblIndicator_TFR, idx_LabelPosition_Left, "Offshore Transfer.", colIndicators)
Set mw_Indicator_RHI = CreateSwitch(picIndicator_RHI, lblIndicator_RHI, idx_LabelPosition_Left, "Random Happenings I.", colIndicators)
Set mw_Indicator_RHII = CreateSwitch(picIndicator_RHII, lblIndicator_RHII, idx_LabelPosition_Right, "Random Happenings II.", colIndicators)
Set mw_Indicator_RHIII = CreateSwitch(picIndicator_RHIII, lblIndicator_RHIII, idx_LabelPosition_Left, "Random Happenings III.", colIndicators)
Set mw_Indicator_RHIV = CreateSwitch(picIndicator_RHIV, lblIndicator_RHIV, idx_LabelPosition_Right, "Random Happenings IV.", colIndicators)
Set mw_Indicator_SH = CreateSwitch(picIndicator_SH, lblIndicator_SH, idx_LabelPosition_Left, "Subliminal Happenings.", colIndicators)
Set mw_Indicator_RPT = CreateSwitch(picIndicator_RPT, lblIndicator_RPT, idx_LabelPosition_Right, "Report.", colIndicators)

For Each m_Indicator In colIndicators

  With m_Indicator

    .Backcolor = &H404040
    .OffColor = &H400000
    .OnColor = &HC00000
    .CompanionLabel.Fontsize = 8
    .IgnoreClicks = True

    .Value = idx_Switch_Status_Off

    .Refresh

  End With

Next m_Indicator

' // Toggle Switches.

Set colSwitches = New Collection

Set mw_Indicator_EWS = CreateSwitch(picIndicator_EWS, lblIndicator_EWS, idx_LabelPosition_Left, "Early Warning System.", colSwitches)
Set mw_Indicator_DEC = CreateSwitch(picIndicator_DEC, lblIndicator_DEC, idx_LabelPosition_Left, "Event Deceleration.", colSwitches)
Set mw_Indicator_FW = CreateSwitch(picIndicator_FW, lblIndicator_FW, idx_LabelPosition_Left, "Fancy Words.", colSwitches)

For Each m_Indicator In colSwitches

  With m_Indicator

    .Backcolor = &H404040
    .OffColor = &H400000
    .OnColor = &H255FB4
    .Backcolor = &H404040
    .IgnoreClicks = False

    .Value = idx_Switch_Status_On

    .Refresh

  End With

Next m_Indicator

End Sub

Public Function CreateSwitch(ByRef Picturebox As VB.Picturebox, ByRef Label As VB.Label, ByRef LabelPosition As LABEL_POSITION, ByRef Tooltip As String, ByRef SwitchCollection As Collection) As cIndicator
Dim m_Indicator As cIndicator

Set m_Indicator = New cIndicator

With m_Indicator

  Set .Picturebox = Picturebox
  Set .CompanionLabel = Label
  .LabelPosition = LabelPosition
  .ToolTipText = Tooltip

End With

SwitchCollection.Add m_Indicator

Set CreateSwitch = m_Indicator

End Function