| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
1990's 3D Doom-Like Walls...
Forum: Programs
Last Post: a740g
1 hour ago
» Replies: 8
» Views: 243
|
Editor WIP
Forum: bplus
Last Post: aadityap0901
7 hours ago
» Replies: 12
» Views: 671
|
QBJS v0.9.0 - Release
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
10 hours ago
» Replies: 14
» Views: 238
|
Fun with Ray Casting
Forum: a740g
Last Post: a740g
Today, 02:36 AM
» Replies: 2
» Views: 67
|
Big problem for me.
Forum: General Discussion
Last Post: bplus
Today, 12:20 AM
» Replies: 7
» Views: 99
|
discover graphics with xa...
Forum: Programs
Last Post: hsiangch_ong
Yesterday, 10:39 PM
» Replies: 0
» Views: 29
|
another variation of "10 ...
Forum: Programs
Last Post: Jack002
Yesterday, 10:05 PM
» Replies: 37
» Views: 652
|
Aloha from Maui guys.
Forum: General Discussion
Last Post: doppler
Yesterday, 03:32 PM
» Replies: 14
» Views: 357
|
Cautionary tale of open, ...
Forum: General Discussion
Last Post: doppler
Yesterday, 03:28 PM
» Replies: 0
» Views: 36
|
Extended KotD #22: _MOUSE...
Forum: Keyword of the Day!
Last Post: SMcNeill
Yesterday, 12:29 AM
» Replies: 0
» Views: 57
|
|
|
| DAY 032: _INSTRREV |
|
Posted by: Pete - 12-12-2022, 08:58 PM - Forum: Keyword of the Day!
- Replies (11)
|
 |
_INSTRREV is an INSTR function, but in reverse! Instead of searching left to right, it searches from right to left.
SYNTAX _INSTRREV(seed%, string$, search$)
Where:
seed% is starting point in the string to begin the search.
string$ is the string to be searched.
search$ is the search term.
Note: The first parameter, seed%, is optional. We can also code it as: _INSTRREV(string$, search$)
Use: Parsing function.
So if we can already search a string forward with INSTR(), what's the benefit of using _INSTRREV()?
Glad you asked...
Let's say we have a page margin of 40 spaces wide. Here is our first string for that document...
a$ = "Pete and Steve walk into a bar. Steve blames Pete for not raising the bar higher."
Oops, that's longer than 40-characters? What do we do now Batman?
Well, simple "Stevey-boy" Wonder, we use the Bat-o-axe and chop it! (I have an old bat-o-axe around the house... Ouch! Hit by the bat-pan again!)
Well while I recover from being being badly bat-tered, let's take a short commercial break and see INSTR() vs _INSTRREV() in action.
Code: (Select All) WIDTH 82, 25
LOCATE 10, 1: PRINT " Okay, here is our string to chop to the page width of 40... "
a$ = "Pete and Steve walk into a bar. Steve blames Pete for not raising the bar higher."
LOCATE 20, 1: PRINT a$; ''PRINT MID$(a$, 1, _WIDTH - 2): PRINT " "; MID$(a$, _WIDTH - 1)
mr = 40 ' Right margin limit
LOCATE 1, mr + 1: PRINT "|";
SLEEP
LOCATE 10, 1: PRINT "First we chopped the string to the page width: a$ = MID$(a$, 1, mr) "
a$ = MID$(a$, 1, mr)
LOCATE 1, 1
PRINT a$;
SLEEP
LOCATE 10, 1: PRINT "Okay, we need to get rid of the "; CHR$(34); "bl"; CHR$(34); " part of blames on our first line... "
LOCATE 12, 1: PRINT "So let's try doing that with INSTR() with a nice long loop function..."; ""
SLEEP
LOCATE 10, 1: PRINT "Well that's working, but it's taking several parsing loops. "
LOCATE 12, 1: PRINT SPACE$(_WIDTH);
LOCATE 1, 1: PRINT SPACE$(mr);
LOCATE 1, 1
seed% = 0: j = 0
DO
chop = j
j = INSTR(seed%, a$, " ")
COLOR 8: PRINT MID$(a$, seed%, j - seed% + 1);: _DELAY .66 ' For fun, we will time delay print each parse.
seed% = j + 1 ' Move forward in our string - character past the last space.
LOOP UNTIL j = 0
COLOR 7
LOCATE 1, 1
PRINT MID$(a$, 1, chop);
SLEEP
LOCATE 10, 1: PRINT "Okay, let's do that with a 1-line _INSTRREV(): chop = _INSTRREV(a$, "; CHR$(34); " "; CHR$(34); ") "
LOCATE 1, 1: PRINT SPACE$(mr);
SLEEP 5
chop = _INSTRREV(a$, " ")
LOCATE 1, 1
PRINT MID$(a$, 1, chop);
LOCATE 10, 1: PRINT "Well that was easy! "
Now the seed% part in _INSTRREV is used a bit differently than INSTR() in that it is read right to left, instead of left to right. So instead of stating your seed% at zero, you start it at the last space - 1 in your string to be chopped.
Code: (Select All) a$ = "Pete and Steve walk into a bar. Steve bl"
LOCATE 1, 41: PRINT "|";
_DELAY 1
DO
seed% = _INSTRREV(a$, " ") - 1: j = 0
DO
chop = j
j = _INSTRREV(seed%, a$, " ")
LOCATE , j + 1: PRINT MID$(a$, j + 1, seed% - j + 1);: _DELAY .5
REM PRINT seed%, j
seed% = j - 1 ' Move backwards in our string - character past the previous space.
LOOP UNTIL j = 0
LOCATE 1, 1: PRINT SPACE$(40);: _DELAY 1: LOCATE 1, 1
seed% = 0: j = 0
DO
chop = j
j = INSTR(seed%, a$ + " ", " ")
PRINT MID$(a$, seed%, j - seed% + 1);: _DELAY .5 ' For fun, we will time delay print each parse.
seed% = j + 1 ' Move forward in our string - character past the last space.
LOOP UNTIL j = 0
LOCATE 1, 1: PRINT SPACE$(40);: _DELAY 1: LOCATE 1, 1
LOOP
Well one practical application I wish we could do with this keyword is seed it find a term in a list of terms, separated with a delimiter. Well, we can build a function and use our key INSTRREV() and I'll throw in _INSTR() for no extra charge.
First input if you are searching forwards or backwards and then input the what number term to find, 1 - 10.
Code: (Select All) DO
DO
CLS
a$ = "dog cat rabbit cow mule pig elephant tiger bear Steve"
PRINT a$: PRINT
INPUT "Pick From the Left [1] or the Right [-1]: ", tmp%: PRINT
INPUT "From 1 - 10, What Term #", tnum%
IF tnum% >= 1 AND tnum% <= 10 AND tmp% >= -1 AND tmp% <= 2 AND tmp% <> 0 THEN EXIT DO
LOOP
tnum% = tnum% * tmp%
PRINT
PRINT " You chose: "; parse(a$, tnum%)
PRINT: PRINT "Press any key to continue or Esc to quit..."
_KEYCLEAR
SLEEP
IF INKEY$ = CHR$(27) THEN SYSTEM
LOOP
FUNCTION parse$ (a$, tnum%)
IF tnum% < 0 THEN
seed% = _INSTRREV(a$ + " ", " ") - 1: j = 0
FOR i = 1 TO ABS(tnum%)
chop = j
j = _INSTRREV(seed%, a$ + " ", " ")
IF i <> ABS(tnum%) THEN seed% = j - 1
NEXT
parse$ = MID$(a$, j + 1, seed% - j + 1)
ELSE
seed% = 0: j = 0
FOR i = 1 TO tnum%
chop = j
j = INSTR(seed%, a$ + " ", " ")
IF i <> tnum% THEN seed% = j + 1
NEXT
parse$ = MID$(a$, seed%, j - seed% + 1)
END IF
END FUNCTION
Other uses are parsing off a file path to show just the directory:
From the Wiki...
Code: (Select All) fullPath$ = "C:\Documents and Settings\Administrator\Desktop\qb64\internal\c\libqb\os\win\libqb_1_2_000000000000.o"
file$ = MID$(fullPath$, _INSTRREV(fullPath$, "\") + 1)
PRINT file$
One last thing, which also applies to INSTR(). Both will return zero if the search term, or aka sub-string, isn't found. So if you are using it with mid$() be aware that zero will give you the full string in the output, instead of a null string. You will need to write a conditional statement to handle this behavior...
Code: (Select All) a$ = "123456789" ' No space(s).
x$ = "" ' Make x$ a null string just in case x$ was assigned someplace else.
substring$ = " "
j = _INSTRREV(a$, substring$)
IF j THEN x$ = MID$(a$, j) ' Only change null x$ if j is non-zero.
PRINT "x$ = "; x$ ' Nothing will print here now that we put in the above condition.
SLEEP
PRINT: PRINT MID$(a$, _INSTRREV(a$, substring$)) ' This would have printed the whole string without the condition.
Tune in tomorrow. Same Bat time, same Bat channel.
Pete
|
|
|
| Windows Magnifier |
|
Posted by: SMcNeill - 12-12-2022, 09:24 AM - Forum: Utilities
- Replies (10)
|
 |
Code: (Select All) Type POINTAPI
X As Long
Y As Long
End Type
Dim WinMse As POINTAPI
Declare Dynamic Library "Gdi32"
Function CreateEllipticRgn%& (ByVal x1&, Byval y1&, Byval x2&, Byval y2&)
End Declare
Declare Dynamic Library "User32"
Function GetWindowLongA& (ByVal hwnd As Long, Byval nIndex As Long)
Function SetWindowLongA& (ByVal hwnd As Long, Byval nIndex As Long, Byval dwNewLong As Long)
Function SetWindowPos& (ByVal hwnd As Long, Byval hWndInsertAfter As Long, Byval x As Long, Byval y As Long, Byval cx As Long, Byval cy As Long, Byval wFlags As Long)
Function SetWindowRgn (ByVal windowhandle%&, Byval region%&, Byval redraw%%)
Function GetCursorPos (lpPoint As POINTAPI)
Function GetKeyState% (ByVal nVirtKey As Long) 'reads Windows key presses independently
End Declare
GWL_STYLE = -16
WS_VISIBLE = &H10000000
Screen _NewImage(720, 720, 32)
_ScreenHide
hwnd& = _WindowHandle
winstyle& = GetWindowLongA&(hwnd&, GWL_STYLE)
a& = SetWindowLongA&(hwnd&, GWL_STYLE, winstyle& And WS_VISIBLE)
a& = SetWindowPos&(hwnd&, -2, 0, 0, 0, 0, 39)
rgn%& = CreateEllipticRgn(0, 0, _Width - 1, _Height - 1)
result = SetWindowRgn(hwnd&, rgn%&, -1)
magnify = -1
_ScreenShow
zoom = 5
Do
update = (update + 1) Mod 6
Cls , 0
m = GetCursorPos(WinMse)
If GetKeyState(17) < 0 Then 'CTRL +
If GetKeyState(&HBD) < 0 Then zoom = zoom + .2
If GetKeyState(&HBB) < 0 Then zoom = zoom - .2
If GetKeyState(Asc("M")) < 0 Then 'M for MAGNIFY
magnify = Not magnify
If magnify Then _ScreenShow Else _ScreenHide
_Delay .2 'give the user time to get their fat fingers off the CTRL-M keys so we don't have multi on/off events instantly.
End If
If GetKeyState(Asc("Q")) < 0 Then System 'Q for QUIT
If GetKeyState(Asc("P")) < 0 Then _ScreenMove WinMse.X - 320, WinMse.Y - 320 'P for POSITION
End If
If zoom < .2 Then zoom = .2
If zoom > 10 Then zoom = 10
If update = 1 Then
If DTI Then _FreeImage DTI
DTI = _ScreenImage
End If
_PutImage , DTI, 0, (WinMse.X - 50 * zoom, WinMse.Y - 50 * zoom)-(WinMse.X + 50 * zoom, WinMse.Y + 50 * zoom)
_Limit 30
oldx = WinMse.X: oldy = WinMse.Y
_Display
Loop
Ever have a screen where everything is just too small to read? Or maybe it's one where you wish you could easily zoom out on so you could see how it'd look on a higher resolution device? Ever wish QB64-PE could solve the problem for you?
WELL, NOW IT CAN!!
Presenting the one and only, limited time offer, for only three easy payments of $49.97, Windows Magnifier!
IT MAKES THINGS BIGGER! it can make things smaller. It can make your wife yell, "WOWZERS!!", when you step out of the shower and she sees you on your bathroom security cam! Just buy now and pay later, and you can have the power of CONTRL-M in the palm of your hands!!
and what's control-m, you ask?
WHY IT'S NOTHING LESS THAN THE MARVELOUS, AMAZING, STUPENDIOUS, ASTOUNDING HOTKEY TO YOUR OWN WINDOWS MAGNIFIER!! Written completely in QB64-PE!
Zoom in with CONTROL-PLUS. Zoom out with CONTROL-MINUS. Position it wherever you want with CONTROL-P, and then when you're done, you can CTRL-Q to QUIT it!
I'm the Ghost of Milly Hay Bayes, and I approve this product 100%!!!
|
|
|
|
| Windows Magnifier |
|
Posted by: SMcNeill - 12-12-2022, 09:24 AM - Forum: SMcNeill
- Replies (10)
|
|
Code: (Select All) Type POINTAPI
X As Long
Y As Long
End Type
Dim WinMse As POINTAPI
Declare Dynamic Library "Gdi32"
Function CreateEllipticRgn%& (ByVal x1&, Byval y1&, Byval x2&, Byval y2&)
End Declare
Declare Dynamic Library "User32"
Function GetWindowLongA& (ByVal hwnd As Long, Byval nIndex As Long)
Function SetWindowLongA& (ByVal hwnd As Long, Byval nIndex As Long, Byval dwNewLong As Long)
Function SetWindowPos& (ByVal hwnd As Long, Byval hWndInsertAfter As Long, Byval x As Long, Byval y As Long, Byval cx As Long, Byval cy As Long, Byval wFlags As Long)
Function SetWindowRgn (ByVal windowhandle%&, Byval region%&, Byval redraw%%)
Function GetCursorPos (lpPoint As POINTAPI)
Function GetKeyState% (ByVal nVirtKey As Long) 'reads Windows key presses independently
End Declare
GWL_STYLE = -16
WS_VISIBLE = &H10000000
Screen _NewImage(720, 720, 32)
_ScreenHide
hwnd& = _WindowHandle
winstyle& = GetWindowLongA&(hwnd&, GWL_STYLE)
a& = SetWindowLongA&(hwnd&, GWL_STYLE, winstyle& And WS_VISIBLE)
a& = SetWindowPos&(hwnd&, -2, 0, 0, 0, 0, 39)
rgn%& = CreateEllipticRgn(0, 0, _Width - 1, _Height - 1)
result = SetWindowRgn(hwnd&, rgn%&, -1)
magnify = -1
_ScreenShow
zoom = 5
Do
update = (update + 1) Mod 6
Cls , 0
m = GetCursorPos(WinMse)
If GetKeyState(17) < 0 Then 'CTRL +
If GetKeyState(&HBD) < 0 Then zoom = zoom + .2
If GetKeyState(&HBB) < 0 Then zoom = zoom - .2
If GetKeyState(Asc("M")) < 0 Then 'M for MAGNIFY
magnify = Not magnify
If magnify Then _ScreenShow Else _ScreenHide
_Delay .2 'give the user time to get their fat fingers off the CTRL-M keys so we don't have multi on/off events instantly.
End If
If GetKeyState(Asc("Q")) < 0 Then System 'Q for QUIT
If GetKeyState(Asc("P")) < 0 Then _ScreenMove WinMse.X - 320, WinMse.Y - 320 'P for POSITION
End If
If zoom < .2 Then zoom = .2
If zoom > 10 Then zoom = 10
If update = 1 Then
If DTI Then _FreeImage DTI
DTI = _ScreenImage
End If
_PutImage , DTI, 0, (WinMse.X - 50 * zoom, WinMse.Y - 50 * zoom)-(WinMse.X + 50 * zoom, WinMse.Y + 50 * zoom)
_Limit 30
oldx = WinMse.X: oldy = WinMse.Y
_Display
Loop
Ever have a screen where everything is just too small to read? Or maybe it's one where you wish you could easily zoom out on so you could see how it'd look on a higher resolution device? Ever wish QB64-PE could solve the problem for you?
WELL, NOW IT CAN!!
Presenting the one and only, limited time offer, for only three easy payments of $49.97, Windows Magnifier!
IT MAKES THINGS BIGGER! it can make things smaller. It can make your wife yell, "WOWZERS!!", when you step out of the shower and she sees you on your bathroom security cam! Just buy now and pay later, and you can have the power of CONTRL-M in the palm of your hands!!
and what's control-m, you ask?
WHY IT'S NOTHING LESS THAN THE MARVELOUS, AMAZING, STUPENDIOUS, ASTOUNDING HOTKEY TO YOUR OWN WINDOWS MAGNIFIER!! Written completely in QB64-PE!
Zoom in with CONTROL-PLUS. Zoom out with CONTROL-MINUS. Position it wherever you want with CONTROL-P, and then when you're done, you can CTRL-Q to QUIT it!
I'm the Ghost of Milly Hay Bayes, and I approve this product 100%!!!
|
|
|
|
| DAY 031: BYVAL |
|
Posted by: Pete - 12-12-2022, 02:37 AM - Forum: Keyword of the Day!
- Replies (8)
|
|
SYNTAX
For us Rednecks... I like ta BYVAL, Pat. I'd like a P.
For everyone else...
BYVAL
So all this really is is a way to tell the system we will be passing a variable in a library variable list by value rather than by reference. We are basically defining the passing mechanism.
So what's the difference you ask?
In short, passing by value passes the actual value of the variable to the sub-procedure, and back.
Passing by reference means we can mess with the variable name from the call list to the library, sub, or function, and modify the programming element underlying the argument in the calling code. The position in the list is all that matters.
Here is a sub example of passing two variables by reference...
Code: (Select All) CALL Pete(smart, ascii) ' But not on weekends and not past 5pm M-F.
PRINT smart, ascii
SUB Pete (dumb, ascii)
dumb = -1
ascii = 1
END SUB
Output -1, 1
So in this reference example, we see the variable value of dumb got passed by reference to the variable, "smart".
On the other hand, passing by value would mean the value of the variable assigned to the name of the variable would remain the same. So the code would need to be changed from dumb =-1 to smart = -1 to get the same output, but...
Sorry, I can't demo BYVAL in a sub or function, because this keyword is only available for use in DECLARE LIBRARY statements.
So here is a Windows example to minimize and maximize the window using BYVAL in a DECLARE Library statement...
Code: (Select All) DECLARE DYNAMIC LIBRARY "user32"
FUNCTION ShowWindow& (BYVAL hwnd AS LONG, BYVAL nCmdShow AS LONG) 'maximize process
END DECLARE
hWnd& = _WINDOWHANDLE
_KEYCLEAR
PRINT "Press a key to minimize this window and then press a key again to restore it..."
SLEEP
y& = ShowWindow&(hWnd&, 2) ' Minimize
_KEYCLEAR
SLEEP
PRINT: PRINT "We're back!"
y& = ShowWindow&(hWnd&, 9) ' Restore
If anyone has any example(s) that work in Linux, or Mac; or any additional info to post, feel free.
Right now, I have to solve the puzzle...
_ _ c k J _ _ B _ d _ n
Let's Go Brandon!
|
|
|
|
| Math Evaluator |
|
Posted by: SMcNeill - 12-11-2022, 08:06 PM - Forum: SMcNeill
- Replies (8)
|
|
I was going to point someone to my math evaluator in a different post, to showcase our math order of operations, and after searching the forums, I couldn't find it. GASP!!
I guess this little routine was over at the old forums and was just one that I forgot to move over, when things went belly up and burnt down. My apologies.
Enjoy guys, and feel free to make use of the code within in any of your projects that you might want -- it's a pretty comprehensive math evaluation routine. Pass it a string full of math stuff, get back the answer to it. It's really that simple.
Code: (Select All)
ReDim Shared OName(0) As String 'Operation Name
ReDim Shared PL(0) As Integer 'Priority Level
ReDim Shared PP_TypeMod(27) As String, PP_ConvertedMod(27) As String 'Prepass Name Conversion variables.
PP_TypeMod(1) = "~`": PP_ConvertedMod(1) = "C_UBI" 'unsigned bit
PP_TypeMod(2) = "~%%": PP_ConvertedMod(2) = "C_UBY" 'unsigned byte
PP_TypeMod(3) = "~%&": PP_ConvertedMod(3) = "C_UOF" 'unsigned offset
PP_TypeMod(4) = "~%": PP_ConvertedMod(4) = "C_UIN" 'unsigned integer
PP_TypeMod(5) = "~&&": PP_ConvertedMod(5) = "C_UIF" 'unsigned integer64
PP_TypeMod(6) = "~&": PP_ConvertedMod(6) = "C_ULO" 'unsigned long
PP_TypeMod(7) = "`": PP_ConvertedMod(7) = "C_BI" 'bit
PP_TypeMod(8) = "%%": PP_ConvertedMod(8) = "C_BY" 'byte
PP_TypeMod(9) = "%&": PP_ConvertedMod(9) = "C_OF" 'offset
PP_TypeMod(10) = "%": PP_ConvertedMod(10) = "C_IN" 'integer
PP_TypeMod(11) = "&&": PP_ConvertedMod(11) = "C_IF" 'integer64
PP_TypeMod(12) = "&": PP_ConvertedMod(12) = "C_LO" 'long
PP_TypeMod(13) = "!": PP_ConvertedMod(13) = "C_SI" 'single
PP_TypeMod(14) = "##": PP_ConvertedMod(14) = "C_FL" 'float
PP_TypeMod(15) = "#": PP_ConvertedMod(15) = "C_DO" 'double
PP_TypeMod(16) = "_RGB32": PP_ConvertedMod(16) = "C_RG" 'rgb32
PP_TypeMod(17) = "_RGBA32": PP_ConvertedMod(17) = "C_RA" 'rgba32
PP_TypeMod(18) = "_RED32": PP_ConvertedMod(18) = "C_RX" 'red32
PP_TypeMod(19) = "_GREEN32": PP_ConvertedMod(19) = "C_GR" 'green32
PP_TypeMod(20) = "_BLUE32": PP_ConvertedMod(20) = "C_BL" 'blue32
PP_TypeMod(21) = "_ALPHA32": PP_ConvertedMod(21) = "C_AL" 'alpha32
PP_TypeMod(22) = "RGB32": PP_ConvertedMod(22) = "C_RG" 'rgb32
PP_TypeMod(23) = "RGBA32": PP_ConvertedMod(23) = "C_RA" 'rgba32
PP_TypeMod(24) = "RED32": PP_ConvertedMod(24) = "C_RX" 'red32
PP_TypeMod(25) = "GREEN32": PP_ConvertedMod(25) = "C_GR" 'green32
PP_TypeMod(26) = "BLUE32": PP_ConvertedMod(26) = "C_BL" 'blue32
PP_TypeMod(27) = "ALPHA32": PP_ConvertedMod(27) = "C_AL" 'alpha32
Set_OrderOfOperations 'This will also make certain our directories are valid, and if not make them.
Do
Input math$
Print Evaluate_Expression(math$)
Loop
'Steve Subs/Functins for _MATH support with CONST
Function Evaluate_Expression$ (e$)
t$ = e$ 'So we preserve our original data, we parse a temp copy of it
PreParse t$
If Left$(t$, 5) = "ERROR" Then Evaluate_Expression$ = t$: Exit Function
'Deal with brackets first
exp$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
Do
Eval_E = InStr(exp$, ")")
If Eval_E > 0 Then
c = 0
Do Until Eval_E - c <= 0
c = c + 1
If Eval_E Then
If Mid$(exp$, Eval_E - c, 1) = "(" Then Exit Do
End If
Loop
s = Eval_E - c + 1
If s < 1 Then Evaluate_Expression$ = "ERROR -- BAD () Count": Exit Function
eval$ = " " + Mid$(exp$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
ParseExpression eval$
eval$ = LTrim$(RTrim$(eval$))
If Left$(eval$, 5) = "ERROR" Then Evaluate_Expression$ = eval$: Exit Function
exp$ = DWD(Left$(exp$, s - 2) + eval$ + Mid$(exp$, Eval_E + 1))
If Mid$(exp$, 1, 1) = "N" Then Mid$(exp$, 1) = "-"
End If
Loop Until Eval_E = 0
c = 0
Do
c = c + 1
Select Case Mid$(exp$, c, 1)
Case "0" To "9", ".", "-" 'At this point, we should only have number values left.
Case Else: Evaluate_Expression$ = "ERROR - Unknown Diagnosis: (" + exp$ + ") ": Exit Function
End Select
Loop Until c >= Len(exp$)
Evaluate_Expression$ = exp$
End Function
Sub ParseExpression (exp$)
Dim num(10) As String
'PRINT exp$
exp$ = DWD(exp$)
'We should now have an expression with no () to deal with
For J = 1 To 250
lowest = 0
Do Until lowest = Len(exp$)
lowest = Len(exp$): OpOn = 0
For P = 1 To UBound(OName)
'Look for first valid operator
If J = PL(P) Then 'Priority levels match
If Left$(exp$, 1) = "-" Then startAt = 2 Else startAt = 1
op = InStr(startAt, exp$, OName(P))
If op = 0 And Left$(OName(P), 1) = "_" And qb64prefix_set = 1 Then
'try again without prefix
op = InStr(startAt, exp$, Mid$(OName(P), 2))
If op > 0 Then
exp$ = Left$(exp$, op - 1) + "_" + Mid$(exp$, op)
lowest = lowest + 1
End If
End If
If op > 0 And op < lowest Then lowest = op: OpOn = P
End If
Next
If OpOn = 0 Then Exit Do 'We haven't gotten to the proper PL for this OP to be processed yet.
If Left$(exp$, 1) = "-" Then startAt = 2 Else startAt = 1
op = InStr(startAt, exp$, OName(OpOn))
numset = 0
'*** SPECIAL OPERATION RULESETS
If OName(OpOn) = "-" Then 'check for BOOLEAN operators before the -
Select Case Mid$(exp$, op - 3, 3)
Case "NOT", "XOR", "AND", "EQV", "IMP"
Exit Do 'Not an operator, it's a negative
End Select
If Mid$(exp$, op - 3, 2) = "OR" Then Exit Do 'Not an operator, it's a negative
End If
If op Then
c = Len(OName(OpOn)) - 1
Do
Select Case Mid$(exp$, op + c + 1, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N": numset = -1 'Valid digit
Case "-" 'We need to check if it's a minus or a negative
If OName(OpOn) = "_PI" Or numset Then Exit Do
Case ",": numset = 0
Case Else 'Not a valid digit, we found our separator
Exit Do
End Select
c = c + 1
Loop Until op + c >= Len(exp$)
E = op + c
c = 0
Do
c = c + 1
Select Case Mid$(exp$, op - c, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N" 'Valid digit
Case "-" 'We need to check if it's a minus or a negative
c1 = c
bad = 0
Do
c1 = c1 + 1
Select Case Mid$(exp$, op - c1, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "."
bad = -1
Exit Do 'It's a minus sign
Case Else
'It's a negative sign and needs to count as part of our numbers
End Select
Loop Until op - c1 <= 0
If bad Then Exit Do 'We found our seperator
Case Else 'Not a valid digit, we found our separator
Exit Do
End Select
Loop Until op - c <= 0
s = op - c
num(1) = Mid$(exp$, s + 1, op - s - 1) 'Get our first number
num(2) = Mid$(exp$, op + Len(OName(OpOn)), E - op - Len(OName(OpOn)) + 1) 'Get our second number
If Mid$(num(1), 1, 1) = "N" Then Mid$(num(1), 1) = "-"
If Mid$(num(2), 1, 1) = "N" Then Mid$(num(2), 1) = "-"
If num(1) = "-" Then
num(3) = "N" + EvaluateNumbers(OpOn, num())
Else
num(3) = EvaluateNumbers(OpOn, num())
End If
If Mid$(num(3), 1, 1) = "-" Then Mid$(num(3), 1) = "N"
If Left$(num(3), 5) = "ERROR" Then exp$ = num(3): Exit Sub
exp$ = LTrim$(N2S(DWD(Left$(exp$, s) + RTrim$(LTrim$(num(3))) + Mid$(exp$, E + 1))))
End If
op = 0
Loop
Next
End Sub
Sub Set_OrderOfOperations
'PL sets our priortity level. 1 is highest to 65535 for the lowest.
'I used a range here so I could add in new priority levels as needed.
'OName ended up becoming the name of our commands, as I modified things.... Go figure! LOL!
ReDim OName(10000) As String, PL(10000) As Integer
'Constants get evaluated first, with a Priority Level of 1
i = i + 1: OName(i) = "C_UOF": PL(i) = 5 'convert to unsigned offset
i = i + 1: OName(i) = "C_OF": PL(i) = 5 'convert to offset
i = i + 1: OName(i) = "C_UBY": PL(i) = 5 'convert to unsigned byte
i = i + 1: OName(i) = "C_BY": PL(i) = 5 'convert to byte
i = i + 1: OName(i) = "C_UIN": PL(i) = 5 'convert to unsigned integer
i = i + 1: OName(i) = "C_IN": PL(i) = 5 'convert to integer
i = i + 1: OName(i) = "C_UIF": PL(i) = 5 'convert to unsigned int64
i = i + 1: OName(i) = "C_IF": PL(i) = 5 'convert to int64
i = i + 1: OName(i) = "C_ULO": PL(i) = 5 'convert to unsigned long
i = i + 1: OName(i) = "C_LO": PL(i) = 5 'convert to long
i = i + 1: OName(i) = "C_SI": PL(i) = 5 'convert to single
i = i + 1: OName(i) = "C_FL": PL(i) = 5 'convert to float
i = i + 1: OName(i) = "C_DO": PL(i) = 5 'convert to double
i = i + 1: OName(i) = "C_UBI": PL(i) = 5 'convert to unsigned bit
i = i + 1: OName(i) = "C_BI": PL(i) = 5 'convert to bit
'Then Functions with PL 10
i = i + 1:: OName(i) = "_PI": PL(i) = 10
i = i + 1: OName(i) = "_ACOS": PL(i) = 10
i = i + 1: OName(i) = "_ASIN": PL(i) = 10
i = i + 1: OName(i) = "_ARCSEC": PL(i) = 10
i = i + 1: OName(i) = "_ARCCSC": PL(i) = 10
i = i + 1: OName(i) = "_ARCCOT": PL(i) = 10
i = i + 1: OName(i) = "_SECH": PL(i) = 10
i = i + 1: OName(i) = "_CSCH": PL(i) = 10
i = i + 1: OName(i) = "_COTH": PL(i) = 10
i = i + 1: OName(i) = "COS": PL(i) = 10
i = i + 1: OName(i) = "SIN": PL(i) = 10
i = i + 1: OName(i) = "TAN": PL(i) = 10
i = i + 1: OName(i) = "LOG": PL(i) = 10
i = i + 1: OName(i) = "EXP": PL(i) = 10
i = i + 1: OName(i) = "ATN": PL(i) = 10
i = i + 1: OName(i) = "_D2R": PL(i) = 10
i = i + 1: OName(i) = "_D2G": PL(i) = 10
i = i + 1: OName(i) = "_R2D": PL(i) = 10
i = i + 1: OName(i) = "_R2G": PL(i) = 10
i = i + 1: OName(i) = "_G2D": PL(i) = 10
i = i + 1: OName(i) = "_G2R": PL(i) = 10
i = i + 1: OName(i) = "ABS": PL(i) = 10
i = i + 1: OName(i) = "SGN": PL(i) = 10
i = i + 1: OName(i) = "INT": PL(i) = 10
i = i + 1: OName(i) = "_ROUND": PL(i) = 10
i = i + 1: OName(i) = "_CEIL": PL(i) = 10
i = i + 1: OName(i) = "FIX": PL(i) = 10
i = i + 1: OName(i) = "_SEC": PL(i) = 10
i = i + 1: OName(i) = "_CSC": PL(i) = 10
i = i + 1: OName(i) = "_COT": PL(i) = 10
i = i + 1: OName(i) = "ASC": PL(i) = 10
i = i + 1: OName(i) = "C_RG": PL(i) = 10 '_RGB32 converted
i = i + 1: OName(i) = "C_RA": PL(i) = 10 '_RGBA32 converted
i = i + 1: OName(i) = "_RGBA": PL(i) = 10
i = i + 1: OName(i) = "_RGB": PL(i) = 10
i = i + 1: OName(i) = "C_RX": PL(i) = 10 '_RED32 converted
i = i + 1: OName(i) = "C_GR": PL(i) = 10 ' _GREEN32 converted
i = i + 1: OName(i) = "C_BL": PL(i) = 10 '_BLUE32 converted
i = i + 1: OName(i) = "C_AL": PL(i) = 10 '_ALPHA32 converted
i = i + 1: OName(i) = "_RED": PL(i) = 10
i = i + 1: OName(i) = "_GREEN": PL(i) = 10
i = i + 1: OName(i) = "_BLUE": PL(i) = 10
i = i + 1: OName(i) = "_ALPHA": PL(i) = 10
'Exponents with PL 20
i = i + 1: OName(i) = "^": PL(i) = 20
i = i + 1: OName(i) = "SQR": PL(i) = 20
i = i + 1: OName(i) = "ROOT": PL(i) = 20
'Multiplication and Division PL 30
i = i + 1: OName(i) = "*": PL(i) = 30
i = i + 1: OName(i) = "/": PL(i) = 30
'Integer Division PL 40
i = i + 1: OName(i) = "\": PL(i) = 40
'MOD PL 50
i = i + 1: OName(i) = "MOD": PL(i) = 50
'Addition and Subtraction PL 60
i = i + 1: OName(i) = "+": PL(i) = 60
i = i + 1: OName(i) = "-": PL(i) = 60
'Relational Operators =, >, <, <>, <=, >= PL 70
i = i + 1: OName(i) = "<>": PL(i) = 70 'These next three are just reversed symbols as an attempt to help process a common typo
i = i + 1: OName(i) = "><": PL(i) = 70
i = i + 1: OName(i) = "<=": PL(i) = 70
i = i + 1: OName(i) = ">=": PL(i) = 70
i = i + 1: OName(i) = "=<": PL(i) = 70 'I personally can never keep these things straight. Is it < = or = <...
i = i + 1: OName(i) = "=>": PL(i) = 70 'Who knows, check both!
i = i + 1: OName(i) = ">": PL(i) = 70
i = i + 1: OName(i) = "<": PL(i) = 70
i = i + 1: OName(i) = "=": PL(i) = 70
'Logical Operations PL 80+
i = i + 1: OName(i) = "NOT": PL(i) = 80
i = i + 1: OName(i) = "AND": PL(i) = 90
i = i + 1: OName(i) = "OR": PL(i) = 100
i = i + 1: OName(i) = "XOR": PL(i) = 110
i = i + 1: OName(i) = "EQV": PL(i) = 120
i = i + 1: OName(i) = "IMP": PL(i) = 130
i = i + 1: OName(i) = ",": PL(i) = 1000
ReDim _Preserve OName(i) As String, PL(i) As Integer
End Sub
Function EvaluateNumbers$ (p, num() As String)
Dim n1 As _Float, n2 As _Float, n3 As _Float
'PRINT "EVALNUM:"; OName(p), num(1), num(2)
If _Trim$(num(1)) = "" Then num(1) = "0"
If PL(p) >= 20 And (Len(_Trim$(num(1))) = 0 Or Len(_Trim$(num(2))) = 0) Then
EvaluateNumbers$ = "ERROR - Missing operand": Exit Function
End If
If InStr(num(1), ",") Then
EvaluateNumbers$ = "ERROR - Invalid comma (" + num(1) + ")": Exit Function
End If
l2 = InStr(num(2), ",")
If l2 Then
Select Case OName(p) 'only certain commands should pass a comma value
Case "C_RG", "C_RA", "_RGB", "_RGBA", "_RED", "_GREEN", "_BLUE", "C_BL", "_ALPHA"
Case Else
C$ = Mid$(num(2), l2)
num(2) = Left$(num(2), l2 - 1)
End Select
End If
Select Case PL(p) 'divide up the work so we want do as much case checking
Case 5 'Type conversions
'Note, these are special cases and work with the number BEFORE the command and not after
Select Case OName(p) 'Depending on our operator..
Case "C_UOF": n1~%& = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1~%&)))
Case "C_ULO": n1%& = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1%&)))
Case "C_UBY": n1~%% = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1~%%)))
Case "C_UIN": n1~% = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1~%)))
Case "C_BY": n1%% = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1%%)))
Case "C_IN": n1% = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1%)))
Case "C_UIF": n1~&& = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1~&&)))
Case "C_OF": n1~& = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1~&)))
Case "C_IF": n1&& = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1&&)))
Case "C_LO": n1& = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1&)))
Case "C_UBI": n1~` = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1~`)))
Case "C_BI": n1` = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1`)))
Case "C_FL": n1## = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1##)))
Case "C_DO": n1# = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1#)))
Case "C_SI": n1! = Val(num(1)): EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1!)))
End Select
Exit Function
Case 10 'functions
Select Case OName(p) 'Depending on our operator..
Case "_PI"
n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
If num(2) <> "" Then n1 = n1 * Val(num(2))
Case "_ACOS": n1 = _Acos(Val(num(2)))
Case "_ASIN": n1 = _Asin(Val(num(2)))
Case "_ARCSEC": n1 = _Arcsec(Val(num(2)))
Case "_ARCCSC": n1 = _Arccsc(Val(num(2)))
Case "_ARCCOT": n1 = _Arccot(Val(num(2)))
Case "_SECH": n1 = _Sech(Val(num(2)))
Case "_CSCH": n1 = _Csch(Val(num(2)))
Case "_COTH": n1 = _Coth(Val(num(2)))
Case "C_RG"
n$ = num(2)
If n$ = "" Then EvaluateNumbers$ = "ERROR - Invalid null _RGB32": Exit Function
c1 = InStr(n$, ",")
If c1 Then c2 = InStr(c1 + 1, n$, ",")
If c2 Then c3 = InStr(c2 + 1, n$, ",")
If c3 Then c4 = InStr(c3 + 1, n$, ",")
If c1 = 0 Then 'there's no comma in the command to parse. It's a grayscale value
n = Val(num(2))
n1 = _RGB32(n, n, n)
ElseIf c2 = 0 Then 'there's one comma and not 2. It's grayscale with alpha.
n = Val(Left$(num(2), c1))
n2 = Val(Mid$(num(2), c1 + 1))
n1 = _RGBA32(n, n, n, n2)
ElseIf c3 = 0 Then 'there's two commas. It's _RGB values
n = Val(Left$(num(2), c1))
n2 = Val(Mid$(num(2), c1 + 1))
n3 = Val(Mid$(num(2), c2 + 1))
n1 = _RGB32(n, n2, n3)
ElseIf c4 = 0 Then 'there's three commas. It's _RGBA values
n = Val(Left$(num(2), c1))
n2 = Val(Mid$(num(2), c1 + 1))
n3 = Val(Mid$(num(2), c2 + 1))
n4 = Val(Mid$(num(2), c3 + 1))
n1 = _RGBA32(n, n2, n3, n4)
Else 'we have more than three commas. I have no idea WTH type of values got passed here!
EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": Exit Function
End If
Case "C_RA"
n$ = num(2)
If n$ = "" Then EvaluateNumbers$ = "ERROR - Invalid null _RGBA32": Exit Function
c1 = InStr(n$, ",")
If c1 Then c2 = InStr(c1 + 1, n$, ",")
If c2 Then c3 = InStr(c2 + 1, n$, ",")
If c3 Then c4 = InStr(c3 + 1, n$, ",")
If c3 = 0 Or c4 <> 0 Then EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + ")": Exit Function
'we have to have 3 commas; not more, not less.
n = Val(Left$(num(2), c1))
n2 = Val(Mid$(num(2), c1 + 1))
n3 = Val(Mid$(num(2), c2 + 1))
n4 = Val(Mid$(num(2), c3 + 1))
n1 = _RGBA32(n, n2, n3, n4)
Case "_RGB"
n$ = num(2)
If n$ = "" Then EvaluateNumbers$ = "ERROR - Invalid null _RGB": Exit Function
c1 = InStr(n$, ",")
If c1 Then c2 = InStr(c1 + 1, n$, ",")
If c2 Then c3 = InStr(c2 + 1, n$, ",")
If c3 Then c4 = InStr(c3 + 1, n$, ",")
If c3 = 0 Or c4 <> 0 Then EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGB requires 4 parameters for Red, Green, Blue, ScreenMode.": Exit Function
'we have to have 3 commas; not more, not less.
n = Val(Left$(num(2), c1))
n2 = Val(Mid$(num(2), c1 + 1))
n3 = Val(Mid$(num(2), c2 + 1))
n4 = Val(Mid$(num(2), c3 + 1))
Select Case n4
Case 0 To 2, 7 To 13, 256, 32 'these are the good screen values
Case Else
EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + Str$(n4) + ")": Exit Function
End Select
t = _NewImage(1, 1, n4)
n1 = _RGB(n, n2, n3, t)
_FreeImage t
Case "_RGBA"
n$ = num(2)
If n$ = "" Then EvaluateNumbers$ = "ERROR - Invalid null _RGBA": Exit Function
c1 = InStr(n$, ",")
If c1 Then c2 = InStr(c1 + 1, n$, ",")
If c2 Then c3 = InStr(c2 + 1, n$, ",")
If c3 Then c4 = InStr(c3 + 1, n$, ",")
If c4 Then c5 = InStr(c4 + 1, n$, ",")
If c4 = 0 Or c5 <> 0 Then EvaluateNumbers$ = "ERROR - Invalid comma count (" + num(2) + "). _RGBA requires 5 parameters for Red, Green, Blue, Alpha, ScreenMode.": Exit Function
'we have to have 4 commas; not more, not less.
n = Val(Left$(num(2), c1))
n2 = Val(Mid$(num(2), c1 + 1))
n3 = Val(Mid$(num(2), c2 + 1))
n4 = Val(Mid$(num(2), c3 + 1))
n5 = Val(Mid$(num(2), c4 + 1))
Select Case n5
Case 0 To 2, 7 To 13, 256, 32 'these are the good screen values
Case Else
EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + Str$(n5) + ")": Exit Function
End Select
t = _NewImage(1, 1, n5)
n1 = _RGBA(n, n2, n3, n4, t)
_FreeImage t
Case "_RED", "_GREEN", "_BLUE", "_ALPHA"
n$ = num(2)
If n$ = "" Then EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): Exit Function
c1 = InStr(n$, ",")
If c1 = 0 Then EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": Exit Function
If c1 Then c2 = InStr(c1 + 1, n$, ",")
If c2 Then EvaluateNumbers$ = "ERROR - " + OName(p) + " requires 2 parameters for Color, ScreenMode.": Exit Function
n = Val(Left$(num(2), c1))
n2 = Val(Mid$(num(2), c1 + 1))
Select Case n2
Case 0 To 2, 7 To 13, 256, 32 'these are the good screen values
Case Else
EvaluateNumbers$ = "ERROR - Invalid Screen Mode (" + Str$(n2) + ")": Exit Function
End Select
t = _NewImage(1, 1, n4)
Select Case OName(p)
Case "_RED": n1 = _Red(n, t)
Case "_BLUE": n1 = _Blue(n, t)
Case "_GREEN": n1 = _Green(n, t)
Case "_ALPHA": n1 = _Alpha(n, t)
End Select
_FreeImage t
Case "C_RX", "C_GR", "C_BL", "C_AL"
n$ = num(2)
If n$ = "" Then EvaluateNumbers$ = "ERROR - Invalid null " + OName(p): Exit Function
n = Val(num(2))
Select Case OName(p)
Case "C_RX": n1 = _Red32(n)
Case "C_BL": n1 = _Blue32(n)
Case "C_GR": n1 = _Green32(n)
Case "C_AL": n1 = _Alpha32(n)
End Select
Case "COS": n1 = Cos(Val(num(2)))
Case "SIN": n1 = Sin(Val(num(2)))
Case "TAN": n1 = Tan(Val(num(2)))
Case "LOG": n1 = Log(Val(num(2)))
Case "EXP": n1 = Exp(Val(num(2)))
Case "ATN": n1 = Atn(Val(num(2)))
Case "_D2R": n1 = 0.0174532925 * (Val(num(2)))
Case "_D2G": n1 = 1.1111111111 * (Val(num(2)))
Case "_R2D": n1 = 57.2957795 * (Val(num(2)))
Case "_R2G": n1 = 0.015707963 * (Val(num(2)))
Case "_G2D": n1 = 0.9 * (Val(num(2)))
Case "_G2R": n1 = 63.661977237 * (Val(num(2)))
Case "ABS": n1 = Abs(Val(num(2)))
Case "SGN": n1 = Sgn(Val(num(2)))
Case "INT": n1 = Int(Val(num(2)))
Case "_ROUND": n1 = _Round(Val(num(2)))
Case "_CEIL": n1 = _Ceil(Val(num(2)))
Case "FIX": n1 = Fix(Val(num(2)))
Case "_SEC": n1 = _Sec(Val(num(2)))
Case "_CSC": n1 = _Csc(Val(num(2)))
Case "_COT": n1 = _Cot(Val(num(2)))
End Select
Case 20 To 60 'Math Operators
Select Case OName(p) 'Depending on our operator..
Case "^": n1 = Val(num(1)) ^ Val(num(2))
Case "SQR": n1 = Sqr(Val(num(2)))
Case "ROOT"
n1 = Val(num(1)): n2 = Val(num(2))
If n2 = 1 Then EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1))): Exit Function
If n1 < 0 And n2 >= 1 Then sign = -1: n1 = -n1 Else sign = 1
n3 = 1## / n2
If n3 <> Int(n3) And n2 < 1 Then sign = Sgn(n1): n1 = Abs(n1)
n1 = sign * (n1 ^ n3)
Case "*": n1 = Val(num(1)) * Val(num(2))
Case "/"
If Val(num(2)) <> 0 Then
n1 = Val(num(1)) / Val(num(2))
Else
EvaluateNumbers$ = "ERROR - Division By Zero"
Exit Function
End If
Case "\"
If _Round(Val(num(2))) = 0 Then
EvaluateNumbers$ = "ERROR - Division By Zero"
Exit Function
End If
n1 = Val(num(1)) \ _Round(Val(num(2)))
Case "MOD"
If _Round(Val(num(2))) = 0 Then
EvaluateNumbers$ = "ERROR - Division By Zero"
Exit Function
End If
n1 = Val(num(1)) Mod _Round(Val(num(2)))
Case "+": n1 = Val(num(1)) + Val(num(2))
Case "-":
n1 = Val(num(1)) - Val(num(2))
End Select
Case 70 'Relational Operators =, >, <, <>, <=, >=
Select Case OName(p) 'Depending on our operator..
Case "=": n1 = Val(num(1)) = Val(num(2))
Case ">": n1 = Val(num(1)) > Val(num(2))
Case "<": n1 = Val(num(1)) < Val(num(2))
Case "<>", "><": n1 = Val(num(1)) <> Val(num(2))
Case "<=", "=<": n1 = Val(num(1)) <= Val(num(2))
Case ">=", "=>": n1 = Val(num(1)) >= Val(num(2))
End Select
Case Else 'a value we haven't processed elsewhere
Select Case OName(p) 'Depending on our operator..
Case "NOT": n1 = Not Val(num(2))
Case "AND": n1 = Val(num(1)) And Val(num(2))
Case "OR": n1 = Val(num(1)) Or Val(num(2))
Case "XOR": n1 = Val(num(1)) Xor Val(num(2))
Case "EQV": n1 = Val(num(1)) Eqv Val(num(2))
Case "IMP": n1 = Val(num(1)) Imp Val(num(2))
End Select
End Select
EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1))) + C$
End Function
Function DWD$ (exp$) 'Deal With Duplicates
'To deal with duplicate operators in our code.
'Such as -- becomes a +
'++ becomes a +
'+- becomes a -
'-+ becomes a -
t$ = exp$
Do
bad = 0
Do
l = InStr(t$, "++")
If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "+-")
If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "-+")
If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "--")
If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Loop Until Not bad
DWD$ = t$
End Function
Sub PreParse (e$)
Dim f As _Float
Do 'convert &H values to decimal values to prevent errors
l = InStr(l, UCase$(e$), "&H")
If l Then
For l1 = l + 2 To Len(e$)
Select Case UCase$(Mid$(e$, l1, 1))
Case "0" To "9"
Case "A" To "F"
Case Else:
Print UCase$(Mid$(e$, l1, 1))
Exit For
End Select
Next
If l1 <> l + 2 Then 'hex number found
If l1 > l + 18 Then Exit Do
l$ = Left$(e$, l - 1)
r$ = Mid$(e$, l1)
t~&& = Val(Mid$(e$, l, l1 - l) + "~&&")
m$ = _Trim$(Str$(t~&&))
e$ = l$ + m$ + r$
Else
Exit Do
End If
End If
Loop Until l = 0
'Turn all &B (binary) numbers into decimal values for the program to process properly
l = 0
Do
l = InStr(t$, "&B")
If l Then
e = l + 1: finished = 0
Do
e = e + 1
comp$ = Mid$(t$, e, 1)
Select Case comp$
Case "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
Case Else
good = 0
For i = 1 To UBound(OName)
If Mid$(t$, e, Len(OName(i))) = OName(i) And PL(i) > 1 And PL(i) <= 250 Then good = -1: Exit For 'We found an operator after our ), and it's not a CONST (like PI)
Next
If Not good Then e$ = "ERROR - Improper &B value. (" + comp$ + ")": Exit Sub
e = e - 1
finished = -1
End Select
Loop Until finished Or e = Len(t$)
bin$ = Mid$(t$, l + 2, e - l - 1)
For i = 1 To Len(bin$)
If Mid$(bin$, i, 1) = "1" Then f = f + 2 ^ (Len(bin$) - i)
Next
t$ = Left$(t$, l - 1) + LTrim$(RTrim$(Str$(f))) + Mid$(t$, e + 1)
End If
Loop Until l = 0
'First strip all spaces
t$ = ""
For i = 1 To Len(e$)
If Mid$(e$, i, 1) <> " " Then t$ = t$ + Mid$(e$, i, 1)
Next
t$ = UCase$(t$)
If t$ = "" Then e$ = "ERROR -- NULL string; nothing to evaluate": Exit Sub
'ERROR CHECK by counting our brackets
l = 0
Do
l = InStr(l + 1, t$, "("): If l Then c = c + 1
Loop Until l = 0
l = 0
Do
l = InStr(l + 1, t$, ")"): If l Then c1 = c1 + 1
Loop Until l = 0
If c <> c1 Then e$ = "ERROR -- Bad Parenthesis:" + Str$(c) + "( vs" + Str$(c1) + ")": Exit Sub
'Modify so that NOT will process properly
l = 0
Do
l = InStr(l + 1, t$, "NOT ")
If l Then
'We need to work magic on the statement so it looks pretty.
' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
'Look for something not proper
l1 = InStr(l + 1, t$, "AND")
If l1 = 0 Or (InStr(l + 1, t$, "OR") > 0 And InStr(l + 1, t$, "OR") < l1) Then l1 = InStr(l + 1, t$, "OR")
If l1 = 0 Or (InStr(l + 1, t$, "XOR") > 0 And InStr(l + 1, t$, "XOR") < l1) Then l1 = InStr(l + 1, t$, "XOR")
If l1 = 0 Or (InStr(l + 1, t$, "EQV") > 0 And InStr(l + 1, t$, "EQV") < l1) Then l1 = InStr(l + 1, t$, "EQV")
If l1 = 0 Or (InStr(l + 1, t$, "IMP") > 0 And InStr(l + 1, t$, "IMP") < l1) Then l1 = InStr(l + 1, t$, "IMP")
If l1 = 0 Then l1 = Len(t$) + 1
t$ = Left$(t$, l - 1) + "(" + Mid$(t$, l, l1 - l) + ")" + Mid$(t$, l + l1 - l)
l = l + 3
'PRINT t$
End If
Loop Until l = 0
For j = 1 To UBound(PP_TypeMod)
l = 0
Do
l = InStr(l + 1, t$, PP_TypeMod(j))
If l = 0 Then Exit Do
i = 0: l1 = 0: l2 = 0: lo = Len(PP_TypeMod(j))
Do
If PL(i) > 10 Then
l2 = _InStrRev(l, t$, OName$(i))
If l2 > 0 And l2 > l1 Then l1 = l2
End If
i = i + lo
Loop Until i > UBound(PL)
l$ = Left$(t$, l1)
m$ = Mid$(t$, l1 + 1, l - l1 - 1)
r$ = PP_ConvertedMod(j) + Mid$(t$, l + lo)
If j > 15 Then
t$ = l$ + m$ + r$ 'replacement routine for commands which might get confused with others, like _RGB and _RGB32
Else
'the first 15 commands need to properly place the parenthesis around the value we want to convert.
t$ = l$ + "(" + m$ + ")" + r$
End If
l = l + 2 + Len(PP_TypeMod(j)) 'move forward from the length of the symbol we checked + the new "(" and ")"
Loop
Next
'Check for bad operators before a ( bracket
l = 0
Do
l = InStr(l + 1, t$, "(")
If l > 0 And l > 2 Then 'Don't check the starting bracket; there's nothing before it.
good = 0
For i = 1 To UBound(OName)
m$ = Mid$(t$, l - Len(OName(i)), Len(OName(i)))
If m$ = OName(i) Then
good = -1: Exit For 'We found an operator after our ), and it's not a CONST (like PI)
Else
If Left$(OName(i), 1) = "_" And qb64prefix_set = 1 Then
'try without prefix
m$ = Mid$(t$, l - (Len(OName(i)) - 1), Len(OName(i)) - 1)
If m$ = Mid$(OName(i), 2) Then good = -1: Exit For
End If
End If
Next
If Not good Then e$ = "ERROR - Improper operations before (.": Exit Sub
l = l + 1
End If
Loop Until l = 0
'Check for bad operators after a ) bracket
l = 0
Do
l = InStr(l + 1, t$, ")")
If l > 0 And l < Len(t$) Then
good = 0
For i = 1 To UBound(OName)
m$ = Mid$(t$, l + 1, Len(OName(i)))
If m$ = OName(i) Then
good = -1: Exit For 'We found an operator after our ), and it's not a CONST (like PI
Else
If Left$(OName(i), 1) = "_" And qb64prefix_set = 1 Then
'try without prefix
m$ = Mid$(t$, l + 1, Len(OName(i)) - 1)
If m$ = Mid$(OName(i), 2) Then good = -1: Exit For
End If
End If
Next
If Mid$(t$, l + 1, 1) = ")" Then good = -1
If Not good Then e$ = "ERROR - Improper operations after ).": Exit Sub
l = l + 1
End If
Loop Until l = 0 Or l = Len(t$) 'last symbol is a bracket
't$ = N2S(t$)
VerifyString t$
e$ = t$
End Sub
Sub VerifyString (t$)
'ERROR CHECK for unrecognized operations
j = 1
Do
comp$ = Mid$(t$, j, 1)
Select Case comp$
Case "0" To "9", ".", "(", ")", ",": j = j + 1
Case Else
good = 0
extrachar = 0
For i = 1 To UBound(OName)
If Mid$(t$, j, Len(OName(i))) = OName(i) Then
good = -1: Exit For 'We found an operator after our ), and it's not a CONST (like PI)
Else
If Left$(OName(i), 1) = "_" And qb64prefix_set = 1 Then
'try without prefix
If Mid$(t$, j, Len(OName(i)) - 1) = Mid$(OName(i), 2) Then
good = -1: extrachar = 1: Exit For
End If
End If
End If
Next
If Not good Then t$ = "ERROR - Bad Operational value. (" + comp$ + ")": Exit Sub
j = j + (Len(OName(i)) - extrachar)
End Select
Loop Until j > Len(t$)
End Sub
Function N2S$ (exp$) 'scientific Notation to String
t$ = LTrim$(RTrim$(exp$))
If Left$(t$, 1) = "-" Or Left$(t$, 1) = "N" Then sign$ = "-": t$ = Mid$(t$, 2)
dp = InStr(t$, "D+"): dm = InStr(t$, "D-")
ep = InStr(t$, "E+"): em = InStr(t$, "E-")
check1 = Sgn(dp) + Sgn(dm) + Sgn(ep) + Sgn(em)
If check1 < 1 Or check1 > 1 Then N2S = exp$: Exit Function 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
Select Case l 'l now tells us where the SN starts at.
Case Is < dp: l = dp
Case Is < dm: l = dm
Case Is < ep: l = ep
Case Is < em: l = em
End Select
l$ = Left$(t$, l - 1) 'The left of the SN
r$ = Mid$(t$, l + 1): r&& = Val(r$) 'The right of the SN, turned into a workable long
If InStr(l$, ".") Then 'Location of the decimal, if any
If r&& > 0 Then
r&& = r&& - Len(l$) + 2
Else
r&& = r&& + 1
End If
l$ = Left$(l$, 1) + Mid$(l$, 3)
End If
Select Case r&&
Case 0 'what the heck? We solved it already?
'l$ = l$
Case Is < 0
For i = 1 To -r&&
l$ = "0" + l$
Next
l$ = "0." + l$
Case Else
For i = 1 To r&&
l$ = l$ + "0"
Next
End Select
N2S$ = sign$ + l$
End Function
![[Image: image.png]](https://i.ibb.co/0XdSR42/image.png)
|
|
|
|
| suggestion: change to _MEMFREE |
|
Posted by: OldMoses - 12-11-2022, 12:43 PM - Forum: General Discussion
- Replies (5)
|
 |
While working with _MEM blocks and freeing them, it occurred to me that perhaps it would be a useful alteration to have _MEMFREE work similar to the new DIM syntax, where one can:
DIM AS INTEGER a, b, c, etc.
Where instead of the required syntax following:
_MEMFREE m
_MEMFREE m2
_MEMFREE m3
One could do:
_MEMFREE m, m2, m3
Would there be any interest in such a change, or would that be too difficult of an implementation?
|
|
|
|
| Chat with Me -- HOST |
|
Posted by: SMcNeill - 12-11-2022, 12:30 PM - Forum: General Discussion
- Replies (61)
|
|
Now, as I mentioned in the topic Come chat with me! (qb64phoenix.com), I told you guys I was going to share the HOST part of the program which we were all using to play around and chat with yesterday -- and try to highlight the steps necessary to get it to run properly for everyone.
First, let's start with the code. We'll begin with the HOST version of my Mini Messenger (qb64phoenix.com):
Code: (Select All) DIM SHARED Users(1 TO 1000) ' array to hold other client info
DIM SHARED NumClients
DIM SHARED out$
PRINT "[Steve's Mini Messenger]"
host = _OPENHOST("TCP/IP:7319") ' no host found, so begin new host
IF host THEN
PRINT "[Beginning new host chat session!]"
NumClients = 0
client = _OPENCLIENT("TCP/IP:7319:localhost")
IF client = 0 THEN PRINT "ERROR: could not attach host's personal client to host!"
INPUT "Enter your name:", myname$
'PRINT #client, myname$ + " connected!"
PRINT "[Chat session active!]"
ELSE
PRINT "ERROR: Could not begin new host!"
END IF ' host
DO ' host main loop
newclient = _OPENCONNECTION(host) ' receive any new connection
IF newclient THEN
NumClients = NumClients + 1
Users(NumClients) = newclient
PRINT "Welcome to Steve's Mini Messenger!"
END IF
FOR i = 1 TO NumClients
GetMessage Users(i) 'check all clients for a message
IF out$ <> "" THEN
l = LEN(out$)
FOR j = 1 TO NumClients ' distribute incoming messages to all clients
PUT #Users(j), , l
PUT #Users(j), , out$
NEXT
END IF
NEXT i
SendMessage myname$, mymessage$, client
_LIMIT 30
LOOP
SUB GetMessage (client) ' get & display any new message
GET #client, , l
IF l > 0 THEN
out$ = SPACE$(l)
GET #client, , out$
VIEW PRINT 1 TO 20
LOCATE 20, 1
PRINT out$
VIEW PRINT 1 TO 24
ELSE
out$ = ""
END IF
END SUB
SUB SendMessage (myname$, mymessage$, client) ' simple input handler
k$ = INKEY$
IF LEN(k$) THEN
IF k$ = CHR$(8) AND LEN(mymessage$) <> 0 THEN
mymessage$ = LEFT$(mymessage$, LEN(mymessage$) - 1)
ELSE
IF LEN(k$) = 1 AND ASC(k$) >= 32 THEN mymessage$ = mymessage$ + k$
END IF
END IF
VIEW PRINT 1 TO 24
LOCATE 22, 1: PRINT SPACE$(80); ' erase previous message displayed
LOCATE 22, 1: PRINT myname$ + ": "; mymessage$;
IF k$ = CHR$(13) THEN ' [Enter] sends the message
IF mymessage$ = "" THEN SYSTEM ' [Enter] with no message ends program
mymessage$ = myname$ + ":" + mymessage$
l = LEN(mymessage$)
PUT #client, , l
PUT #client, , mymessage$
mymessage$ = ""
END IF
IF k$ = CHR$(27) THEN SYSTEM ' [Esc] key ends program
END SUB[color=#cccccc][font=Monaco, Consolas, Courier, monospace][/font][/color]
Now, I tried to keep this as simple as I possibly could -- without any bells or whistles to complicate the viewing and understanding of the basic process we're using here -- so don't think this is anything fancy at all. All this basically does is show how to set up a host connection, accept users trying to connect to that connection, and then transfer information back and forth between the two.
It's a demo to showcase the very bare bones of the TCP/IP stuff, and nothing more, so keep that in mind as we go along and talk about things. 
First change needed to swap this over from LOCALHOST to world wide web hosting involves... dum dum de dum.... Opening a browser tab and going to What Is My IP? Shows Your Public IP Address - IPv4 - IPv6. If you're using a VPN or such to protect your IP, you may be able to get by with using it, or you may not. That all depends on your VPN's safety protocols. If it just forwards anything that comes its way back your way, you're fine. If it wants you to open ports and such as that and only forward certain things, then you're screwed unless you jump through their hoops and allow the transfer.
My advice here: Use your actual web address. 172.83.131.239 happens to be my permanent little home on the web. From time to time, I tend to host my own website, and I need a static IP so I can always connect to it when it's up and going. Most folks have a dynamic IP, which is assigned to them randomly every time they connect to the internet (it costs extra $$ each month for a static IP), so you'll need to update your chat program with the current IP with each reboot of your computer.
Once you've gotten your IP address, you can now go into the code above and make the drastic change from local to www connections:
Code: (Select All) client = _OpenClient("TCP/IP:7319:localhost")
Change the line above to where it now has your IP address, rather than "localhost".
Code: (Select All) client = _OpenClient("TCP/IP:7319:172.83.131.239")
^That's what it'll look like for me. For you, the same, except with a different IP address in there.
And that's basically the ONLY TCP/IP requirement that QB64-PE makes you have to change to make it work and communicate across the net!
And chances are, if some of you try to make that work, it's not going to work for you. In fact, I'd bet against it. 
WHY??
First is the TCP/IP:7319... What the heck is that 7319, and why is it in there?
It's one of the multitude of ports which our modern PCs have available for us to use to communicate with things. How was 7319 chosen? That was all just Steve, picking an unused port on my PC, and deciding, "I'm ah gonna use dis one!" Most of the time, our modern routers tend to lock down port access for most people and things. You have one or two ports open for common stuff (like http and https transfers), but the rest of those ports are locked for security purposes.
Since there's a zillion different routers, and a zillion different ways they're configured, with a zillion different sets of software to interact with them, *I CAN'T HELP YOU WITH YOUR ROUTER SETTINGS.* You'll have to Google, dig out the manual that came packaged when you bought the router, or call your ISP and ask them to help. At the end of the day though, you're NOT going to be able to share communications unless you're sharing on a port that's opened and allows it. <--This part, unfortunately, you're on your own to puzzle out. All I can say is "Open your router settings, choose a port you like that's not currently in use, and open it -- however you do that on your router."
Once you've got an open port, and if it's not 7319 like I chose for it to be, then you'd need to change your program to work on the port you've chosen.
Code: (Select All) client = _OpenClient("TCP/IP:####:172.83.131.239")
Try that, and it MAY work for you. Once again, however, I'd be willing to bet against it.
Once more, go into your router settings, and this time look for PORT FORWARDING. Most of us have multiple devices set up for the internet. Our phones are connected, as is our pc, our ipad, our tv, all our damn smart lightbulbs... You probably need to do a little more specific directing with port forwarding to tell your router where you want to send that open port information to.
Once again, I'm sorry, but I can't really help much with this step as every router has it's own software and way of interacting with you.
![[Image: image.png]](https://i.ibb.co/wQjS5vB/image.png)
Click on the image above, if you want, and it'll show my router's port forwarding setup. The first three and where I host my own private server from time to time (ports 80 and 443 and http and https traffic, while 3306 is where my SQL Database likes to communicate back and forth when it's up and running). The last entry in that list, however, is the one of interest for you guys -- Laptop Forwarding on port 7319, and which is going to 10.243.1.77...
That 10.242.1.77 is my laptop's local address on my network. By setting up port forwarding like this, communications on port 7319 are now routed directly to it, allowing it to communicate with the rest of the world.
Once you've set up the open port, and forwarded it to your machine which is going to run the compiled EXE, chances are you're good to go!! Your firewall might pop up a question "Do you really want to allow this", but you can feel free to tell it to pisser off. You've got to let the information travel back and forth to your PC, or else you'll never be able to communicate on an open port like this with the outside world.
So you run it... And it works!! YAAAAAAYYYY!!!
You go to bed, get up the next morning, notice that Windows did an update on you, and it now no longer works. WTF?!! (I can just hear some of you cussing already! No worries -- no judgement. I've been there as well!!)
Two important things to keep in mind:
1) If you don't have a permanent STATIC IP address (you'll know if you do because you asked for it specifically from your ISP and are paying extra each month for it), then your IP address is dynamically allocated for you. You'll need to get the new address, swap it into your program, and try it again.
2) And if number one doesn't fix the issue, problem number two is... dum dum de dum... once again dynamic addresses. That last step that we did, with the port forwarding... Remember it? You forwarded your data to a specific local IP address... If you don't have that configured as a static address (set up manually instead of automatic), then it may not be the same as it was before either. You may have to go back and change your port forwarding address once again so it works as you'd expect.
|
|
|
|
| Playing with the mouse |
|
Posted by: NasaCow - 12-11-2022, 07:59 AM - Forum: Help Me!
- Replies (13)
|
 |
I am running this program to play with the mouse, just playing with things to understand it before trying to imbed it into something else.
Code: (Select All) $NOPREFIX
CONST FALSE = 0, TRUE = NOT FALSE
TYPE MouseType
EndX AS INTEGER
EndY AS INTEGER
StartX AS INTEGER
StartY AS INTEGER
LButDown AS INTEGER
RButDown AS INTEGER
OldLBut AS INTEGER
OldRBut AS INTEGER
END TYPE
SCREEN NEWIMAGE(1280, 720, 32)
DIM AS MouseType Mouse
DIM AS INTEGER highlight(500000)
DIM AS BIT Active
Mouse.OldLBut = --1
Active = FALSE
LINE (500, 200)-(600, 300), RGB(0, 0, 255), BF
DO
'LIMIT 120
DO WHILE MOUSEINPUT
LOOP
Mouse.StartX = MOUSEX
Mouse.StartY = MOUSEY
Mouse.LButDown = MOUSEBUTTON(1)
IF Mouse.StartX >= 500 AND Mouse.StartX <= 600 AND Mouse.StartY >= 200 AND Mouse.StartY <= 300 AND NOT Active THEN
GET (500, 200)-(600, 300), highlight()
PUT (500, 200), highlight(), PRESET
Active = TRUE
ELSEIF Active EQV Mouse.StartX < 500 OR Mouse.StartX > 600 OR Mouse.StartY < 200 OR Mouse.StartY > 300 THEN
GET (500, 200)-(600, 300), highlight()
PUT (500, 200), highlight(), PRESET
Active = FALSE
END IF
IF Mouse.LButDown AND NOT Mouse.OldLBut THEN
LOCATE 1, 1
PRINT Mouse.StartX, Mouse.StartY, Mouse.LButDown
END IF
Mouse.OldLBut = Mouse.LButDown
LOOP UNTIL INKEY$ = CHR$(27)
and it is working as expected with a box highlighting and not but I don't understand why this if statement needs EQV:
Code: (Select All) ELSEIF Active EQV Mouse.StartX < 500 OR Mouse.StartX > 600 OR Mouse.StartY < 200 OR Mouse.StartY > 300 THEN
GET (500, 200)-(600, 300), highlight()
PUT (500, 200), highlight(), PRESET
Active = FALSE
END IF
than the one I was trying to work with at first:
Code: (Select All) ELSEIF Active AND Mouse.StartX < 500 OR Mouse.StartX > 600 OR Mouse.StartY < 200 OR Mouse.StartY > 300 THEN
GET (500, 200)-(600, 300), highlight()
PUT (500, 200), highlight(), PRESET
Active = FALSE
END IF
My belief that If (false and True or True or True or True) should return a false with false and true.... condition.
Never used EQV before but the table on the wiki implies both should return false. Maybe someone can educate me where my logic has gone wrong? Many thanks 
|
|
|
|
| DAY 030: _CONTROLCHR |
|
Posted by: Pete - 12-11-2022, 02:13 AM - Forum: Keyword of the Day!
- Replies (5)
|
|
Ever want to be able to see the ASCII characters that do things like eject the printer paper, CHR$(12)? Well with the keyword _CONTROLCHR OFF, you can! And if you act now, because we can't do this all day, we'll throw in _CONTROLCHR$ ON at no extra charge. Just pay separate shipping and handling.
SYNTAX _CONTROLCHR {OFF|ON}
Code: (Select All) WIDTH 127, 20
_FONT 16
_KEYCLEAR
msg$ = "ASCII CHaracter Chart"
LOCATE 1, _WIDTH \ 2 - LEN(msg$) \ 2
PRINT msg$;
c = 1
_CONTROLCHR OFF
FOR i = 0 TO 255 ' There are 256 ASCII characters.
i$ = LTRIM$(STR$(i))
FOR j = 1 TO 2
IF LEN(i$) < 3 THEN i$ = "0" + i$
NEXT
IF i AND i MOD (_HEIGHT - 4) = 0 THEN c = c + 8: LOCATE 3, c
LOCATE i MOD (_HEIGHT - 4) + 3, c + 1: PRINT i$; " "; CHR$(i);
NEXT
SLEEP
_CONTROLCHR ON
_DELAY .5
FOR i = 1 TO _HEIGHT
PRINT CHR$(13);
_DELAY .2
NEXT
So now we have some nice symbols we can print to the screen for our text programs, which without this KEYWORD, would be used for the following...
Code: (Select All) CTRL + A = CHR$(1) ? StartHeader (SOH) CTRL + B = CHR$(2) ? StartText (STX)
CTRL + C = CHR$(3) ? EndText (ETX) CTRL + D = CHR$(4) ? EndOfTransmit (EOT)
CTRL + E = CHR$(5) ? Enquiry (ENQ) CTRL + F = CHR$(6) ? Acknowledge (ACK)
CTRL + G = CHR$(7) • Bell (BEL) CTRL + H = CHR$(8) ? [Backspace] (BSP)
CTRL + I = CHR$(9) ? Horiz.Tab [Tab] CTRL + J = CHR$(10) ? LineFeed(printer) (LF)
CTRL + K = CHR$(11) ? Vert. Tab (VT) CTRL + L = CHR$(12) ? FormFeed(printer) (FF)
CTRL + M = CHR$(13) ? [Enter] (CR) CTRL + N = CHR$(14) ? ShiftOut (SO)
CTRL + O = CHR$(15) ¤ ShiftIn (SI) CTRL + P = CHR$(16) ? DataLinkEscape (DLE)
CTRL + Q = CHR$(17) ? DevControl1 (DC1) CTRL + R = CHR$(18) ? DeviceControl2 (DC2)
CTRL + S = CHR$(19) ? DevControl3 (DC3) CTRL + T = CHR$(20) ¶ DeviceControl4 (DC4)
CTRL + U = CHR$(21) § NegativeACK (NAK) CTRL + V = CHR$(22) ? Synchronous Idle (SYN)
CTRL + W = CHR$(23) ? EndTXBlock (ETB) CTRL + X = CHR$(24) ? Cancel (CAN)
CTRL + Y = CHR$(25) ? EndMedium (EM) CTRL + Z = CHR$(26) ? End Of File(SUB) (EOF)
Note that PRINT CHR$(7) used t sound a BEEP in QuickBasic and older QB64 versions, but not any longer. I wonder who the dev was who decided to get the BEEP out of QB64?
Pete
|
|
|
|
|
