02-11-2026, 03:16 PM
I played around with making 3D Text earlier and couldn't get it to look like I wanted exactly. (Though @Petr did one helluva job and knocked it out of the ballpark for us!!) So, I thought I'd take a step back and try to play around with something different that I'm not so terrible with -- creating nice buttons and keys!!
These are currently set to work for keyboard keys, to replace the complicated and glitchy ones that were in my virtual keyboard. I've been working on trying to replicate the shapes of the unique keys on the keyboard -- windows command, apple option, the media keys and what not. Give this a test guys and see how it looks for a first run at it this morning. Already, there might be several little routines in here which folks might want to make use of. I really like the way the shader routine works for these buttons, and some of the buttons themselves I'm rather proud of, having made them with just simple line and circle commands.
There's a lot more to come in time, but give it a shot and see what you think so far. Am I on the right track here for something which others might find usable? Or is this getting over-engineered like I have a bad habit of doing?
I have a feeling that once I add per key highlighting and other such things, I'm going to end up making a routine with a bazillion different parameters to keep up with and pass, and I'm not entirely certain I want to get *THAT* extreme. LOL!! Test it. Kick it around. And tell me how much more complex you guys think this should/could be.
These are currently set to work for keyboard keys, to replace the complicated and glitchy ones that were in my virtual keyboard. I've been working on trying to replicate the shapes of the unique keys on the keyboard -- windows command, apple option, the media keys and what not. Give this a test guys and see how it looks for a first run at it this morning. Already, there might be several little routines in here which folks might want to make use of. I really like the way the shader routine works for these buttons, and some of the buttons themselves I'm rather proud of, having made them with just simple line and circle commands.
There's a lot more to come in time, but give it a shot and see what you think so far. Am I on the right track here for something which others might find usable? Or is this getting over-engineered like I have a bad habit of doing?
I have a feeling that once I add per key highlighting and other such things, I'm going to end up making a routine with a bazillion different parameters to keep up with and pass, and I'm not entirely certain I want to get *THAT* extreme. LOL!! Test it. Kick it around. And tell me how much more complex you guys think this should/could be.
Code: (Select All)
$Color:32
Screen _NewImage(640, 480, 32)
DrawKey3D 100, 100, 60, 60, _RGB32(40, 40, 40), "up", "opt"
DrawKey3D 50, 200, 300, 60, _RGB32(50, 50, 50), "up", "SPACE"
DrawKey3D 100, 300, 60, 60, _RGB32(40, 40, 40), "up", "up"
DrawKey3D 100, 360, 60, 60, _RGB32(40, 40, 40), "up", "down"
DrawKey3D 40, 360, 60, 60, _RGB32(40, 40, 40), "up", "left"
DrawKey3D 160, 360, 60, 60, _RGB32(40, 40, 40), "up", "right"
Sleep 'I'm only going to push half my keys down so you can see them in the down state
'also decided to go with different colors so you can see the shading in action with them
DrawKey3D 100, 100, 60, 60, Red, "down", "A"
DrawKey3D 50, 200, 300, 60, Green, "down", "" 'so you can see we don't need the word for the space bar
DrawKey3D 100, 300, 60, 60, Blue, "up", "play"
DrawKey3D 100, 360, 60, 60, White, "up", "pause"
DrawKey3D 40, 360, 60, 60, Yellow, "up", "record"
DrawKey3D 160, 360, 60, 60, Silver, "up", "backspace"
Sub RoundRectFill (x As Single, y As Single, x1 As Single, y1 As Single, r As Single, c As _Unsigned Long)
Dim a As Single, b As Single, e As Single
Line (x, y + r + 1)-(x1, y1 - r - 1), c, BF
a = r: b = 0: e = -a
Do While a >= b
Line (x + r - b, y + r - a)-(x1 - r + b, y + r - a), c, BF
Line (x + r - a, y + r - b)-(x1 - r + a, y + r - b), c, BF
Line (x + r - b, y1 - r + a)-(x1 - r + b, y1 - r + a), c, BF
Line (x + r - a, y1 - r + b)-(x1 - r + a, y1 - r + b), c, BF
b = b + 1: e = e + b + b
If e > 0 Then a = a - 1: e = e - a - a
Loop
End Sub
Function ShadeColor~& (col~&, factor As Single)
Dim r As Integer, g As Integer, b As Integer
r = _Red32(col~&): g = _Green32(col~&): b = _Blue32(col~&)
r = r * factor: If r > 255 Then r = 255
g = g * factor: If g > 255 Then g = 255
b = b * factor: If b > 255 Then b = 255
ShadeColor~& = _RGB32(r, g, b)
End Function
Sub DrawCenteredText (cx As Integer, cy As Integer, txt$, col~&)
Dim tw As Integer, th As Integer, c As _Unsigned Long, d As _Unsigned Long
c = _DefaultColor: d = _BackgroundColor
tw = _UPrintWidth(txt$): th = _UFontHeight
Color col~&, 0
_UPrintString (cx - tw \ 2, cy - th \ 2), txt$
Color c, d
End Sub
Sub DrawIcon (x As Integer, y As Integer, w As Integer, h As Integer, icon$, col~&)
Dim cx As Integer, cy As Integer
Dim As Integer scale, pad, paneW, paneH, rr, ix, iy
cx = x + w \ 2: cy = y + h \ 2
Color col~&
Select Case icon$
Case "up"
Line (cx, cy - h \ 4)-(cx, cy + h \ 6)
Line (cx, cy - h \ 4)-(cx - w \ 6, cy - h \ 10)
Line (cx, cy - h \ 4)-(cx + w \ 6, cy - h \ 10)
Case "down"
Line (cx, cy - h \ 6)-(cx, cy + h \ 4)
Line (cx, cy + h \ 4)-(cx - w \ 6, cy + h \ 10)
Line (cx, cy + h \ 4)-(cx + w \ 6, cy + h \ 10)
Case "left"
Line (cx - w \ 4, cy)-(cx + w \ 6, cy)
Line (cx - w \ 4, cy)-(cx - w \ 10, cy - h \ 6)
Line (cx - w \ 4, cy)-(cx - w \ 10, cy + h \ 6)
Case "right"
Line (cx + w \ 4, cy)-(cx - w \ 6, cy)
Line (cx + w \ 4, cy)-(cx + w \ 10, cy - h \ 6)
Line (cx + w \ 4, cy)-(cx + w \ 10, cy + h \ 6)
Case "play"
Line (cx - w \ 10, cy - h \ 6)-(cx + w \ 6, cy)
Line (cx + w \ 6, cy)-(cx - w \ 10, cy + h \ 6)
Line (cx - w \ 10, cy + h \ 6)-(cx - w \ 10, cy - h \ 6)
Case "pause"
Line (cx - w \ 10, cy - h \ 6)-(cx - w \ 10, cy + h \ 6)
Line (cx + w \ 10, cy - h \ 6)-(cx + w \ 10, cy + h \ 6)
Case "stop"
Line (cx - w \ 8, cy - h \ 8)-(cx + w \ 8, cy - h \ 8)
Line (cx + w \ 8, cy - h \ 8)-(cx + w \ 8, cy + h \ 8)
Line (cx + w \ 8, cy + h \ 8)-(cx - w \ 8, cy + h \ 8)
Line (cx - w \ 8, cy + h \ 8)-(cx - w \ 8, cy - h \ 8)
Case "record"
Circle (cx, cy), h \ 6, col~&
Paint (cx, cy), col~&, col~&
Case "cmd", "command"
' Modern Windows logo: 4 rounded squares, scaled smaller to center nicely
scale = 50 ' percent of icon area to use (adjust for taste)
ix = x + (w - (w * scale \ 100)) \ 2: iy = y + (h - (h * scale \ 100)) \ 2
w = w * scale \ 100: h = h * scale \ 100: pad = w \ 10
paneW = (w - pad * 3) \ 2: paneH = (h - pad * 3) \ 2: rr = paneW \ 6
RoundRectFill ix + pad, iy + pad, ix + pad + paneW, iy + pad + paneH, rr, col~& ' Top-left pane
RoundRectFill ix + pad * 2 + paneW, iy + pad, ix + pad * 2 + paneW * 2, iy + pad + paneH, rr, col~& ' Top-right pane
RoundRectFill ix + pad, iy + pad * 2 + paneH, ix + pad + paneW, iy + pad * 2 + paneH * 2, rr, col~& ' Bottom-left pane
RoundRectFill ix + pad * 2 + paneW, iy + pad * 2 + paneH, ix + pad * 2 + paneW * 2, iy + pad * 2 + paneH * 2, rr, col~& ' Bottom-right pane
Case "opt", "option"
Dim As Integer arm, t
scale = 50
iw = w * scale \ 100: ih = h * scale \ 100: ix = x + (w - iw) \ 2: iy = y + (h - ih) \ 2
cx = ix + iw \ 2: cy = iy + ih \ 2: arm = iw \ 4: t = arm / 2
Line (cx - t, cy - arm)-(cx - t, cy + arm), col~&
Line (cx + t, cy - arm)-(cx + t, cy + arm), col~&
Line (cx - arm, cy - t)-(cx + arm, cy - t), col~&
Line (cx - arm, cy + t)-(cx + arm, cy + t), col~&
Circle (cx - arm, cy - arm), t, col~&, _D2R(0), _D2R(270) ' Top-left loop
Circle (cx + arm, cy - arm), t, col~&, _D2R(270), _D2R(180) ' Top-right loop
Circle (cx + arm, cy + arm), t, col~&, _D2R(180), _D2R(90) ' Bottom-right loop
Circle (cx - arm, cy + arm), t, col~&, _D2R(90), 0 ' Bottom-left loop
Case "ctrl", "control"
' Control symbol: caret-like shape
Line (cx - w \ 6, cy + h \ 6)-(cx, cy - h \ 6)
Line (cx, cy - h \ 6)-(cx + w \ 6, cy + h \ 6)
Case "enter"
Line (cx + w \ 6, cy - h \ 6)-(cx + w \ 6, cy)
Line (cx + w \ 6, cy)-(cx - w \ 10, cy)
Line (cx - w \ 10, cy)-(cx - w \ 20, cy - h \ 10)
Line (cx - w \ 10, cy)-(cx - w \ 20, cy + h \ 10)
Case "backspace"
Dim tipX As Integer: tipX = cx - w \ 3 ' arrow tip further left than box
Line (cx - w \ 6, cy - h \ 6)-(cx + w \ 6, cy - h \ 6) ' Top horizontal edge of box
Line (cx + w \ 6, cy - h \ 6)-(cx + w \ 6, cy + h \ 6) ' Right vertical edge of box
Line (cx + w \ 6, cy + h \ 6)-(cx - w \ 6, cy + h \ 6) ' Bottom horizontal edge of box
Line (cx - w \ 6, cy - h \ 6)-(tipX, cy) ' Left slanted edges forming a true "<" arrowhead
Line (tipX, cy)-(cx - w \ 6, cy + h \ 6)
Case "tab"
Line (cx - w \ 6, cy)-(cx + w \ 6, cy)
Line (cx + w \ 6, cy)-(cx + w \ 10, cy - h \ 6)
Line (cx + w \ 6, cy)-(cx + w \ 10, cy + h \ 6)
Line (cx - w \ 6, cy)-(cx - w \ 10, cy - h \ 6)
Line (cx - w \ 6, cy)-(cx - w \ 10, cy + h \ 6)
End Select
End Sub
Sub DrawKey3D (x As Integer, y As Integer, w As Integer, h As Integer, baseColor~&, state$, label$)
Dim As Integer r
Dim As _Unsigned Long Top, Bottom, textColor
r = h \ 4
' Auto text color (light text on dark keys, dark text on light keys)
If _Red32(baseColor~&) + _Green32(baseColor~&) + _Blue32(baseColor~&) < 350 Then
textColor = _RGB32(240, 240, 240)
Else
textColor = _RGB32(20, 20, 20)
End If
If LCase$(state$) = "down" Then ' Shading based on user color
Top = ShadeColor~&(baseColor~&, 0.45)
Bottom = ShadeColor~&(baseColor~&, 0.25)
Else
Top = ShadeColor~&(baseColor~&, 0.75)
Bottom = ShadeColor~&(baseColor~&, 0.50)
End If
RoundRectFill x, y, x + w, y + h, r, Bottom ' Outer rim
RoundRectFill x + 3, y + 3, x + w - 6, y + h - 6, r - 2, Top ' Inner face
Select Case LCase$(label$) ' Draw text or icon
Case "up", "down", "left", "right", "play", "pause", "stop", "record", "cmd", "command", "opt", "option",_
"ctrl", "control", "enter", "backspace", "tab"
DrawIcon x + 3, y + 3, w - 6, h - 6, LCase$(label$), textColor
Case Else: DrawCenteredText x + w \ 2, y + h \ 2, label$, textColor
End Select
End Sub