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...
