Microsoft Small Basic

Program Listing: NVQ042

List Program

' Color Slider 0.1
' Copyright (c) 2012 Nonki Takahashi. All rights reserved.
'
' History :
' 0.1 2012/06/23 Created.
'
' Reference :
' [1] James D. Foley, Andries Van Dam "Fundamentals of Interactive Computer Graphics" 1982

' define constant
UNDEFINED = "N/A"
DELTA = 40
BEGIN = 80
BGCOLOR = "Gray"
BORDERCOLOR = "#666666"
TEXTCOLOR = "White"
SLITCOLOR = "#555555"
BARCOLOR = "YellowGreen"
BOXCOLOR = "LightGray"
Init()
sliderMoved = "False"
While "True"
If sliderMoved Then
oSlider = oClicked
Slider_GetMouseLevel()
Slider_Move()
AdjustSlider()
GetColor()
ShowColor() ' for copy of web color
DrawColorRect()
sliderMoved = "False"
Else
Program.Delay(200)
EndIf
EndWhile
' program end

Sub AdjustSlider
' param oClicked
If oClicked = oHue Or oClicked = oLightness Or oClicked = oSaturation Then
oSlider = oClicked
If oClicked = oHue Then
Slider_GetLevel()
rHue = level
ElseIf oClicked = oLightness Then
Slider_GetLevel()
rLightness = level / 100
Else
Slider_GetLevel()
rSaturation = level / 100
EndIf
Color_HSLtoRGB()
oSlider = oRed
level = iR
Slider_Move()
oSlider = oGreen
level = iG
Slider_Move()
oSlider = oBlue
level = iB
Slider_Move()
Else
GetColor()
sColor = GraphicsWindow.GetColorFromRGB(red, green, blue)
Color_RGBtoHSL()
If rHue = UNDEFINED Then
rHue = 0
EndIf
level = Math.Floor(rHue)
oSlider = oHue
Slider_Move()
level = Math.Floor(rSaturation * 100)
oSlider = oSaturation
Slider_Move()
level = Math.Floor(rLightness * 100)
oSlider = oLightness
Slider_Move()
EndIf
EndSub

Sub DrawColorRect
' param color - color of rectangle
' param x, y - position of rectangle
' param width, height - size of rectangle
GraphicsWindow.BrushColor = color
GraphicsWindow.FillRectangle(x, y, width, height)
GraphicsWindow.PenColor = BORDERCOLOR
GraphicsWindow.DrawRectangle(x, y, width, height)
EndSub

Sub GetColor
' return color
oSlider = oRed
Slider_GetLevel()
red = level
oSlider = oGreen
Slider_GetLevel()
green = level
oSlider = oBlue
Slider_GetLevel()
blue = level
color = GraphicsWindow.GetColorFromRGB(red, green, blue)
EndSub

Sub Init
' initialize sliders
GraphicsWindow.Title = "Color Slider 0.1"
GraphicsWindow.BackgroundColor = BGCOLOR
width = 256
min = 0
max = 255
left = 80
' add red slider
top = BEGIN
caption = "R"
Slider_Add()
oRed = oSlider
' add green slider
top = top + DELTA
caption = "G"
Slider_Add()
oGreen = oSlider
' add blue slider
top = top + DELTA
caption = "B"
Slider_Add()
oBlue = oSlider
' add hue slider
width = 360
top = top + DELTA
max = 360
caption = "H"
Slider_Add()
oHue = oSlider
' add saturation slider
width = 100
top = top + DELTA
max = 100
caption = "S"
Slider_Add()
oSaturation = oSlider
' add lightness slider
width = 100
top = top + DELTA
max = 100
caption = "L"
Slider_Add()
oLightness = oSlider
AdjustSlider()
' add text box
GraphicsWindow.BrushColor = "Black"
top = top + DELTA
oColor = Controls.AddTextBox(left, top)
' draw color rectangle
GetColor()
ShowColor()
x = 440
y = BEGIN
width = 100
height = 100
DrawColorRect()
GraphicsWindow.MouseUp = Slider_OnMouseUp
GraphicsWindow.MouseDown = Slider_OnMouseDown
EndSub

Sub ShowColor
' param oColor
' param color
Controls.SetTextBoxText(oColor, color)
EndSub

Sub Color_HSLtoRGB
' Color | Convert HSL to RGB
' param rHue - [0, 360) or UNDEFINED
' param rLightness - [0, 1]
' param rSaturation - [0, 1]
' return iR, iG, iB - RGB color
' return sColor - "#rrggbb"
If rLightness <= 0.5 Then
rN2 = rLightness * (1 + rSaturation)
Else
rN2 = rLightness + rSaturation - rLightness * rSaturation
EndIf
rN1 = 2 * rLightness - rN2
If rSaturation = 0 Then
iR = Math.Round(rLightness * 255)
iG = Math.Round(rLightness * 255)
iB = Math.Round(rLightness * 255)
Else
rH = rHue + 120
Color_Value()
iR = iValue
rH = rHue
Color_Value()
iG = iValue
rH = rHue - 120
Color_Value()
iB = iValue
EndIf
sColor = GraphicsWindow.GetColorFromRGB(iR, iG, iB)
EndSub

Sub Color_ColorToRGB
' Color | Convert Color to RGB
' param sColor - "#rrggbb"
' return iR, iG, iB - [0, 255]
sR = Text.GetSubText(sColor, 2, 2)
sG = Text.GetSubText(sColor, 4, 2)
sB = Text.GetSubText(sColor, 6, 2)
sHex = sR
Math_Hex2Dec()
iR = iDec
sHex = sG
Math_Hex2Dec()
iG = iDec
sHex = sB
Math_Hex2Dec()
iB = iDec
EndSub

Sub Color_RGBtoHSL
' Color | Convert RGB to HSL
' param sColor - "#rrggbb"
' return rHue - [0, 360) or UNDEFINED
' return rLightness - (0, 1)
' return rSaturation - (0, 1)
Color_ColorToRGB()
' rR = iR / 255 ' occurs Math.Max() bug
rR = Math.Round(iR / 255 * 10000) / 10000
' rG = iG / 255 ' occurs Math.Max() bug
rG = Math.Round(iG / 255 * 10000) / 10000
' rB = iB / 255 ' occurs Math.Max() bug
rB = Math.Round(iB / 255 * 10000) / 10000
rMax = Math.Max(rR, rG)
rMax = Math.Max(rMax, rB)
rMin = Math.Min(rR, rG)
rMin = Math.Min(rMin, rB)
rLightness = (rMax + rMin) / 2
If rMax = rMin Then ' rR = rG = rB
rSaturation = 0
rHue = UNDEFINED
Else
If rLightness <= 0.5 Then
rSaturation = (rMax - rMin) / (rMax + rMin)
Else
rSaturation = (rMax - rMin) / (2 - rMax - rMin)
EndIf
rRC = (rMax - rR) / (rMax - rMin)
rGC = (rMax - rG) / (rMax - rMin)
rBC = (rMax - rB) / (rMax - rMin)
If rR = rMax Then ' between Yellow and Magenta
rHue = rBC - rGC
ElseIf rG = rMax Then ' between Cyan and Yellow
rHue = 2 + rRC - rBC
ElseIf rB = rMax Then ' between Magenta and Cyan
rHue = 4 + rGC - rRC
Else
TextWindow.WriteLine("Error:")
TextWindow.WriteLine("rMax=" + rMax)
TextWindow.WriteLine("rR=" + rR + ",sR=" + sR)
TextWindow.WriteLine("rG=" + rG + ",sG=" + sG)
TextWindow.WriteLine("rB=" + rB + ",sB=" + sB)
EndIf
rHue = rHue * 60
If rHue < 0 Then
rHue = rHue + 360
EndIf
EndIf
EndSub

Sub Color_Value
' Color | Function value
' param rN1, rN2
' param rH - [-120, 480)
' return iValue - 0..255
If rH >= 360 Then
rH = rH - 360
EndIF
If rH < 0 Then
rH = rH + 360
EndIF
If rH < 60 Then
rV = rN1 + (rN2 - rN1) * rH / 60
ElseIf rH < 180 Then
rV = rN2
ElseIf rH < 240 Then
rV = rN1 + (rN2 - rN1) * (240 - rH) / 60
Else
rV = rN1
EndIf
iValue = Math.Round(rV * 255)
EndSub

Sub Math_Hex2Dec
' Math | Convert hexadecimal to decimal
' param sHex
' return iDec
iDec = 0
iLen = Text.GetLength(sHex)
For iPtr = 1 To iLen
iDec = iDec * 16 + Text.GetIndexOf("0123456789ABCDEF", Text.GetSubText(sHex, iPtr, 1)) - 1
EndFor
EndSub

Sub Slider_Add
' param width
' param caption
' param min, max
' param left, top
' return oSlider
numSlider = numSlider + 1
oSlider = "Slider" + numSlider
' add shapes for slider
GraphicsWindow.BrushColor = TEXTCOLOR
prop[oSlider + ".text"] = caption
prop[oSlider + ".caption"] = Shapes.AddText(caption)
level = Math.Floor((min + max) / 2)
prop[oSlider + ".level"] = level
GraphicsWindow.BrushColor = BARCOLOR
GraphicsWindow.PenColor = BORDERCOLOR
mag = (level - min) / (max - min)
GraphicsWindow.FillRectangle(left, top + 4, Math.Floor(width * mag), 10)
GraphicsWindow.DrawRectangle(left, top + 4, Math.Floor(width * mag), 10)
GraphicsWindow.BrushColor = SLITCOLOR
GraphicsWindow.FillRectangle(left + Math.Floor(width * mag), top + 4, Math.Floor(width * (1 - mag)), 10)
GraphicsWindow.DrawRectangle(left + Math.Floor(width * mag), top + 4, Math.Floor(width * (1 - mag)), 10)
GraphicsWindow.PenColor = BORDERCOLOR
GraphicsWindow.BrushColor = BOXCOLOR
prop[oSlider + ".box"] = Shapes.AddRectangle(10, 18)
prop[oSlider + ".min"] = min
prop[oSlider + ".max"] = max
GraphicsWindow.BrushColor = TEXTCOLOR
prop[oSlider + ".value"] = Shapes.AddText(level)
' move shapes for slider
len = Text.GetLength(caption)
Shapes.Move(prop[oSlider + ".caption"], left - (len * 5 + 10), top + 1)
Shapes.Move(prop[oSlider + ".slit"], left, top + 4)
prop[oSlider + ".x0"] = left
prop[oSlider + ".x1"] = left + width
prop[oSlider + ".y0"] = top
Shapes.Move(prop[oSlider + ".bar"], left, top + 4)
Shapes.Move(prop[oSlider + ".box"], left + Math.Floor(width * mag) - 5, top)
Shapes.Move(prop[oSlider + ".value"], left + width + 6, top + 1)
prop[oSlider + ".x2"] = left + Math.Floor(width * mag) - 5
prop[oSlider + ".x3"] = left + Math.Floor(width * mag) - 5 + 10
prop[oSlider + ".y2"] = top
prop[oSlider + ".y3"] = top + 18
EndSub

Sub Slider_CheckClicked
' param oSlider
' return oClicked - clicked slider
x2 = prop[oSlider + ".x2"]
x3 = prop[oSlider + ".x3"]
y2 = prop[oSlider + ".y2"]
y3 = prop[oSlider + ".y3"]
If x2 <= xMouse And xMouse <= x3 And y2 <= yMouse And yMouse <= y3 Then
GraphicsWindow.MouseMove = Slider_OnMouseMove
oClicked = oSlider
EndIf
EndSub

Sub Slider_GetLevel
' param oSlider
' return level
level = prop[oSlider + ".level"]
EndSub

Sub Slider_GetMouseLevel
' param oSlider
' return level
x0 = prop[oSlider + ".x0"]
x1 = prop[oSlider + ".x1"]
max = prop[oSlider + ".max"]
min = prop[oSlider + ".min"]
level = min + Math.Floor((max - min) * (xMouse - x0) / (x1 - x0))
EndSub

Sub Slider_Move
' param oSlider
' param level
Stack.PushValue("local", width)
x0 = prop[oSlider + ".x0"]
x1 = prop[oSlider + ".x1"]
y0 = prop[oSlider + ".y0"]
width = x1 - x0
prop[oSlider + ".level"] = level
Shapes.SetText(prop[oSlider + ".value"], level)
' redraw bar
GraphicsWindow.BrushColor = BARCOLOR
GraphicsWindow.PenColor = BORDERCOLOR
min = prop[oSlider + ".min"]
max = prop[oSlider + ".max"]
mag = (level - min) / (max - min)
GraphicsWindow.FillRectangle(x0, y0 + 4, Math.Floor(width * mag), 10)
GraphicsWindow.DrawRectangle(x0, y0 + 4, Math.Floor(width * mag), 10)
GraphicsWindow.BrushColor = SLITCOLOR
GraphicsWindow.FillRectangle(x0 + Math.Floor(width * mag), y0 + 4, Math.Floor(width * (1 - mag)), 10)
GraphicsWindow.DrawRectangle(x0 + Math.Floor(width * mag), y0 + 4, Math.Floor(width * (1 - mag)), 10)
' move box
Shapes.Move(prop[oSlider + ".box"], x0 + Math.Floor(width * mag) - 5, y0)
prop[oSlider + ".x2"] = x0 + Math.Floor(width * mag) - 5
prop[oSlider + ".x3"] = x0 + Math.Floor(width * mag) - 5 + 10
prop[oSlider + ".y2"] = y0
prop[oSlider + ".y3"] = y0 + 18
width = Stack.PopValue("local")
EndSub

Sub Slider_OnMouseDown
' return oClicked - clicked slider
xMouse = GraphicsWindow.MouseX
yMouse = GraphicsWindow.MouseY
oClicked = ""
For i = 1 To numSlider
oSlider = "Slider" + i
Slider_CheckClicked()
EndFor
EndSub

Sub Slider_OnMouseMove
sliderMoved = "True"
xMouse = GraphicsWindow.MouseX
x0 = prop[oClicked + ".x0"]
x1 = prop[oClicked + ".x1"]
If xMouse < x0 Then
xMouse = x0
EndIf
If x1 < xMouse Then
xMouse = x1
EndIf
EndSub

Sub Slider_OnMouseUp
GraphicsWindow.MouseMove = Slider_DoNothing
EndSub

Sub Slider_DoNothing
EndSub