Forgetting to set that fillstyle
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:
Code:
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.
Code:
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:
Code:
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
Re: Forgetting to set that fillstyle
Perhaps you could attach a project? That is a lot of code to copy-paste. :-)
2 Attachment(s)
Re: Forgetting to set that fillstyle
Attachment 195577
Not a screenshot from above attached. But this is the project I'm making these for.
Attachment 195578
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.
Re: Forgetting to set that fillstyle
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.
1 Attachment(s)
Re: Forgetting to set that fillstyle
For reference purposes, this is what that same region looked like two days ago:
Attachment 195579
Re: Forgetting to set that fillstyle
This is the code I'm using to create the Indicators in the main project.
Code:
' 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.
Code:
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
