Not about the "Bat Signal" that's just for TheBOB's benefit. Helps him find his way here. It's about...
Clickable buttons for a graphics WP routine.
(Requires fonts in attachment. They are really nice ones for mono-spaced use.)
Well I nearly posted this in the help forum, but it works, so no actual help is needed with the coding. My question is more along the lines of the approach. If you had to make this type of routine, would you do it this way or another way such as using a hardware overlay method, using images with _putimage, etc. I'd figure I'd ask so I don't end up getting too comfortable with doing it one way, when using another method would demonstrate better results.
The part of the code that produces the buttons is in both in the main and skin routines.
The fonts to use in it are attached, below.
Pete
Clickable buttons for a graphics WP routine.
(Requires fonts in attachment. They are really nice ones for mono-spaced use.)
Code: (Select All)
$Color:32
Screen _NewImage(1100, 600, 32)
Color Black, _RGB32(255, 255, 255, 255)
Cls
_Display ' Turn off autodisplay.
_Delay .1
_ScreenMove _Middle
_Delay .1
_Clipboard$ = ""
Type textvar
initiate As Integer ' -1 Indicates the Subroutine has been Initiated.
nof As Integer ' Number of Fonts.
maxchrs As Integer ' The Max Characters of a Text String. IMPORTANT: Cannot be over 255.
fsn As Integer ' Font Selection Number 1 reg, 2 Bold, 3 Italic, 4 Bold Italic.
noa As Integer ' Number of Text Attributes.
lm As Integer ' Left Margin by Pixel.
row As Integer ' Row by Pixel.
rm As Integer ' Right Margin by Pixel.
ccol As Integer ' Numeric Column of a Character.
oldccol As Integer ' Numeric Column of the Previous Cursor Position.
pixcol As Integer ' The Pixel Column the Cursor is On Currently.
insreg As Integer ' Causes a Delay in Changing the Cursor Appearance When the Insert Key is Rapidly Pressed.
reprnt As Integer ' Only Reprints a Row of Characters When Non-zero.
ovr As Integer ' Overwrite mode When Non-zero, Otherwise Insert Mode.
xl As Integer ' Pixel Column for a Character that is Part of a Link.
xm As Integer ' Numeric Column of the Character Being Passed to the Matrix.
mindex As Integer ' Numeric Matrix Index.
fsize As Integer ' Font Size.
underline As Integer ' Underline Text.
link As Integer ' Hyperlink Text.
chr_wdth As Integer ' Character Width in Pixels.
chr_hght As Integer ' Character Height in Pixels.
c_wdth As Integer ' Cursor Width in Pixels
c_hght As Integer ' Cursor Height in Pixels.
numchrs As Integer ' Number of Characters in the Line of Text.
sa As Integer ' Special Attributes for Paragraph, highlighting markers, etc.
cchr As String ' Cursor Character.
t As String ' Row of Text.
m As String ' Text and Attributes to be Saved in an RA File.
url As String ' URL Link to Follow.
linkmap As String ' Maps Pixels for Link ID with Mouse.
shift As Integer ' Shift Keys.
autoshift As Integer ' Used for instances like mouse highlighting to mimic keyboard highighting.
ctrl As Integer ' Ctrl key.
alt As Integer ' Alt key.
hl As Integer ' Highlighting Left (-1) or Right (+1)
arrows As Integer ' Aids the Cursor Update Subroutine When Arrows are Used to Highliht Text.
mouse_button1_row As Integer
button1 As Integer
tcopy As String ' Copied Text
mcopy As String ' Copied Text Matrix
button_map1 As String
End Type
Dim tx As textvar
Type mousevar
mx As Integer
my As Integer
wh As Integer
lb As Integer
rb As Integer
lb_status As Integer
rb_status As Integer
locked As Integer
oldmx As Integer
CursorStyle As Integer
mousekey As String ' Auto Keyboard Input.
End Type
Dim m As mousevar
Type popup
nmi As Integer
setup As Integer
status As Integer
pr1 As Integer
pr2 As Integer
pc1 As Integer
pc2 As Integer
phshadow As Integer
pvshadow As Integer
pwdth As Integer
phght As Integer
pbgcolor As Integer
pbbxcolor As Integer
pbshdcolor As Integer
col_matrix As String
row_matrix As String
restrict As String
End Type
Dim pop As popup
Dim Shared bit As _Bit
ReDim Shared cl(3) As Integer, bc(3) As Integer
ReDim Shared default_cl(3), default_bc(3)
tx.nof = 4
tx.fsize = 18
tx.maxchrs = 256 ' IMPORTANT: Cannot be over 255.
ReDim Shared fnum(tx.nof) As Long
ReDim Shared index_col(tx.maxchrs)
default_cl(1) = 0: default_cl(2) = 0: default_cl(3) = 0
default_bc(1) = 255: default_bc(2) = 255: default_bc(3) = 255
tx.fsn = 1 ' Default font style number.
tx.noa = 12 ' Number of character attributes.
tx.row = 100 ' Current row in pixels.
tx.lm = 100 ' Left margin in pixels.
tx.rm = tx.lm + _Width - 2 * tx.lm
tx.sa = 10 ' Number of special attributes.
cl(1) = default_cl(1): cl(2) = default_cl(2): cl(3) = default_cl(3)
bc(1) = default_bc(1): bc(2) = default_bc(2): bc(3) = default_bc(3)
tx.m$ = String$(tx.sa + tx.maxchrs * (tx.noa + 1), Chr$(0)) ' Algorithm makes a 1 string field, 10 ID fields for highlighting, paragraph, plain text line, etc., and tx.noa attributes fields.
tx.t$ = String$(tx.maxchrs, Chr$(0)) ' Our text.
tx.linkmap$ = String$(_Width, Chr$(0))
' Matrix: 1-maxchrs text, maxchrs + 1 to maxchrs + 10 Special attributes, maxchrs + 11 on are attributes each tx.noa spaces long.
' Example: maxchrs = 255. tx.noa = 12. 1-255 text, 256-265 special attributes, 266-277 attributes for 1st character in text string, 278-289 2nd, etc.
main tx, m, pop
Sub main (tx As textvar, m As mousevar, pop As popup)
Do
_Limit 60
load_font tx, fnum()
skin tx, button1$()
mouse m
If m.my >= tx.mouse_button1_row And m.my <= tx.mouse_button1_row + 17 Then
If Mid$(tx.button_map1$, m.mx, 1) <> Chr$(0) Then
_MouseShow "LINK": m.CursorStyle = 1
Else
_MouseShow "DEFAULT": m.CursorStyle = 0
End If
ElseIf m.CursorStyle Then
_MouseShow "DEFAULT": m.CursorStyle = 0
End If
If m.lb_status = 1 And m.CursorStyle Then
i% = Asc(Mid$(tx.button_map1$, m.mx, 1))
If i% > 126 Then i% = i% - 126: j% = i% Else j% = i% + 126 ' Toggle
tx.button1 = -j%
Select Case i%
Case 1, 2, 3
Mid$(tx.button_map1$, tx.lm + (i% - 1) * 26, 17) = String$(17, Chr$(j%))
Case 4, 5, 6
If i% <> Asc(Mid$(tx.button_map1$, tx.lm + (i% - 1) * 26, 1)) - 126 Then ' Radio style buttons once highlighted cannot accept same button clicks.
For k% = 4 To 6
Mid$(tx.button_map1$, tx.lm + (k% - 1) * 26, 17) = String$(17, Chr$(k%))
Next
Mid$(tx.button_map1$, tx.lm + (i% - 1) * 26, 17) = String$(17, Chr$(j%))
Else
Beep
End If
Case 7
For k% = 4 To 6
Mid$(tx.button_map1$, tx.lm + (k% - 1) * 26, 17) = String$(17, Chr$(k%))
Next
Mid$(tx.button_map1$, tx.lm + (i% - 1) * 26, 17) = String$(17, Chr$(j%))
Case 8
a = tx.lm + (i% - 1) * 26: b = 30
Line (a, b)-(a + 17, b + 17), Black, B: _Display
_Delay .15
Line (a, b)-(a + 17, b + 17), DarkGray, B: _Display
_Delay .15
End Select
End If
''keyboard tx, m, b$
''text_input tx, m, pop, b$
''popup_main tx, m, pop
Loop
End Sub
Sub load_font (tx As textvar, fnum() As Long)
If fnum(0) = 0 Then ' Bypass this routine if fnum(0) = -1. Fonts in use were already loaded. Reset to zero to reuse this routine.
fnum(0) = -1 ' See remark above.
fnum(1) = _LoadFont("RobotoMono-regular.ttf", tx.fsize)
fnum(2) = _LoadFont("RobotoMono-bold.ttf", tx.fsize)
fnum(3) = _LoadFont("RobotoMono-italic.ttf", tx.fsize)
fnum(4) = _LoadFont("RobotoMono-bolditalic.ttf", tx.fsize)
For i% = 1 To tx.nof
If fnum(i%) <= 0 Then ' Try to load the Windows Lucida Console font.
fnum(1) = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", tx.fsize)
Exit For
End If
Next
If fnum(1) <= 0 Then
tx.fsize = 16 ' Default 8 x 16 font.
fnum(1) = tx.fsize
End If
End If
End Sub
Sub skin (tx As textvar, button1$())
Static initialize
If tx.button1 <= 0 Then
tx.button1 = Abs(tx.button1): If tx.button1 = 0 Then tx.button1 = 999 ' loced out until a button is clicked.
j% = _LoadFont("RobotoMono-regular.ttf", 14)
k% = _LoadFont("RobotoMono-italic.ttf", 14)
a = tx.lm: b = 30: c = 26
If Len(tx.button_map1$) = 0 Then tx.button_map1$ = String$(_Width, Chr$(0))
tx.mouse_button1_row = b
If tx.maxchrs * _PrintWidth("A") + tx.lm < tx.rm Then tx.rm = tx.maxchrs * _PrintWidth("A") + tx.lm
For i% = 1 To 8
If Asc(Mid$(tx.button_map1$, a, 1)) > 126 Then
Line (a, b)-(a + 17, b + 17), Black, B
Line (a + 2, b + 2)-(a - 2 + 17, b - 2 + 17), _RGB32(255, 255, 255, 255), BF
Else
Line (a, b)-(a + 17, b + 17), DarkGray, B
Line (a + 2, b + 2)-(a - 2 + 17, b - 2 + 17), _RGB32(230, 230, 230, 255), BF
End If
Line (a + 17 + 1, b + 3)-(a + 17 + 2, b + 17), _RGB32(210, 210, 210, 255), BF
Line (a + 3, b + 17 + 1)-(a + 17 + 1, b + 17 + 2), _RGB32(210, 210, 210, 255), BF
a = a + c
Next
a = tx.lm: b = 30: c = 26
_Font j%
If Asc(Mid$(tx.button_map1$, a, 1)) > 126 Then
Color _RGB32(0, 0, 0, 255), _RGB32(255, 255, 255, 0)
Else
Color _RGB32(0, 0, 0, 255), _RGB32(230, 230, 230, 0)
End If
For i% = 1 To 8
Select Case i%
Case 1
_PrintString (a + (i% - 1) * c + 5, b + 2), "B"
Case 2
_Font k%
_PrintString (a + (i% - 1) * c + 5, b + 2), "I"
Case 3
_Font j%
_PrintString (a + (i% - 1) * c + 5, b + 1), "u"
Line (a + (i% - 1) * c + 5, b + 17 - 2)-(a + (i% - 1) * c + 13, b + 17 - 2), Black, B
Case 4
Line (a + (i% - 1) * c + 5, b + 5)-(a + (i% - 1) * c + 12, b + 17 - 5), Black, BF
Case 5
Line (a + (i% - 1) * c + 5, b + 5)-(a + (i% - 1) * c + 12, b + 17 - 5), Blue, BF
Case 6
Line (a + (i% - 1) * c + 5, b + 5)-(a + (i% - 1) * c + 12, b + 17 - 5), Red, BF
Case 7
Line (a + (i% - 1) * c + 4, b + 4)-(a + (i% - 1) * c + 14, b + 17 - 4), Yellow, BF
Rem Circle (a + (i% - 1) * c + 8, b + 8), 2, _RGB32(90): Paint Step(0, 0), _RGB32(90)
_PrintString (a + (i% - 1) * c + 5, b + 2), "h"
Case 8
Color Blue, _RGB32(210, 210, 210, 0)
_PrintString (a + (i% - 1) * c + 5, b + 2), "ì"
End Select
' Make mouse map.
If initialize = 0 Then
Mid$(tx.button_map1$, tx.lm + (i% - 1) * c, c) = String$(17, Chr$(i%)) + String$(c - 17, Chr$(0))
End If
Next
_Font fnum(1) ' Default font.
If initialize = 0 Then
Line (tx.lm - 5, tx.row - 5)-(tx.rm + 5, tx.row + _FontHeight + 5), Gray, B ' Text input field.
a = tx.lm + (4 - 1) * c
Line (a, b)-(a + 17, b + 17), Black, B ' Default black text button.
Line (a + 2, b + 2)-(a - 2 + 17, b - 2 + 17), _RGB32(255, 255, 255, 0), BF
Mid$(tx.button_map1$, tx.lm + (4 - 1) * c, c) = String$(17, Chr$(4 + 216))
initialize = -1
End If
_Display
End If
End Sub
Sub mouse (m As mousevar)
' Local vars: i%,j%
If Len(m.mousekey$) And m.lb_status <> 2 Then Exit Sub ' Bypass mouse when an automatic key was issued unless a drag event is occurring.
While _MouseInput
m.wh = m.wh + _MouseWheel
Wend
m.mx = _MouseX
m.my = _MouseY
m.lb = _MouseButton(1)
m.rb = _MouseButton(2)
Select Case m.lb
Case 0
Select Case m.lb_status
Case -2
m.lb_status = 0 ' The clicked event and the release triggered any event structured to occur on release.
If m.locked = -1 Then m.locked = 0
Case -1
m.lb_status = -2 ' The clicked event triggered any event structured to occur on initial button press.
Case 0
' Button has not been pressed yet.
Case 1
m.lb_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.
Case 2
m.lb_status = 0 ' The drag event is over because the button was released.
End Select
Case -1
Select Case m.lb_status ' Note drag is determined in the text highlighting routine.
Case -1
' An event occurred and the button is still down.
Case 0
m.lb_status = 1
Case 1
m.lb_status = -1 ' The button is down and triggered any event structured to occur on initial press. The status will remain -1 as long as the button is depressed.
End Select
End Select
Select Case m.rb
Case 0
Select Case m.rb_status
Case -1
m.rb_status = 0 ' An event occurred and the button was released.
Case 0
' Button has not been pressed yet.
Case 1
m.rb_status = 0 ' Button was released with no event occurring.
End Select
Case -1
Select Case m.rb_status
Case -1
' An event occurred and the button is still down.
Case 0
m.rb_status = 1
Case 1
' The button is still down but no event occurred.
End Select
End Select
m.oldmx = m.mx
End Sub
Well I nearly posted this in the help forum, but it works, so no actual help is needed with the coding. My question is more along the lines of the approach. If you had to make this type of routine, would you do it this way or another way such as using a hardware overlay method, using images with _putimage, etc. I'd figure I'd ask so I don't end up getting too comfortable with doing it one way, when using another method would demonstrate better results.
The part of the code that produces the buttons is in both in the main and skin routines.
The fonts to use in it are attached, below.
Pete
[i've also been taking smelling lessons from Phil inspired by the man whose name is written so green i'm sure] anyway that's what i think at moment or two, 2 points please...
