06-30-2022, 01:46 PM
(This post was last modified: 06-30-2022, 06:41 PM by bplus.
Edit Reason: Edit: 2nd Dim Shared line for Controls. It was missing an As Long for Type
)
Here is 3 Digit Color Picker I was talking about yesterday, run this file along side upcoming Control Designer Form for 3 digit colors 1000 colors. In screenshot I found closest pure green that matched Pic Box Title BC.
Code: (Select All)
Option _Explicit
'$include:'vs GUI.BI'
' Set Globals from BI your Title here VVV
Xmax = 400: Ymax = 540: GuiTitle$ = "3 Digit Color Picker"
OpenWindow Xmax, Ymax, GuiTitle$ ' need to do this before drawing anything from NewControls
' GUI Controls
' Dim and set Globals for GUI app
Dim Shared As Long lblC, TBC, btnC, picC, btnR0, btnG0, btnB0, btnRP, btnGP, btnBP, btnRM, btnGM, btnBM
Dim Shared As Long btnR9, btnG9, btnB9, btnR5, btnG5, btnB5
lblC = NewControl(4, 10, 20, 200, 32, "3 Digit Color:")
TBC = NewControl(2, 220, 20, 50, 32, "000")
btnC = NewControl(1, 290, 20, 100, 32, "Color")
picC = NewControl(5, 10, 70, 380, 200, "Color Sample")
btnR0 = NewControl(1, 30, 290, 100, 32, "Red 0")
btnG0 = NewControl(1, 150, 290, 100, 32, "Green 0")
btnB0 = NewControl(1, 270, 290, 100, 32, "Blue 0")
btnR5 = NewControl(1, 30, 340, 100, 32, "Red 5")
btnG5 = NewControl(1, 150, 340, 100, 32, "Green 5")
btnB5 = NewControl(1, 270, 340, 100, 32, "Blue 5")
btnR9 = NewControl(1, 30, 390, 100, 32, "Red 9")
btnG9 = NewControl(1, 150, 390, 100, 32, "Green 9")
btnB9 = NewControl(1, 270, 390, 100, 32, "Blue 9")
btnRP = NewControl(1, 30, 440, 100, 32, "Red +1")
btnGP = NewControl(1, 150, 440, 100, 32, "Green +1")
btnBP = NewControl(1, 270, 440, 100, 32, "Blue +1")
btnRM = NewControl(1, 30, 490, 100, 32, "Red -1")
btnGM = NewControl(1, 150, 490, 100, 32, "Green -1")
btnBM = NewControl(1, 270, 490, 100, 32, "Blue -1")
' End GUI Controls
Dim Shared As _Unsigned Long SampleC
MainRouter ' after all controls setup
Sub BtnClickEvent (i As Long)
Dim t3$
Select Case i
Case btnC ' update Color Sample from TB text
SampleC = c3S~&(con(TBC).Text)
_Dest con(picC).N1
Color , SampleC
Cls
_Dest 0
drwPic picC, 0
Case btnR0
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
Mid$(t3$, 1, 1) = "0"
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
Case btnG0
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
Mid$(t3$, 2, 1) = "0"
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
Case btnB0
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
Mid$(t3$, 3, 1) = "0"
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
Case btnRP
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
If Val(Mid$(t3$, 1, 1)) < 9 Then
Mid$(t3$, 1, 1) = _Trim$(Str$(Val(Mid$(t3$, 1, 1)) + 1))
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
End If
Case btnRM
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
If Val(Mid$(t3$, 1, 1)) > 0 Then
Mid$(t3$, 1, 1) = _Trim$(Str$(Val(Mid$(t3$, 1, 1)) - 1))
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
End If
Case btnGP
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
If Val(Mid$(t3$, 2, 1)) < 9 Then
Mid$(t3$, 2, 1) = _Trim$(Str$(Val(Mid$(t3$, 2, 1)) + 1))
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
End If
Case btnGM
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
If Val(Mid$(t3$, 2, 1)) > 0 Then
Mid$(t3$, 2, 1) = _Trim$(Str$(Val(Mid$(t3$, 2, 1)) - 1))
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
End If
Case btnBP
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
If Val(Mid$(t3$, 3, 1)) < 9 Then
Mid$(t3$, 3, 1) = _Trim$(Str$(Val(Mid$(t3$, 3, 1)) + 1))
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
End If
Case btnBM
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
If Val(Mid$(t3$, 3, 1)) > 0 Then
Mid$(t3$, 3, 1) = _Trim$(Str$(Val(Mid$(t3$, 3, 1)) - 1))
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
End If
Case btnR9
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
Mid$(t3$, 1, 1) = "9"
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
Case btnG9
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
Mid$(t3$, 2, 1) = "9"
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
Case btnB9
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
Mid$(t3$, 3, 1) = "9"
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
Case btnR5
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
Mid$(t3$, 1, 1) = "5"
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
Case btnG5
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
Mid$(t3$, 2, 1) = "5"
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
Case btnB5
t3$ = Right$("000" + _Trim$(con(TBC).Text), 3) ' make sure we are right size
Mid$(t3$, 3, 1) = "5"
con(TBC).Text = t3$
drwTB TBC, 0
BtnClickEvent btnC
End Select
End Sub
Sub LstSelectEvent (control As Long)
Select Case control
End Select
End Sub
Sub PicClickEvent (i As Long, Pmx As Long, Pmy As Long)
Select Case i
End Select
End Sub
Sub PicFrameUpdate (i As Long)
Select Case i
End Select
End Sub
Function c3S~& (digit3$) ' parameter as a string of 3 digits
Dim s3$
Dim As Long r, g, b
s3$ = Right$("000" + digit3$, 3)
r = Val(Mid$(s3$, 1, 1)): If r Then r = 28 * r + 3
g = Val(Mid$(s3$, 2, 1)): If g Then g = 28 * g + 3
b = Val(Mid$(s3$, 3, 1)): If b Then b = 28 * b + 3
c3S~& = _RGB32(r, g, b)
End Function
' not used in this app but is c3s~& partner in Coloring from 3 digits
Function c3I~& (i As Long) 'parameter as an integer up 0-999 noi red until 3rd digit!
Dim s3$
Dim As Long r, g, b
s3$ = Right$("000" + _Trim$(Str$(i)), 3)
r = Val(Mid$(s3$, 1, 1)): If r Then r = 28 * r + 3
g = Val(Mid$(s3$, 2, 1)): If g Then g = 28 * g + 3
b = Val(Mid$(s3$, 3, 1)): If b Then b = 28 * b + 3
c3I~& = _RGB32(r, g, b)
End Function
'$include:'vs GUI.BM'
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever