| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
MBA Assignment Help in Du...
Forum: General Discussion
Last Post: hafsahomar
06-11-2025, 07:05 AM
» Replies: 0
» Views: 9
|
лучшие песни медляки слуш...
Forum: Petr
Last Post: WillieTop
06-08-2025, 02:21 AM
» Replies: 0
» Views: 23
|
пинк слушать онлайн беспл...
Forum: SMcNeill
Last Post: WillieTop
06-08-2025, 02:20 AM
» Replies: 0
» Views: 20
|
скачать музыку российскую...
Forum: madscijr
Last Post: WillieTop
06-08-2025, 02:18 AM
» Replies: 0
» Views: 22
|
нежная музыка mp3 скачать
Forum: Keybone
Last Post: WillieTop
06-08-2025, 02:17 AM
» Replies: 0
» Views: 21
|
лучшая песня слушать онла...
Forum: bplus
Last Post: WillieTop
06-08-2025, 02:16 AM
» Replies: 0
» Views: 23
|
пикник слушать онлайн луч...
Forum: Spriggsy
Last Post: WillieTop
06-08-2025, 02:15 AM
» Replies: 0
» Views: 21
|
какая сейчас популярная м...
Forum: RhoSigma
Last Post: WillieTop
06-08-2025, 02:14 AM
» Replies: 0
» Views: 17
|
хит лета 2019 музыка на т...
Forum: Christmas Code
Last Post: WillieTop
06-08-2025, 02:12 AM
» Replies: 0
» Views: 23
|
бесплатная музыка mp3 рег...
Forum: Works in Progress
Last Post: WillieTop
06-08-2025, 02:11 AM
» Replies: 0
» Views: 17
|
|
|
| Storing stuff |
|
Posted by: NasaCow - 12-14-2022, 10:42 AM - Forum: Help Me!
- Replies (12)
|
 |
Every time in the past, when I need to store something to file, I always used a user-defined type and wrote and read the contents to a file using INPUT and OUTPUT. Now starting to design the actual gradebook, I am a little stumped. Naturally, an array sounds useful for something like this. My initial thought is assigning every student a unique ID (UID), unknown to the user but used by me, so if the name changes or something of the sort, we still can line the grades with the proper name.
So, the thinking is UID, Grade or mark, and notes. I am not overly experienced using multi-dimensional arrays. Is there any issues resizing them using REDIM PRESERVE. Is there a better idea for keeping and using this information or storing it with INPUT/OUTPUT won't be overly taxing since I would have to overwrite the file every time I make an update? Using RANDOM sounds like I have to make all these decision on the front-end... I guess I am just looking for a nudge in the right direction since I am kinda inexperinced with this type of programming 
Thanks y'all
|
|
|
| DAY 033: COMMAND$ |
|
Posted by: Pete - 12-13-2022, 06:48 PM - Forum: Keyword of the Day!
- Replies (9)
|
 |
Ever wish we could travel the world on a transporter beam? Well, we can't, so for now, let's stay home and play with COMMAND$...
SYNTAX: cmd$ = COMMAND$[(count%)]
USE: Passing arguments to other apps and drag and drop applications.
And as a bonus, if you act now, we'll throw in _COMMANDCOUNT to evaluate that count% variable.
Okay, let's get our demo of the day going...
Works for Windows, untested for Linux or Mac...
Code: (Select All) WIDTH 120, 25
_SCREENMOVE 0, 0
PRINT
cmd$ = COMMAND$(0) ' Gets the complete path and name of your current running program.
j = _INSTRREV(cmd$, "\")
program$ = MID$(cmd$, j + 1) ' Parse to just the program name.
IF j THEN
DrivePath$ = MID$(cmd$, 1, LEN(cmd$) - LEN(program$))
j = 1
ELSE
DrivePath$ = COMMAND$(1)
j = 2
END IF
PRINT "Drive and path of program passing arguments... "; DrivePath$: PRINT
PRINT "Program name passing the arguments............ "; program$: PRINT
IF LEN(COMMAND$(1)) THEN
' Parse and add back spaces because command$ needs passing spaces enclosed in quotes to preserve them.
k = _COMMANDCOUNT ' The number of arguments passed.
FOR i = j TO k
cmd$ = COMMAND$(i) ' Parse out an argument.
msg$ = msg$ + cmd$ + " " ' Concatenate string and add space back into string.
NEXT
msg$ = MID$(msg$, 1, LEN(msg$) - 1) ' Cut off the trailing space we added.
COLOR 14: PRINT msg$: PRINT: COLOR 7
END IF
PRINT "[1] Pete is a genius!": PRINT
PRINT "[2] Steve is a genius!": PRINT
PRINT "[3] Pete and Steve are both idiots, and I wore out my [3] key!": PRINT
PRINT
DO
INPUT "1-3: ", ans%: PRINT
IF ans% = 0 THEN SYSTEM
IF ans% > 0 AND ans% < 4 THEN EXIT DO
LOOP
' RUN and pass our sentences as a command$() parameter.
' Note we need a space between each argument we are going to be passing.
format$ = " " + CHR$(34) + _CWD$ + CHR$(34) + "\ "
SELECT CASE ans%
CASE 1: RUN program$ + format$ + "Pete is a genius!"
CASE 2: RUN program$ + format$ + "Steve is a genius!"
CASE 3: RUN program$ + format$ + "Pete and Steve are both idiots, and I wore out my [3] key!"
END SELECT
So the example above is a self-contained program. You don't have to name it or save it, just run it. Well how in the hell is that possible, you ask? Well, let's get into that, pronto...
COMMAND$(0): This is a special parameter of COMMAND$() that retrieves the current drive, path, and name of the running app. Pretty cool, right?
Edit: Steve caught the fact COMMAND$(0) doesn't grab the drive and path of the passing app, it grabs where it is being started from along with the name, of course. (See posts below for more info.) So I adjusted the code above to also include a way to pass the drive and path with _CWD$. Our example only needs the name, but it's nice to know the drive and path, if needed, could be passed as well.
Now that our example program knows its name, it let's you pick a selection then runs itself. It passes the choice you made through COMMAND$() and parses it out in the first conditional block statement... IF LEN(COMMAND$(1)) THEN
The (1) of COMMAND$(1) is string we passed in the RUN statement. So COMMAND$(0) got us or drive, path, and program name, and COMMAND$(1) got us the string argument we passed in the RUN statement.
Note: A difference between QB64 and QuickBASIC is QB made the arguments uppercase. QB64 maintains the case of the passed string.
_COMMANDCOUNT then kicks in and tells us how many parameters. COMMAND$() separates our text message by spaces. In other words a space acts as a string delimiter. So if the message was: "Call me Betty" we would have three arguments: Call, me, Betty. By knowing we have 3, we can save a little coding parsing those arguments out as COMMAND$(1), COMMAND$(2), and COMMAND$(3) by using our FOR/NEXT loop routine.
So even though we posted just one elf-contained program, for ease of use, keep in mind we will primarily use COMMAND$() when RUNning or SHELLing to another application, which needs info passed to it from the previous or calling program.
Note: Other methods of accomplishing for RUN and/or SHELL would be CHAIN, but not used in SHELL statements, Piping, used in SHELL statements, _CLIPBOARD$, usable in both, database sharing, used in both, TCP/IP, usable in both, and SCREEN writing and reading, used in both.
Oh, and here is a fun little shortcut example you can make to view files from Explorer in Notepad...
Instructions: name it anything you want. Make exe only. Find exe and make Desktop shortcut.
Code: (Select All) cmd$ = COMMAND$(0) ' Gets the complete path and name of your current running program.
IF LEN(COMMAND$(1)) THEN
' Parse and add back spaces because command$ needs passing spaces enclosed in quotes to preserve them.
j = _COMMANDCOUNT ' The number of arguments passed.
FOR i = 1 TO j
cmd$ = COMMAND$(i) ' Parse out an argument.
msg$ = msg$ + cmd$ + " " ' Concatenate string and add space back into string.
NEXT
msg$ = MID$(msg$, 1, LEN(msg$) - 1) ' Cut off the trailing space we added.
COLOR 14: PRINT msg$: PRINT: COLOR 7
PRINT: PRINT "SHELL notepad " + cmd$
SHELL _HIDE _DONTWAIT "notepad " + cmd$
END IF
So what now? Open Explorer and find a text file. Drag it into the desktop icon you just created. It will open that dragged file in Notepad.
...And if you want to make it stealth, code it as...
Code: (Select All) ' Make a desktop shortcut to this and drag files into it.
_SCREENHIDE
cmd$ = COMMAND$(0) ' Gets the complete path and name of your current running program.
REM PRINT cmd$: PRINT
IF LEN(COMMAND$(1)) THEN
' Parse and add back spaces because command$ needs passing spaces enclosed in quotes to preserve them.
j = _COMMANDCOUNT ' The number of arguments passed.
FOR i = 1 TO j
cmd$ = COMMAND$(i) ' Parse out an argument.
msg$ = msg$ + cmd$ + " " ' Concatenate string and add space back into string.
NEXT
msg$ = MID$(msg$, 1, LEN(msg$) - 1) ' Cut off the trailing space we added.
REM COLOR 14: PRINT msg$: PRINT: COLOR 7
REM PRINT: PRINT "SHELL notepad " + cmd$
SHELL _HIDE _DONTWAIT "start notepad " + cmd$
END IF
SYSTEM
Now imagine what other drag and drop apps you could use this for. Paint.net is one I use this on. I use SENDKEYS WIn32 API routines in my COMMAND$() desktop app to control PAINT.net after it opens and loads the image I dragged into the file. That saves me several steps. I can even resize photos without touching the keyboard once!
If you guys have other uses or programs of a similar nature to share, please feel free to either add them here as examples, or add the link to the forum page.
Thanks, an now back to work on my transporter beam. I think I just sent my CapsLock toe to the South of France.
Pete
|
|
|
|
| NOT OOO |
|
Posted by: SMcNeill - 12-13-2022, 03:10 PM - Forum: General Discussion
- Replies (1)
|
 |
From the thread here, I had a couple of people message me about NOT and why I mentioned it was an oddball in the Order Of Operations (OOO). Let me see if I can explain this simply, without confounding the issue..
Exponents are one of the first things we solve in our OOO. Right?
And NOT is down near the end of our OOO. Right?
So following those rules, write a program to parse and solve: 1 ^ NOT 2 ^ 3 AND 4
??? <-- Now how the heck DOES it calculate that???
The odd secret is NOT is both calculated FIRST, and near the LAST of our OOO.
Here's the trick I learned: Put a beginning parentheses BEFORE your NOT, and the ending parentheses before any binary operators like AND, OR, EQV...
1 ^ NOT 2 ^ 3 AND 4 gets solved as: 1 ^ (NOT 2 ^ 3) AND 4
1 ^ (NOT 2 ^ 3) AND 4 makes sense to us. Do the parentheses FIRST, even if NOT might be evaluated down low on the OOO.
You can't just say, "Solve it last," as sometimes, such as in this case, you have to solve it first before you can do the other operations. 1 raised to the WHAT power? The (NOT 2 ^ 3)rd power!
Put a beginning parentheses BEFORE your NOT, and the ending parentheses before any binary operators like AND, OR, EQV. <-- That's the rule for parsing and solving NOT properly.
|
|
|
|
| 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%!!!
|
|
|
|
| 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 (2)
|
|
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
Dim Shared QuickReturn As Integer
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
b = InStr(UCase$(e$), "EQL") 'take out assignment before the preparser sees it
If b Then t$ = Mid$(e$, b + 3): var$ = UCase$(LTrim$(RTrim$(Mid$(e$, 1, b - 1))))
QuickReturn = 0
PreParse t$
If QuickReturn Then Evaluate_Expression$ = t$: Exit Function
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 Print "ERROR -- BAD () Count": End
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) = "-"
temppp$ = DWD(Left$(exp$, s - 2) + " ## " + eval$ + " ## " + Mid$(exp$, E + 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
'We should now have an expression with no () to deal with
If Mid$(exp$, 2, 1) = "-" Then exp$ = "0+" + Mid$(exp$, 2)
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 op = InStr(2, exp$, OName(P)) Else op = InStr(exp$, OName(P))
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 op = InStr(2, exp$, OName(OpOn)) Else op = InStr(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 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) = "-"
num(3) = EvaluateNumbers(OpOn, num())
If Mid$(num(3), 1, 1) = "-" Then Mid$(num(3), 1) = "N"
'PRINT "*************"
'PRINT num(1), OName(OpOn), num(2), num(3), exp$
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))))
'PRINT exp$
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!
'Constants get evaluated first, with a Priority Level of 1
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_PI"
ReDim _Preserve PL(i): PL(i) = 1
'I'm not certain where exactly percentages should go. They kind of seem like a special case to me. COS10% should be COS.1 I'd think...
'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
i = i + 1: ReDim _Preserve OName(i): OName(i) = "%"
ReDim _Preserve PL(i): PL(i) = 5
'Then Functions with PL 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ACOS"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ASIN"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ARCSEC"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ARCCSC"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ARCCOT"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_SECH"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_CSCH"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_COTH"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "COS"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "SIN"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "TAN"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "LOG"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "EXP"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "ATN"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_D2R"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_D2G"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_R2D"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_R2G"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_G2D"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_G2R"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "ABS"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "SGN"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "INT"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ROUND"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "FIX"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_SEC"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_CSC"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_COT"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "ASC"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "CHR$"
ReDim _Preserve PL(i): PL(i) = 10
'Exponents with PL 20
i = i + 1: ReDim _Preserve OName(i): OName(i) = "^"
ReDim _Preserve PL(i): PL(i) = 20
i = i + 1: ReDim _Preserve OName(i): OName(i) = "SQR"
ReDim _Preserve PL(i): PL(i) = 20
i = i + 1: ReDim _Preserve OName(i): OName(i) = "ROOT"
ReDim _Preserve PL(i): PL(i) = 20
'Multiplication and Division PL 30
i = i + 1: ReDim _Preserve OName(i): OName(i) = "*"
ReDim _Preserve PL(i): PL(i) = 30
i = i + 1: ReDim _Preserve OName(i): OName(i) = "/"
ReDim _Preserve PL(i): PL(i) = 30
'Integer Division PL 40
i = i + 1: ReDim _Preserve OName(i): OName(i) = "\"
ReDim _Preserve PL(i): PL(i) = 40
'MOD PL 50
i = i + 1: ReDim _Preserve OName(i): OName(i) = "MOD"
ReDim _Preserve PL(i): PL(i) = 50
'Addition and Subtraction PL 60
i = i + 1: ReDim _Preserve OName(i): OName(i) = "+"
ReDim _Preserve PL(i): PL(i) = 60
i = i + 1: ReDim _Preserve OName(i): OName(i) = "-"
ReDim _Preserve PL(i): PL(i) = 60
'Relational Operators =, >, <, <>, <=, >= PL 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "<>"
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "><" 'These next three are just reversed symbols as an attempt to help process a common typo
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "<="
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = ">="
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "=<" 'I personally can never keep these things straight. Is it < = or = <...
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "=>" 'Who knows, check both!
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = ">"
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "<"
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "="
ReDim _Preserve PL(i): PL(i) = 70
'Logical Operations PL 80+
i = i + 1: ReDim _Preserve OName(i): OName(i) = "NOT"
ReDim _Preserve PL(i): PL(i) = 80
i = i + 1: ReDim _Preserve OName(i): OName(i) = "AND"
ReDim _Preserve PL(i): PL(i) = 90
i = i + 1: ReDim _Preserve OName(i): OName(i) = "OR"
ReDim _Preserve PL(i): PL(i) = 100
i = i + 1: ReDim _Preserve OName(i): OName(i) = "XOR"
ReDim _Preserve PL(i): PL(i) = 110
i = i + 1: ReDim _Preserve OName(i): OName(i) = "EQV"
ReDim _Preserve PL(i): PL(i) = 120
i = i + 1: ReDim _Preserve OName(i): OName(i) = "IMP"
ReDim _Preserve PL(i): PL(i) = 130
End Sub
Function EvaluateNumbers$ (p, num() As String)
Dim n1 As _Float, n2 As _Float, n3 As _Float
Select Case OName(p) 'Depending on our operator..
Case "_PI": n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
Case "%": n1 = (Val(num(1))) / 100 'Note percent is a special case and works with the number BEFORE the % command and not after
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 "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 "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)))
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 "/": n1 = Val(num(1)) / Val(num(2))
Case "\"
If Val(num(2)) <> 0 Then
n1 = Val(num(1)) \ Val(num(2))
Else
EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
Exit Function
End If
Case "MOD": n1 = Val(num(1)) Mod 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))
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 "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))
Case Else
EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)" 'Let's say we're bad...
End Select
EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1)))
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$
VerifyString t$
End Function
Sub PreParse (e$)
Dim f As _Float
t$ = e$
'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
'Check for bad operators before a ( bracket
l = 0
Do
l = InStr(l + 1, t$, "(")
If l And l > 2 Then 'Don't check the starting bracket; there's nothing before it.
good = 0
For i = 1 To UBound(OName)
If Mid$(t$, l - Len(OName(i)), 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 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 And l < Len(t$) Then
good = 0
For i = 1 To UBound(OName)
If Mid$(t$, l + 1, 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 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
'Turn all &H (hex) numbers into decimal values for the program to process properly
l = 0
Do
l = InStr(t$, "&H")
If l Then
E = l + 1: finished = 0
Do
E = E + 1
comp$ = Mid$(t$, E, 1)
Select Case comp$
Case "0" To "9", "A" To "F" '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 &H value. (" + comp$ + ")": Exit Sub
E = E - 1
finished = -1
End Select
Loop Until finished Or E = Len(t$)
t$ = Left$(t$, l - 1) + LTrim$(RTrim$(Str$(Val(Mid$(t$, l, E - l + 1))))) + Mid$(t$, E + 1)
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
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
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)
Next
If Not good Then t$ = "ERROR - Bad Operational value. (" + comp$ + ")": Exit Sub
j = j + Len(OName(i))
End Select
Loop Until j > Len(t$)
End Sub
Function N2S$ (exp$) 'scientific Notation to String
t$ = LTrim$(RTrim$(exp$))
If Left$(t$, 1) = "-" 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)
|
|
|
|
Silent pw entry not working |
|
Posted by: Ra7eN - 12-11-2022, 02:06 PM - Forum: Help Me!
- Replies (46)
|
 |
The following code does the following
prints "*" when entering a password (scratch built) and then return the plaintext back.
Instead it returns a zero and blank text. What did I miss? thanks.
Code: (Select All) Print "-Enter Password: "; pInput$ = silentInput$
Print pInput$ 'DEBUG DELETE AFTER TESTING
Code: (Select All) Function silentInput$
Dim Txt$
Dim KeyPress$
Txt$ = ""
' GREAT FOR PASSWORDS
Do
Do: KeyPress$ = InKey$: Loop Until KeyPress$ > ""
If KeyPress$ <> Chr$(13) Then
Txt$ = Txt$ + KeyPress$
Print "*"; ' crate a visual
End If
Loop Until KeyPress$ = Chr$(13)
Print
silentInput$ = Txt$
End Function
PS, appreciate you guys keeping the qb64 going!! thank you
|
|
|
|
|
![[Image: P1030491a.jpg]](https://i.ibb.co/r4Gd0Bx/P1030491a.jpg)
