| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 762
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,034
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155
|
|
|
| Data setting tutorial video! |
|
Posted by: johannhowitzer - 12-03-2022, 11:18 AM - Forum: Learning Resources and Archives
- Replies (6)
|
 |
Is your code filled with blocks of variable setting or DATA statements? Is code you wrote years ago now indecipherable to you as a result? Suffer no longer! Table routines and abstraction are here to save the day.
This tutorial video isn't really QB64 specific, but hopefully people will get some mileage out of it, and find ways to make their code clearer and less bulky.
|
|
|
| DAY 022: CLEAR |
|
Posted by: Pete - 12-03-2022, 12:47 AM - Forum: Keyword of the Day!
- Replies (3)
|
 |
Do you have a clear idea of what the KEYWORD CLEAR does? If not, clear your
schedule while I clear up what CLEAR does in a clear and concise manner. So let's
clear the way and get started with some helpful do's and don't's (Hey, a double apostrophe siting!)
when using CLEAR; clear enough? If not, clear out now...
CLEAR zeros every numeric variable and nullifies every string.
CLEAR zeros the value of all arrays and also removes (de-initializes) the dimension range. All arrays will need to be re-diminsioned.
CLEAR zeros and nullifies all STATIC variables. (Variables that would otherwise retain their values in a sub-routine).
CLEAR cannot be used in a sub routine or function, only in the main.
CLEAR does not affect settings like VIEW PRINT, colors with PALETTE of fonts, window size, or cursor position, etc.
CLEAR does not destroy TYPE structure. It just makes all TYPE variables zero and all TYPE strings null.
For example...
Code: (Select All) CONST pi = 3.14
PALETTE 0, 8 ' Black background to dark blue.
PALETTE 8, 63 ' Gray to bright white text.
DIM pete AS Perfect
TYPE Perfect
s AS STRING
v AS INTEGER
END TYPE
pete.s = "Pete"
COLOR 8, 0
101
PRINT pete.s;
SLEEP
CLEAR: pete.s = " is better than Steve and pi is " + LTRIM$(STR$(pi))
GOTO 101
CLEAR in QuickBasic had 2 parameters that are ignored in QB64. They were used to clear up specified amounts of stack space and memory.
CLEAR does not remove any PCOPY info.
CLEAR does not close any open files.
CLEAR acts a bit different than RUN in certain situations...
Code: (Select All) ' Let's locate and print off-screen and try to redo it. This works with CLEAR but not with RUN.
101
LOCATE 30, 1
PRINT "PRINT "Press a key loop again."
SLEEP
CLEAR
GOTO 101
Try doing that with RUN and it errors out at the LOCATE statement.
Code: (Select All) ' Let's locate and print off-screen and try to redo it. This works with CLEAR but not with RUN.
LOCATE 30, 1
PRINT "PRINT "Press a key loop again."
SLEEP
RUN
So in the first run QB64 acts like QBasic, it adjusts the screen to accommodate the off-screen print location.With CLEAR, it works but with RUN it does not duplicate that initial accommodation.
So here is the most interesting event I've found working with CLEAR over the years, the need to re-initialize a STATIC array.
Code: (Select All) 101
testsub
PRINT: PRINT "Okay, press a key..."
SLEEP
CLS
_DELAY .5
CLEAR
REDIM SHARED testarray(20) '<----------- We must remember to reinitialize our array.
GOTO 101
SUB testsub
STATIC testarray(20)
FOR i = 1 TO 20
testarray(i) = i
PRINT testarray(i): _DELAY .05
NEXT
END SUB
For fun, try that again with the REDIM line REMmed out. It will error out at line 15.
What I think the developers should look at is RUN. RUN should not require we reinitialize anything.
This error out...
Code: (Select All) testsub
PRINT: PRINT "Okay, press a key..."
SLEEP
CLS
_DELAY .5
RUN
SUB testsub
STATIC testarray(20)
FOR i = 1 TO 20
testarray(i) = i
PRINT testarray(i): _DELAY .05
NEXT
END SUB
Now to get that to work would require we once again initialize our array, but this time at the top of the program.
REDIM SHARED testarray(20) ' <----------- Place this at the top of the code above and it will work.
Other differences between CLEAR and RUN are...
RUN can have a line number like RUN 101. CLEAR would need to be written as: CLEAR: GOTO 101
RUN sets the cursor to the top left. CLEAR maintains the current position.
RUN resets the RANDOMIZE sequence to the starting RND function value. (From the wiki). Clear does not reset the RND pattern.
RUN does not preserve the PALETTE or COLOR, but CLEAR does.
RUN does not preserve VIEW PRINT, but CLEAR does.
RUN and CLEAR both preserve PCOPY memory.
In general it is better practice to keep a list of all your variables and "clear" the ones you need cleared, but CLEAR
is a quick way of obtaining the same results when all your variables need to be cleared.
Another advantage of CLEAR over RUN is you can insert program control flow variables after the CLEAR statement.
Code: (Select All) PRINT "What is my route? ": PRINT
101
SELECT CASE myroute
CASE 0
PRINT "Route 1"
CASE 1
PRINT "Route 2"
END SELECT
SLEEP
CLEAR: myroute = 1
GOTO 101
Finally RUN can be used in a SUB or FUNCTION, but CLEAR cannot. This is considered bad practice, because it creates a stack leak, which in time with excessive use will cause your program to crash.
Pete
|
|
|
|
| SHOWDRAW |
|
Posted by: James D Jarvis - 12-02-2022, 02:24 PM - Forum: Utilities
- Replies (2)
|
 |
I enjoy "drawing" in text mode but it can be a pain juggling the print commands. I've posted and developed all sorts of complicated schemes for doing just that and I realized it is fairly simple to use ANY QB graphics commands to draw on a text screen. All one has to do is draw to an image buffer (which is a 32 bit image) with any standard graphics command, scan that and convert it to text "graphics".
Here's one way to do that:
Code: (Select All) '---------------------------------------------------
'show draw header
'---------------------------------------------------
Dim Shared dspace& 'this is the drawing space/canvas that allows mixed mode graphics routines to function
Dim Shared ts& 'the text screen
Dim Shared stwd, stht
stwd = 80: stht = 40 'resize as you wish, on my monitor 2pixels wide per 1 vertical looks decent
ts& = _NewImage(stwd, stht, 0)
dspace& = _NewImage(stwd + 1, stht + 1, 32)
Screen ts&
_FullScreen
'-------------------------------------
'demo code
'-------------------------------------
Print "Plain old text screen set to 80 characters wide by 40 characters high."
Input "Enter a your name"; uname$
_Dest dspace& 'set the destination so graphics commands will be drawn into space&
Line (1, 1)-(stwd, stht), _RGB32(3, 176, 7), BF
Color _RGB32(15, 48, 0)
_PrintString (1, 1), "GIANT TEXT"
Circle (15, 15), 8, _RGB32(8, 72, 0)
Line (2, 2)-(20, 20), _RGB32(31, 176, 15), B
Color _RGB32(15, 48, 0)
_Dest ts& 'set the screen to the text screen
showdraw 1, 1, stwd, stht 'show dspace on the textscreen rendered in characters
Color 15, 0 'change the color it may be changed in showdraw
_Delay 1
Print "WELL WELL WELL"
_Delay 1
Cls
Print "WELL WELL WELL... you can use any standard graphics command."
Print
For cx = -5 To 90
Print "An animated circle, on a text screem."
_Limit 24
_Dest dspace& 'rember to set the destination to dspace& before you call showdraw
Line (1, 1)-(stwd, stht), _RGB32(8, 177, 7), BF
For bl = -20 To 80 Step 5
Line (bl, 1)-(bl + 6, stht), _RGB32(12, Asc("*"), 2)
Next bl
Circle (cx, 21), 5, _RGB32(15, 219, 0)
showdraw 1, 1, stwd, stht 'showdraw always writes to ts& so you don't have to change destination manually
Next cx
_Dest dspace& 'writitng to dspace& again
Color _RGB32(15, 219, 0) 'use color _RGB32( FOREGROUND_COLOR, DRAWN_CHARACTER, background_color) before printing to dspace&
_PrintString (1, 1), uname$
showdraw 1, 1, stwd, stht
Color 15, 0 'restoring to text mode colors white and black for foreground and background
Locate 1, 1: Print "BYE"
_Delay 1
'-----------------------------------------
'SHOWDRAW
'copies the image from the drawing space onto the text screen
'each pixel in dspace& will hold the text screen character and colors
'-----------------------------------------
Sub showdraw (xa, ya, xb, yb)
Dim tk As _Unsigned Long
'render from xa,ya to xb,yb from dspace& to the ts&
x1 = xa: x2 = xb: y1 = ya: y2 = yb
If x1 < 1 Then x1 = 1
If y1 < 1 Then x1 = 1
If y2 > stht Then y2 = stht
If x2 > stwd Then x2 = stwd
For x = x1 To x2
For y = y1 To y2
_Source dspace&
tk = Point(x, y)
Locate 1, 1
tc = _Red32(tk) 'the red color channel is foreground color for the text screen
ac = _Green32(tk) 'the green color channel is the ascii character to be drawn to the text screen
bc = _Blue32(tk) 'the blue color background color for the text screen
If tc > 0 Then
_Dest ts&
Color tc, bc
_PrintString (x, y), Chr$(ac)
End If
Next y
Next x
_Source ts&
End Sub
|
|
|
|
| DAY 021: LOCATE |
|
Posted by: Pete - 12-02-2022, 04:50 AM - Forum: Keyword of the Day!
- Replies (2)
|
|
Since I'd rather code than write, I decided to present the KEYWORD of the Day, LOCATE in a brief demo. Reading the code window is also an easy option to obtain the various descriptions.
Just press a key during a pause to move on...
Code: (Select All) ' LOCATE Demo
WIDTH 100, 42
_SCREENMOVE 50, 50
'-------------------------------------------------------------------------------------------------------------
PRINT "Locate is used in text screens to locate the cursor by row and column."
PRINT: PRINT "Let's print a message at the 5th row and 2nd column of this window..."
SLEEP
LOCATE 5, 2: PRINT "Hello World!"
SLEEP
PRINT: PRINT "Locate can be used to center text. Let's center our message horizontally..."
SLEEP
msg$ = "Hello World!"
COLOR 14
LOCATE 9, _WIDTH \ 2 - LEN(msg$) \ 2: PRINT msg$
COLOR 7
PRINT: PRINT "CSRLIN denotes the current row and POS(0) for current column...";
SLEEP
LOCATE CSRLIN, POS(0): PRINT " See?..."
SLEEP
PRINT: PRINT "Just be sure you add a semi-colon to the end of your text to stay at the end of the print line."
SLEEP 6: _KEYCLEAR
PRINT: PRINT "If you are already on the row you want, you can also just leave the 1st parameter blank...";
SLEEP
LOCATE , POS(0): PRINT " See?..."
SLEEP
PRINT: PRINT "You can show or hide the cursor, too..."
SLEEP
LOCATE , , 1
PRINT: PRINT "LOCATE , , 1 where our 3rd parameter '1' means let's show the default cursor...";
SLEEP
LOCATE , POS(0), 1
PRINT: PRINT: PRINT "The two last parameters change the cursor shape: cursorStart%, cursorStop%...";
SLEEP 6
PRINT: PRINT: PRINT "The start and end parameters range from 0 to 30. Press to see a medium cursor...";
SLEEP
LOCATE , POS(0), 1, 7, 30
PRINT: PRINT: PRINT "Now press again for a thick cursor...";
SLEEP
LOCATE , POS(0), 1, 0, 30
PRINT: PRINT: PRINT "Note that '7, 7' is the default cursor and 0, 30 is full.";
SLEEP 3
PRINT: PRINT: PRINT "We can hide the cursor with '0' as the 3rd parameter. Press a key to hide it now...";
SLEEP
LOCATE , , 0
SLEEP 3: _KEYCLEAR
LOCATE , , 1
PRINT: PRINT: PRINT "And bring it back again with "; 1; " to its last state LOCATE , , 1, 0, 30...";
SLEEP
LOCATE , , 0
PRINT: PRINT: PRINT "LOCATE also has the ability to print to the last row on a VIEW PRINT restricted screen..."
VIEW PRINT 1 TO 20
SLEEP
LOCATE _HEIGHT, _WIDTH \ 2 - LEN(msg$) \ 2: PRINT msg$;
SLEEP
VIEW PRINT: CLS
PRINT "Finally we need to note some behavior that could screw up your printing.";
SLEEP 4
PRINT: PRINT: PRINT "LOCATE may wrap some text but mostly prints an entire text line to next line...";
LOCATE , , 1, 0, 30
SLEEP
LOCATE , , 0 ' Hide cursor.
PRINT "See? I'm on the next line this time."
SLEEP 6
PRINT: PRINT "This next demo will show what happens when printing an '*' to the last row and column..."
SLEEP
WIDTH 80, 25
CLS
LOCATE 15, 1: PRINT "HEIGHT ="; _HEIGHT, "WIDTH ="; _WIDTH
PRINT: PRINT "Printing an '*' to the right bottom corner with a semi colon works,"
PRINT: PRINT "but look where the next cursor row is."
LOCATE _HEIGHT, _WIDTH
COLOR 14 + 16: PRINT "*";: COLOR 7
y = CSRLIN: x = POS(0)
LOCATE 17: PRINT "Current cursor row is"; y; "instead of"; y + 1; "and the"
PRINT: PRINT "cursor column is"; x; "as expected."
SLEEP
LOCATE y, 1: PRINT "Here's where the next line of text will appear if you don't code a solution."
PRINT: PRINT "See? it's above the asterisk!...";
SLEEP
CLS
PRINT: PRINT "Our final demo will show how to overcome this restriction"
PRINT: PRINT "When trying to fill the screen..."
SLEEP
CLS
a$ = STRING$(_WIDTH, "*")
FOR i = 1 TO _HEIGHT
PRINT a$;
NEXT
SLEEP
CLS
PRINT "Well that didn't work. The last row was empty because the screen scrolled."
PRINT: PRINT "Hmm, let's use LOCATE to fix that..."
SLEEP
CLS
a$ = STRING$(_WIDTH, "*")
FOR i = 1 TO _HEIGHT
LOCATE i, 1 ' <---------------------------Fixes scrolling issue.
PRINT a$;
NEXT
SLEEP
CLS
PRINT "Yep, that worked..."
_DELAY 1
msg$ = "That concludes this portion of our KEYWORD for the Day!"
LOCATE _HEIGHT \ 2, _WIDTH \ 2 - LEN(msg$) \ 2: PRINT msg$
END
Now naturally I did this for SCREEN 0. If anyone wants to elaborate on the use of LOCATE in a graphics environment, feel free.
Pete
|
|
|
|
| How to View the QB64 WINTER BANNER |
|
Posted by: Pete - 12-02-2022, 01:22 AM - Forum: Announcements
- No Replies
|
|
The winner of this year's QB64 PE Winter Banner is bplus. The banner is now available. To view, you need to set your forum "Themes" to either "Default" or "Black" mode. To do so...
1) Scroll down to the bottom right of the page and locate the input field just left of the "Go" button.
2) Click the arrow to open the options, and click either "Default" or "Black" as your new forum page theme.
3) Click the "Go" button and our Winter Banner will appear.
Congrats again to Mark, and thanks for all the Christmas cheer.
Pete
- To all our Australian friends, Happy 4th of July!
|
|
|
|
| Buttons and Boxes |
|
Posted by: James D Jarvis - 12-01-2022, 07:13 PM - Forum: Works in Progress
- No Replies
|
|
A simple control and display scheme for text mode. Currently only supports one active dialog at a time.
Has a number of built-in styles.
Use the mouse or the up and down arrow keys to make a selection.
Code: (Select All) 'Buttons_N_Boxes
'by James D. Jarvis, December 2022
'this demo shows a couple subroutines for simple text boxes and selection boxes in text mode
'if you can read this code and have QB64 you are of course perfectly welcome to use it as you wish.
'
'currently supports just one active button dialog ( Button box) at a time.
'$dynamic
Screen _NewImage(80, 30, 0)
_Title "Buttons and Boxes"
'------------------------------------------------------
'header must be included to use these subroutines
'------------------------------------------------------
Dim Shared bchar$(15, 9)
buildbchar
'------------------------------------------------------
'demo code
'------------------------------------------------------
Randomize Timer
Dim bb$(7)
Dim ob$(1)
bb$(1) = "One": bb$(2) = "Two": bb$(3) = "Three": bb$(4) = "Four"
bb$(5) = "Five": bb$(6) = "Six": bb$(7) = "Seven"
demotext$ = "Please make a selection."
bpick = buttonbox(11, 2, 60, 10, 5, bb$(), demotext$)
Locate 1, 1
If bpick > 0 Then
mtext$ = "You selected button " + bb$(bpick)
Else
mtext$ = "No option selected"
End If
Cls
ob$(1) = "OKAY"
bpick = buttonbox(3, 3, 32, 5, 1, ob$(), mtext$)
ReDim bb$(2)
bb$(1) = "YES": bb$(2) = "QUIT"
bpick = buttonbox(5, 4, 32, 5, 1, bb$(), "Want to see a bunch of Printboxes?")
If bpick = 1 Then
Cls
demotext$ = "The quick brown fox took a ride on the cow as it jumped over the moon and the owl found out how many licks it took to get to the center of a tootsie pop."
Randomize Timer
For n = 1 To 30
boxX = Int(1 + Rnd * 60): boxY = Int(1 + Rnd * 20)
boxW = Int(12 + Rnd * 30): boxH = Int(3 + Rnd * 9)
bstyle = Int(1 + Rnd * 15)
bklr = Int(Rnd * 16) - 8: If bklr < 0 Then bklr = 0
Do
fklr = Int(Rnd * 20): If fklr > 15 Then fklr = 15
Loop Until fklr <> bklr
Color fklr, bklr
printbox boxX, boxY, boxW, boxH, bstyle, demotext$
_Delay 0.5
Next n
Color 15, 0
printbox 11, 8, 60, 4, 1, "That's it, a nice simple demonstration of PRINTBOX"
printbox 11, 12, 60, 4, 5, "Text is clipped to fit the printbox. While text will wrap within the box any extra characters will be lost."
ob$(1) = "QUIT"
dummy = buttonbox(11, 16, 60, 3, 7, ob$(), "BYE")
End If
System
'------------------------------------------------------
' Printbox draws a fixed text box for a text mode screem
' there are 15 styles programmed into this.
' Each is defined by a string array where corners, top and sides are defined in bchar$
'
'text will wrap inside the print box butwill not printoutside the printbox, that would be another subroutine
'the box may screen wrap the text will not.
'------------------------------------------------------
Sub printbox (bx, by, ww, hh, bb, txt$)
topbar$ = bchar$(bb, 1) + String$(ww - 2, Asc(bchar$(bb, 2))) + bchar$(bb, 3)
midbar$ = bchar$(bb, 4) + String$(ww - 2, Asc(bchar$(bb, 5))) + bchar$(bb, 6)
btmbar$ = bchar$(bb, 7) + String$(ww - 2, Asc(bchar$(bb, 8))) + bchar$(bb, 9)
_PrintString (bx, by), topbar$
For r = 1 To hh - 2: _PrintString (bx, by + r), midbar$: Next r
_PrintString (bx, by + hh - 1), btmbar$
ml = Len(txt$)
If ml < ww - 2 Then
cx = bx + ww / 2 - ml \ 2
_PrintString (cx, by + 1), txt$
Else
cx = bx + 2
cy = by + 1
For c = 1 To ml
If cy < _Height - 1 And cx < _Width - 1 Then
If cy < (by + hh - 1) Then _PrintString (cx, cy), Mid$(txt$, c, 1)
End If
cx = cx + 1
If cx > bx + ww - 3 Or cx > _Width - 1 Then
cx = bx + 2
cy = cy + 1
End If
Next c
End If
End Sub
Sub buildbchar
bchar$(1, 1) = Chr$(219): bchar$(1, 2) = Chr$(223): bchar$(1, 3) = Chr$(219)
bchar$(1, 4) = Chr$(219): bchar$(1, 5) = Chr$(32): bchar$(1, 6) = Chr$(219)
bchar$(1, 7) = Chr$(219): bchar$(1, 8) = Chr$(220): bchar$(1, 9) = Chr$(219)
bchar$(2, 1) = Chr$(178): bchar$(2, 2) = Chr$(178): bchar$(2, 3) = Chr$(178)
bchar$(2, 4) = Chr$(178): bchar$(2, 5) = Chr$(32): bchar$(2, 6) = Chr$(178)
bchar$(2, 7) = Chr$(178): bchar$(2, 8) = Chr$(178): bchar$(2, 9) = Chr$(178)
bchar$(3, 1) = Chr$(177): bchar$(3, 2) = Chr$(177): bchar$(3, 3) = Chr$(177)
bchar$(3, 4) = Chr$(177): bchar$(3, 5) = Chr$(32): bchar$(3, 6) = Chr$(177)
bchar$(3, 7) = Chr$(177): bchar$(3, 8) = Chr$(177): bchar$(3, 9) = Chr$(177)
bchar$(4, 1) = Chr$(176): bchar$(4, 2) = Chr$(176): bchar$(4, 3) = Chr$(176)
bchar$(4, 4) = Chr$(176): bchar$(4, 5) = Chr$(32): bchar$(4, 6) = Chr$(176)
bchar$(4, 7) = Chr$(176): bchar$(4, 8) = Chr$(176): bchar$(4, 9) = Chr$(176)
bchar$(5, 1) = Chr$(218): bchar$(5, 2) = Chr$(196): bchar$(5, 3) = Chr$(191)
bchar$(5, 4) = Chr$(179): bchar$(5, 5) = Chr$(32): bchar$(5, 6) = Chr$(179)
bchar$(5, 7) = Chr$(192): bchar$(5, 8) = Chr$(196): bchar$(5, 9) = Chr$(217)
bchar$(6, 1) = Chr$(213): bchar$(6, 2) = Chr$(205): bchar$(6, 3) = Chr$(184)
bchar$(6, 4) = Chr$(179): bchar$(6, 5) = Chr$(32): bchar$(6, 6) = Chr$(179)
bchar$(6, 7) = Chr$(212): bchar$(6, 8) = Chr$(205): bchar$(6, 9) = Chr$(190)
bchar$(7, 1) = Chr$(201): bchar$(7, 2) = Chr$(205): bchar$(7, 3) = Chr$(187)
bchar$(7, 4) = Chr$(186): bchar$(7, 5) = Chr$(32): bchar$(7, 6) = Chr$(186)
bchar$(7, 7) = Chr$(200): bchar$(7, 8) = Chr$(205): bchar$(7, 9) = Chr$(188)
bchar$(8, 1) = Chr$(219): bchar$(8, 2) = Chr$(196): bchar$(8, 3) = Chr$(219)
bchar$(8, 4) = Chr$(179): bchar$(8, 5) = Chr$(32): bchar$(8, 6) = Chr$(179)
bchar$(8, 7) = Chr$(219): bchar$(8, 8) = Chr$(196): bchar$(8, 9) = Chr$(219)
bchar$(9, 1) = Chr$(219): bchar$(9, 2) = Chr$(42): bchar$(9, 3) = Chr$(219)
bchar$(9, 4) = Chr$(42): bchar$(9, 5) = Chr$(32): bchar$(9, 6) = Chr$(42)
bchar$(9, 7) = Chr$(219): bchar$(9, 8) = Chr$(42): bchar$(9, 9) = Chr$(219)
bchar$(10, 1) = Chr$(42): bchar$(10, 2) = Chr$(42): bchar$(10, 3) = Chr$(42)
bchar$(10, 4) = Chr$(42): bchar$(10, 5) = Chr$(32): bchar$(10, 6) = Chr$(42)
bchar$(10, 7) = Chr$(42): bchar$(10, 8) = Chr$(42): bchar$(10, 9) = Chr$(42)
bchar$(11, 1) = Chr$(240): bchar$(11, 2) = Chr$(240): bchar$(11, 3) = Chr$(240)
bchar$(11, 4) = Chr$(240): bchar$(11, 5) = Chr$(32): bchar$(11, 6) = Chr$(240)
bchar$(11, 7) = Chr$(240): bchar$(11, 8) = Chr$(240): bchar$(11, 9) = Chr$(240)
bchar$(12, 1) = Chr$(240): bchar$(12, 2) = Chr$(240): bchar$(12, 3) = Chr$(240)
bchar$(12, 4) = Chr$(32): bchar$(12, 5) = Chr$(32): bchar$(12, 6) = Chr$(32)
bchar$(12, 7) = Chr$(240): bchar$(12, 8) = Chr$(240): bchar$(12, 9) = Chr$(240)
bchar$(13, 1) = Chr$(240): bchar$(13, 2) = Chr$(240): bchar$(13, 3) = Chr$(240)
bchar$(13, 4) = Chr$(46): bchar$(13, 5) = Chr$(46): bchar$(13, 6) = Chr$(46)
bchar$(13, 7) = Chr$(240): bchar$(13, 8) = Chr$(240): bchar$(13, 9) = Chr$(240)
bchar$(14, 1) = Chr$(46): bchar$(14, 2) = Chr$(46): bchar$(14, 3) = Chr$(46)
bchar$(14, 4) = Chr$(46): bchar$(14, 5) = Chr$(46): bchar$(14, 6) = Chr$(46)
bchar$(14, 7) = Chr$(46): bchar$(14, 8) = Chr$(46): bchar$(14, 9) = Chr$(46)
bchar$(15, 1) = Chr$(176): bchar$(15, 2) = Chr$(176): bchar$(15, 3) = Chr$(176)
bchar$(15, 4) = Chr$(176): bchar$(15, 5) = Chr$(176): bchar$(15, 6) = Chr$(176)
bchar$(15, 7) = Chr$(176): bchar$(15, 8) = Chr$(176): bchar$(15, 9) = Chr$(176)
End Sub
'-----------------------------------------------------------
'Button box
'uses pritnbox to display a an array of bottons passed in the array btn$()
'the id number of the button selected is returned
'if <esc> is used bypass the selection a value of 0 is returned.
'make selection with a mouse or using the up and down arrow keys with <return>
'-----------------------------------------------------------
Function buttonbox (bx, by, ww, hh, bb, btn$(), txt$)
bi& = _NewImage(_Width + 1, _Height + 1, 256)
ds& = _Dest
bcount = UBound(btn$)
fk = _DefaultColor
thh = hh
tnh = Len(txt$) / (ww - 3)
If tnh < 1 Then tnh = 1
bby = by + tnh + 2
If thh < bby + bcount * 3 Then thh = tnh + bcount * 3 + 4
printbox bx, by, ww, thh, bb, txt$
For b = 1 To bcount
printbox bx + 2, bby, ww - 4, 3, bb, btn$(b)
_Dest bi&
Line (bx + 2, bby)-(bx + ww - 4, bby + 2), b, BF
_Dest ds&
bby = bby + 3
Next b
bselect = 0
Do
_Limit 60
bkk = _KeyHit
Select Case bkk
Case -18432 'up
If bselect > 0 Then
btpy = by + tnh + 2 + (bselect - 1) * 3
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
End If
bselect = bselect - 1
If bselect < 1 Then bselect = bcount
btpy = by + tnh + 2 + (bselect - 1) * 3
Color fk + 16
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
Color fk
Case -20480 'down
If bselect > 0 Then
btpy = by + tnh + 2 + (bselect - 1) * 3
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
End If
bselect = bselect + 1
If bselect > bcount Then bselect = 1
btpy = by + tnh + 2 + (bselect - 1) * 3
fk = _DefaultColor
Color fk + 16
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
Color fk
End Select
lasto = 0
Do While _MouseInput
_Source bi&
pbx = _MouseX
pby = _MouseY
optt = Point(pbx, pby)
If optt > 0 And bptt < bcount + 1 Then
If lasto <> optt And lasto > 0 Then
Color fk
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(lasto)
End If
If bselect > 0 Then
btpy = by + tnh + 2 + (bselect - 1) * 3
Color fk
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
End If
Color fk + 16
btpy = by + tnh + 2 + (optt - 1) * 3
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(optt)
Color fk
lasto = optt
If optt > 0 Then bselect = optt
End If
If _MouseButton(1) Then
Do
_Limit 60
i = _MouseInput
Loop Until Not _MouseButton(1)
pbx = _MouseX
pby = _MouseY
bptt = Point(pbx, pby)
Locate 1, 4: Print bptt
End If
If bptt > 0 And bptt < bcount + 1 Then
btpy = by + tnh + 2 + (bptt - 1) * 3
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bptt)
bselect = bptt
btpy = by + tnh + 2 + (bselect - 1) * 3
fk = _DefaultColor
Color fk + 16
printbox bx + 2, btpy, ww - 4, 3, bb, btn$(bselect)
Color fk
_Delay 0.05
bkk = -13
GoTo mdone
End If
Loop
mdone:
Loop Until bkk = -27 Or bkk = -13
Locate 2, 2: Print bselect
_Dest ds&
_Source ds&
_FreeImage bi&
buttonbox = bselect
End Function
|
|
|
|
| You never CALL |
|
Posted by: Pete - 12-01-2022, 04:37 PM - Forum: General Discussion
- Replies (13)
|
|
So when it comes to subs and functions, which convention do you employ?
CALL MySub(Parameters)
or...
MySub Paramenters
Certainly the later is less typing. It also looks neater. That stated, I almost always write apps with 20 to 30 sub routines and maybe 40+ calls. For the simple reason of ease of search, I use the CALL convention. F3, type "CALL" and check match case and whole word. Easy peasy.
I have a feeling I'm going to be in the minority on this one, but let's find out.
So which convention do you prefer?
Pete
- You can CALL me Betty, and Betty when you CALL me you can CALL me Al, CALL me Al...
|
|
|
|
|
