| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 762
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,032
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,588
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155
|
|
|
| Multi-Input Popup Box |
|
Posted by: SMcNeill - 04-23-2022, 05:12 PM - Forum: SMcNeill
- No Replies
|
 |
(I'd posted this elsewhere, but thought I'd share it here so folks who might not be reading the other topic could locate this and maybe someday reference it, or make use of it, for their own stuff.)
Here's a little something which I tossed together in about 20 minutes this afternoon, which you might be able to use:
Code: (Select All) Screen _NewImage(1280, 720, 32)
Dim As String prompt(3), results(3)
prompt(0) = "Name": prompt(1) = "Age": prompt(2) = "Sex": prompt(3) = "Phone Number"
For i = 1 To 100 'Draw some stuff on the screen for a background
Line (Rnd * 1280, Rnd * 720)-(Rnd * 1280, Rnd * 720), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
Print "SLEEPING SO YOU CAN SEE OUR BACKGROUND"
Sleep
MultiInput 100, 100, prompt(), results(), 20
Print: Print "As you can see, when finished, our pop up restored our background..."
Print "And your answers were the following:"
For i = 0 To UBound(results): Print results(i): Next
Sub MultiInput (xPos, yPos, prompt() As String, results() As String, maxLength As Integer)
backupImage = _CopyImage(0) 'copy our screen
B = _Blend: _DontBlend: A = _AutoDisplay: u = UBound(prompt)
For i = 0 To u 'get box size
p = _PrintWidth(prompt(i)): If p > maxWidth Then maxWidth = p
Next
boxWidth = maxWidth + maxLength * _FontWidth + 10: boxheight = (u + 1) * (_FontHeight + 3)
Do
If Timer > t# + .5 Then blink = Not blink: t# = Timer
k = _KeyHit 'get input
Select Case k
Case 18432: selection = selection - 1: If selection < 0 Then selection = u 'up
Case 20480, 13: selection = selection + 1: If selection > u Then selection = 0 'down
Case 27: Exit Do 'esc is the exit/finish code
Case 8: results(selection) = Left$(results(selection), Len(results(selection)) - 1) 'backspace
Case 32 TO 255: results(selection) = results(selection) + Chr$(k) 'all else
End Select
_PutImage , backupImage 'restore background
Line (xPos, yPos)-Step(boxWidth, boxheight), 0, BF: Line (x + xPos + maxWidth + 1, y + yPos)-Step(0, boxheight), -1 'draw box
For i = 0 To u
Line (x + xPos, y + i * (_FontHeight + 3) + yPos)-Step(boxWidth, _FontHeight + 3), -1, B
_PrintString (x + xPos + 2, y + i * (_FontHeight + 3) + yPos + 2), prompt(i)
If i = selection And blink Then out$ = results(i) + Chr$(219) Else out$ = results(i)
_PrintString (x + xPos + maxWidth + 3, y + i * (_FontHeight + 3) + yPos + 2), out$
Next
_Limit 30: _Display
Loop
_PutImage , backupImage
If B Then _Blend
If A Then _AutoDisplay
_FreeImage backupImage
End Sub
45 lines total, and only 33 lines for our SUB, which does all the real work for us.
And what's this do, you ask?
It creates a simple, stand-alone, multi-line, POP-UP input box which we can use the arrow keys to move up and down between.
Usage is rather simple:
1) Dim 2 arrays to hold your prompts and the results.
2) Set your prompts.
3) Call the function, get the results.
Can't be much simpler than that!
|
|
|
| Screenmove absolute coordinates |
|
Posted by: SMcNeill - 04-23-2022, 05:09 PM - Forum: SMcNeill
- No Replies
|
|
I think the demo here speaks for itself:
Code: (Select All) $COLOR:32
_DEFINE A-Z AS LONG
SCREEN _NEWIMAGE(1020, 780, 32)
ScreenMove_Middle
PRINT "Your desktop dimensions: "; _DESKTOPWIDTH, _DESKTOPHEIGHT
PRINT "Your program dimensions: "; _WIDTH, _HEIGHT
PRINT "Your program borders : "; glutGet(506)
PRINT "Your program titlebar : "; glutGet(507)
PRINT
PRINT "To properly center your program, it should be at:"
PRINT (_DESKTOPWIDTH - _WIDTH) / 2,
PRINT (_DESKTOPHEIGHT - _HEIGHT) / 2
PRINT
PRINT "Using Screenmove_Middle, it is currently at:"
PRINT glutGet(100), glutGet(101)
PRINT
SLEEP
PRINT "Using _SCREENMOVE _MIDDLE, the screen is placed at:"
_SCREENMOVE _MIDDLE
PRINT glutGet(100), glutGet(101)
PRINT
PRINT "Which, as you can see, doesn't account for our borders or titlebar width and height."
SLEEP
CLS
PRINT "Maybe a better example would be to move the screen to 0,0."
_SCREENMOVE 0, 0
PRINT "Notice how the titlebar and borders are still here?"
PRINT "Our program is actually at: "; glutGet(100), glutGet(101)
SLEEP
ScreenMove 0, 0
PRINT "And notice how our program window now starts at 0,0, like we told it to?"
PRINT "And, as you can see, we're now actually at :"; glutGet(100), glutGet(101)
SLEEP
CLS
PRINT "And, best of all, since all these values are calculated manually, you don't need to worry about using a _DELAY with them, at the beginning of your code, as we're manually setting our X/Y position and not trying to do it automatically."
SUB ScreenMove_Middle
$IF BORDERDEC = UNDEFINED THEN
$LET BORDERDEC = TRUE
DECLARE LIBRARY
FUNCTION glutGet& (BYVAL what&)
END DECLARE
$END IF
BorderWidth = glutGet(506)
TitleBarHeight = glutGet(507)
_SCREENMOVE (_DESKTOPWIDTH - _WIDTH - BorderWidth) / 2 + 1, (_DESKTOPHEIGHT - _HEIGHT - BorderWidth) / 2 - TitleBarHeight + 1
END SUB
SUB ScreenMove (x, y)
$IF BORDERDEC = UNDEFINED THEN
$LET BORDERDEC = TRUE
DECLARE LIBRARY
FUNCTION glutGet& (BYVAL what&)
END DECLARE
$END IF
BorderWidth = glutGet(506)
TitleBarHeight = glutGet(507)
_SCREENMOVE x - BorderWidth, y - BorderWidth - TitleBarHeight
END SUB
Note: I found these subtle positioning differences to be vital for me, in another little batch program which tries to interact with my screen in various ways. Clicks were often not registering as my screen simply wasn't where I expected it to be. A box from (0,0)-(100,100), wasn't really at those coordinates, as it was instead at (borderwidth, borderwidth + titlebarheight)-STEP(100,100)...
Which was more than enough to throw all my work off and cause all sorts of unintentional glitches. 
|
|
|
|
| Self-Referencing Customtype Libraries |
|
Posted by: SMcNeill - 04-23-2022, 05:06 PM - Forum: SMcNeill
- No Replies
|
|
Just something rather neat that I thought I'd share, even if I haven't honestly sorted out an use for it (yet)...
Code: (Select All) DECLARE CUSTOMTYPE LIBRARY 'Use Customtype for self-referencing a sub written inside your program
SUB SUB_EXAMPLE (BYVAL passed AS _OFFSET) 'this points to SUB EXAMPLE below, but uses an OFFSET to point to its parameter.
'NOTE: The sub/function name *MUST* be the same as QB64 translates it as, for us.
'General rule of thumb is to make the subname ALL CAPS, preceeded by SUB_ or FUNCTION_ as dictated.
SUB SUB_EXAMPLE2 (BYVAL passed AS _OFFSET)
END DECLARE
TYPE DataType 'A datatype to use as an example
x AS STRING * 12
y AS LONG
z AS LONG
END TYPE
TYPE DataType2 'a second datatype
byte1 AS _UNSIGNED _BYTE
byte2 AS _UNSIGNED _BYTE
byte3 AS _UNSIGNED _BYTE
byte4 AS _UNSIGNED _BYTE
byte5 AS _UNSIGNED _BYTE
byte6 AS _UNSIGNED _BYTE
byte7 AS _UNSIGNED _BYTE
byte8 AS _UNSIGNED _BYTE
byte9 AS _UNSIGNED _BYTE
byte10 AS _UNSIGNED _BYTE
byte11 AS _UNSIGNED _BYTE
byte12 AS _UNSIGNED _BYTE
byte13 AS _UNSIGNED _BYTE
byte14 AS _UNSIGNED _BYTE
byte15 AS _UNSIGNED _BYTE
byte16 AS _UNSIGNED _BYTE
byte17 AS _UNSIGNED _BYTE
byte18 AS _UNSIGNED _BYTE
byte19 AS _UNSIGNED _BYTE
byte20 AS _UNSIGNED _BYTE
END TYPE
DIM m AS _MEM 'A memblock to store some information
m = _MEMNEW(20) 'The proper size to fill the data type that we're interested in passing back to our program.
_MEMPUT m, m.OFFSET, "Hello World" '12 bytes
_MEMPUT m, m.OFFSET + 12, -2 AS LONG '4 more
_MEMPUT m, m.OFFSET + 16, 3 AS LONG '4 more to make all 20
SUB_EXAMPLE m.OFFSET 'Call the sub with the offset to these 20 bytes of memory
SLEEP
SUB_EXAMPLE2 m.OFFSET 'Notice, we passed the same block of memory, but are handling it differently here,
' according to the paramters set in the second sub
_MEMFREE m
END
SUB Example (t AS DataType) 'And here, we want to set up the actual sub to work with our example datatype.
PRINT t.x 'print the values of that memblock
PRINT t.y
PRINT t.z
END SUB
SUB Example2 (x AS DataType2)
COLOR 12
PRINT x.byte1
PRINT x.byte2
PRINT x.byte3
PRINT x.byte4
PRINT x.byte5
PRINT x.byte6
PRINT x.byte7
PRINT x.byte8
PRINT x.byte9
PRINT x.byte10
PRINT x.byte11
PRINT x.byte12
PRINT x.byte13
PRINT x.byte14
PRINT x.byte15
PRINT x.byte16
PRINT x.byte17
PRINT x.byte18
PRINT x.byte19
PRINT x.byte20
END SUB
|
|
|
|
| Mouse Button Status (MBS) |
|
Posted by: SMcNeill - 04-23-2022, 05:05 PM - Forum: SMcNeill
- Replies (3)
|
|
Code: (Select All) _Title "MBS (Mouse Button Status) by Steve" ' 12-17-2020 // updated 4/23/2022
Do
Cls
held$ = ""
result = MBS
left = left - (result And 8) \ 8
right = right - (result And 16) \ 16
middle = middle - (result And 32) \ 32
If result And 64 Then held$ = "Left held"
If result And 128 Then held$ = "Right held"
If result And 256 Then held$ = "Middle held"
If result And 512 Then scroll = scroll + 1
If result And 1024 Then scroll = scroll - 1
Print "MouseX: "; _MouseX
Print "MouseY: "; _MouseY
Print "Left down : "; result And 1
Print "Right down : "; result And 2
Print "Middle down : "; result And 4
Print "Left pressed : "; left
Print "Right pressed : "; right
Print "Middle pressed: "; middle
Print "Mouse Wheel Scrolled: "; scroll
Print
Print "Last held event started at X/Y :"; Mouse_StartX, Mouse_StartY
Print "Last held event ended at X/Y :"; Mouse_EndX, Mouse_EndY
Print held$
_Limit 60
Loop
Function MBS% 'Mouse Button Status
Static StartTimer As _Float
Static ButtonDown As Integer
Static ClickCount As Integer
Const ClickLimit## = 0.2 'Less than 1/4th of a second to down, up a key to count as a CLICK.
' Down longer counts as a HOLD event.
Shared Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
While _MouseInput 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
Select Case Sgn(_MouseWheel)
Case 1: tempMBS = tempMBS Or 512
Case -1: tempMBS = tempMBS Or 1024
End Select
Wend
If _MouseButton(1) Then tempMBS = tempMBS Or 1
If _MouseButton(2) Then tempMBS = tempMBS Or 2
If _MouseButton(3) Then tempMBS = tempMBS Or 4
If StartTimer = 0 Then
If _MouseButton(1) Then 'If a button is pressed, start the timer to see what it does (click or hold)
ButtonDown = 1: StartTimer = Timer(0.01)
Mouse_StartX = _MouseX: Mouse_StartY = _MouseY
ElseIf _MouseButton(2) Then
ButtonDown = 2: StartTimer = Timer(0.01)
Mouse_StartX = _MouseX: Mouse_StartY = _MouseY
ElseIf _MouseButton(3) Then
ButtonDown = 3: StartTimer = Timer(0.01)
Mouse_StartX = _MouseX: Mouse_StartY = _MouseY
End If
Else
BD = ButtonDown Mod 3
If BD = 0 Then BD = 3
If Timer(0.01) - StartTimer <= ClickLimit Then 'Button was down, then up, within time limit. It's a click
If _MouseButton(BD) = 0 Then tempMBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
Else
If _MouseButton(BD) = 0 Then 'hold event has now ended
tempMBS = 0: ButtonDown = 0: StartTimer = 0
Mouse_EndX = _MouseX: Mouse_EndY = _MouseY
Else 'We've now started the hold event
tempMBS = tempMBS Or 32 * 2 ^ ButtonDown
End If
End If
End If
MBS = tempMBS
End Function
I had one of these somewhere before, but I'll be danged if I can find it, so I rolled another one...
A simple routine to check the mouse buttons and to give us information on up/down, click, and hold statuses, as well as hold start/stop positions. Results are all stored in a single binary integer, and basically break down to:
1 -- left down
2 -- right down
4 -- middle down
8 -- left clicked
16 -- right clicked
32 -- middle clicked
64 -- left held
128 -- right held
256 -- middle held
512 -- scroll down
1024 -- scroll up
Starting X/Y and Ending X/Y positions are available in the shared Mouse_ variables.
Note, HOLD and CLICK events are independent of each other. We don't register a free click with each hold event. Windows tends to count first down events as clicks, so all hold events start with a click event and then transition into a hold event. I didn't need that for my purposes, so this will either give you a hold event OR a click event; not both.
|
|
|
|
| Tutorial - Turn a QB64 interpreter into a compiler |
|
Posted by: Dav - 04-23-2022, 03:55 PM - Forum: Dav
- Replies (3)
|
 |
Tutorial: How to turn a QB64 interpreter into a compiler.
(WINDOWS ONLY!)
Several of our members have made excellent interpreters in QB64 that run BAS code. I ported one of mine to QB64, and wanted to take it further and make it an compiler that turn BAS code in standalone EXE's. Here's a tutorial on how I did it. With this method you can make your own EXE producing compiler in QB64.
It's easier to explain the method by just going through the steps of making one, so in this tutorial we will turn a small interpreter into a EXE producing compiler. Please note - this is not a 'true' compiler, but more like a 'bytecode' one. The EXE's produced are merely a special interpreter with source coded binded to it - Like RapidQ and other basic compilers out there do. The EXE's will read itself and run the attached code. I've attached all the needed source files to this post at the bottom for easier saving. So...Download all the attached BAS files before we begin.
STEP #1) Compile the MarkExeSize.bas tool to an EXE first. The interpreter and compiler EXE's we make here will need to be marked by that tool. You can read what MarkExeSize does in its source code.
(MarkExeBas.bas)
Code: (Select All) '===============
'MarkExeSize.bas
'===============
'Marks QB64 compiled EXE's with its EXE data size.
'Coded by Dav, JAN/2021
'WINDOWS ONLY!
'This helps facilitate using appended data on the EXE.
'It saves the compiled EXE size to the EXE file, so
'the program can read that info and jump to its data.
'It does this by borrowing some space near the top of
'the EXE file. It shortens 'This program cannot be run
'in DOS mode.' to 'This program can't run in DOS mode.' and
'uses those 4 gained spaces to save EXE file size instead.
'=======================================================
'Example...after you mark your EXE file, it can do this:
'=======
'OPEN COMMAND$(0) FOR BINARY AS 1 'Open itself up...
'test$ = INPUT$(200, 1) 'grab a little info
'place = INSTR(1, test$, "This program can't") 'look for words
'IF place = 0 THEN PRINT "No data found.": CLOSE: END
'grab exesize info...
'SEEK 1, place + 35: ExeSize& = CVL(INPUT$(4, 1))
'Go there....
'SEEK 1, ExeSize& + 1 'where appended data begins
'=======================================================
'NOTE: Always mark the EXE before appending data to it.
' If you use EXE compressors, like UPX, mark the EXE
' AFTER using UPX, not before, otherwise the info won't
' be read correctly by your program.
SCREEN Pete
PRINT
PRINT "================"
PRINT "MarkExeSize v1.0 - by Dav"
PRINT "================"
PRINT
IF COMMAND$ = "" THEN
INPUT "EXE to Mark -->", exe$
PRINT
ELSE
exe$ = COMMAND$
END IF
IF exe$ = "" THEN END
IF NOT _FILEEXISTS(exe$) THEN
PRINT "File not found.": END
END IF
OPEN exe$ FOR BINARY AS 1
'find location of place to mark
test$ = INPUT$(200, 1)
place = INSTR(1, test$, "This program can")
IF place = 0 THEN
PRINT "This file is not markable."
CLOSE: END
END IF
'jump to location
SEEK 1, place
look$ = INPUT$(19, 1) 'grab a little info
SELECT CASE look$
CASE IS = "This program cannot"
'mark/overwrite exe file info file with new info
PRINT "Marking file "; exe$
PRINT
PRINT "EXE files size:"; LOF(1)
PRINT "Data start loc:"; LOF(1) + 1
new$ = "This program can't run in DOS mode." + MKL$(LOF(1))
PUT 1, place, new$
PRINT: PRINT "Done."
CASE IS = "This program can't "
PRINT "EXE already appears to be marked."
PRINT
SEEK 1, place + 35: datastart& = CVL(INPUT$(4, 1))
PRINT "EXE files size:"; LOF(1)
PRINT "Data start loc:"; datastart& + 1
PRINT "Size of data :"; LOF(1) - datastart&
CASE ELSE
PRINT "EXE is not markable."
END SELECT
CLOSE
STEP #2) Compile the sample interpreter.bas to EXE. This is just an example interpreter. The main thing is that this interpreter is made to open itself up when run, and load source code attached to itself, instead of loading an external BAS file. Think of it as the runtime file. But don't attach any BAS code to it yet, just compile it for now. (When using your own interpreter you will need to adapt it to load code this way too).
(interpreter.bas)
Code: (Select All) 'Mini Interpreter runtime.
'A compiled EXE of this runs BAS code attached to it.
DIM Code$(100) 'space for 100 lines
'==========================================================
OPEN COMMAND$(0) FOR BINARY AS 1
place = INSTR(1, INPUT$(200, 1), "This program can't")
IF place = 0 THEN
CLOSE: END
ELSE
SEEK 1, place + 35: ExeSize& = CVL(INPUT$(4, 1))
END IF
'==========================================================
'Make sure something is attached to exe...
IF ExeSize& + 1 > LOF(1) THEN END
SEEK 1, ExeSize& + 1
Lines = 1
WHILE NOT EOF(1)
LINE INPUT #1, c$
Code$(Lines) = c$
Lines = Lines + 1
WEND
CLOSE 1
FOR t = 1 TO Lines
ExecuteLine Code$(t)
NEXT
SUB ExecuteLine (cmd$)
cmd$ = LTRIM$(RTRIM$(cmd$))
IF LEFT$(cmd$, 1) = "'" THEN EXIT SUB
IF UCASE$(LEFT$(cmd$, 3)) = "REM" THEN EXIT SUB
IF UCASE$(LEFT$(cmd$, 5)) = "SLEEP" THEN SLEEP
IF UCASE$(cmd$) = "BEEP" THEN BEEP
IF UCASE$(LEFT$(cmd$, 6)) = "COLOR " THEN
COLOR VAL(RIGHT$(cmd$, LEN(cmd$) - 6))
END IF
IF UCASE$(cmd$) = "PRINT" THEN PRINT
IF UCASE$(LEFT$(cmd$, 7)) = "PRINT " + CHR$(34) THEN
PRINT MID$(cmd$, 8, LEN(cmd$) - 8)
END IF
IF UCASE$(LEFT$(cmd$, 3)) = "CLS" THEN CLS
IF UCASE$(LEFT$(cmd$, 3)) = "END" THEN END
END SUB
STEP #3) Compile the compiler.bas to EXE. This little programs whole job is to combine the interpreter+source code together. But - It will have the interpreter runtime attached to it eventually, like the interpreter has code attached to it. We will attach that later. For now just compile it...
(compiler.bas)
Code: (Select All) 'Mini Compiler example
PRINT
PRINT "A Mini .BAS Compiler"
PRINT "Compile .BAS to .EXE"
PRINT
INPUT "BAS to open ->", in$: IF in$ = "" THEN END
INPUT "EXE to make ->", out$: IF out$ = "" THEN END
'First see if this EXE is marked...
OPEN COMMAND$(0) FOR BINARY AS 1
place = INSTR(1, INPUT$(200, 1), "This program can't")
IF place = 0 THEN CLOSE: END
'Grab EXE size info
SEEK 1, place + 35: ExeSize& = CVL(INPUT$(4, 1))
'Make sure data attached...
IF ExeSize& + 1 > LOF(1) THEN END
'Jump to data
SEEK 1, ExeSize& + 1
'Extract data, make EXE file...
OPEN out$ FOR OUTPUT AS 2
outdata$ = INPUT$(LOF(1) - ExeSize&, 1)
PRINT #2, outdata$;: outdata$ = ""
'Add/attach BAS code to EXE
OPEN in$ FOR BINARY AS 3
outdata$ = INPUT$(LOF(3), 3)
PRINT #2, outdata$;
CLOSE
PRINT "Made "; out$
END
OPTIONAL STEP: At this point you could run UPX on those EXE's to reduce their size down to about 500k. You will have to download UPX from off the internet. I use it a lot. Works well on QB64 generated EXE's. Make sure if you do this step, that you do it right here - BEFORE using MarkExeSize on them.
STEP #4) Now use the MarkExeSize.exe tool on both the interpreter.exe and compiler.exe programs. It saves their EXE size in the EXE's. IMPORTANT: This is a needed step. Without it, the EXE's won't know how to open a file attached to them.
STEP #5) Now it's time to make the mini.exe compiler program. Drop to a command prompt, into the folder where the new EXE's are, and combine both the compiler.exe+interpreter.exe files like this, making a new file called mini.exe:
copy /b compiler.exe+interpreter.exe mini.exe
If all went well, You just made a new EXE file called mini.exe. It's the whole compiler that contains the interpreter runtime too. Run mini.exe, and you can now compile the demo.bas below. It will generate a demo.exe out of it. The interpreter.exe & compiler.exe are no longer needed - mini.exe is the only thing needed to make the EXE files from BAS code.
(demo.bas)
Code: (Select All) REM Sample program
COLOR 3
PRINT "Hit any key to clear..."
SLEEP
BEEP
CLS
COLOR 15
PRINT "Cleared!"
END
Final comments: The example here is just a simple interpreter, just to show you how to do yours. Be aware that unless you encode/decode your source code on the interpreter, people will be able to open up your EXE and see the source code, so I would put in an encoding/decoding method in your interpreter.
Try building this sample first, and you will see how easy it is to turn your interpreter into a byte-code compiler using QB64. Start your own programming language!
Have fun!
- Dav
markexesize.bas (Size: 2.64 KB / Downloads: 59)
interpreter.bas (Size: 1.3 KB / Downloads: 59)
compiler.bas (Size: 829 bytes / Downloads: 59)
demo.bas (Size: 113 bytes / Downloads: 56)
|
|
|
|
| TextToImage and DisplayImage |
|
Posted by: SMcNeill - 04-23-2022, 02:02 PM - Forum: SMcNeill
- Replies (6)
|
|
Code: (Select All) SCREEN _NEWIMAGE(800, 700, 32)
_SCREENMOVE 250, 0
FOR i = 1 TO 4
HW(i) = TextToImage("Hello World", 16, &HFFFFFF00, 0, i)
NEXT
CLS
PRINT "The first thing to showcase with these two routines is just how simple it is to turn"
PRINT "text into an image with TextToImage."
SLEEP
PRINT
PRINT "First, let's print it forwards:"
_PUTIMAGE (250, 48), HW(1)
SLEEP
PRINT
PRINT "Then, let's print it backwards:"
_PUTIMAGE (250, 80), HW(2)
SLEEP
PRINT
PRINT "Then, let's print it up to down:"
_PUTIMAGE (270, 112), HW(3)
SLEEP
LOCATE 8, 40: PRINT "And let's finish with down to up:"
_PUTIMAGE (580, 112), HW(4)
SLEEP
LOCATE 20, 1
PRINT
PRINT
PRINT "TextToImage simply transforms text into an image for us, with a few built in options"
PRINT "to it for the direction we want we text to print."
PRINT "It's as simple as a call with:"
PRINT " Handle = TextToImage(text$, fonthandle, fontcolor, backgroundcolor, mode"
PRINT
PRINT " text$ is the string which we want to print. (In this case 'Hello World'"
PRINT " fonthandle is the handle of the font which we _LOADFONT for use."
PRINT " (In this case, I choose the default _FONT 16.)"
PRINT " fontcolor is the color which we want our text in. (Here, it's YELLOW.)"
PRINT " backgroundcolor is the background which we want for the text time. (Clear this time.)"
PRINT " mode is how we decide to print forwards, backwards, up to down, or down to up."
PRINT
PRINT "Once we have an image handle, we can use that image just the same as we can with any other."
PRINT "For those who don't need to do anything more than display the text as an image,"
PRINT "feel free to use it as I have in the first part of this program with _PUTIMAGE."
PRINT
PRINT "Trust me -- TextToImage works just fine with _PUTIMAGE."
PRINT
PRINT "But.... If you need more..."
SLEEP
CLS , 0
PRINT "There's always DisplayImage to help you out!"
DisplayImage HW(1), 300, 30, 1, 1, 0, 1
PRINT
PRINT "Display your image at a scale!"
SLEEP
PRINT
PRINT "Twice as wide! ";
DisplayImage HW(1), 300, 60, 2, 1, 0, 1
SLEEP
PRINT "Twice as tall! "
DisplayImage HW(1), 500, 60, 1, 2, 0, 1
SLEEP
PRINT
PRINT "At an angle!"
DisplayImage HW(1), 280, 90, 1, 1, -45, 1
SLEEP
PRINT: PRINT: PRINT: PRINT: PRINT
PRINT "Make it rotate!"
_DELAY .2
_KEYCLEAR
DO
LINE (355, 155)-STEP(100, 100), &HFF000000, BF
DisplayImage HW(1), 400, 200, 1, 1, angle, 0
angle = (angle + 1) MOD 360
_LIMIT 30
_DISPLAY
LOOP UNTIL _KEYHIT
_AUTODISPLAY
PRINT
PRINT
PRINT
PRINT
PRINT "You can basically use DisplayImage just as you'd normally use RotoZoom, EXCEPT..."
SLEEP
PRINT "You can choose which CORNER of the image you want to display at your coordinates."
PRINT
LINE (350, 350)-STEP(100, 100), -1, B
CIRCLE (400, 400), 10, -1
SLEEP
PRINT "Top Left corner! ";
DisplayImage HW(1), 400, 400, 2, 2, 0, 1
SLEEP
PRINT "Bottom Left corner! ";
DisplayImage HW(1), 400, 400, 2, 2, 0, 2
SLEEP
PRINT "Top Right corner! ";
DisplayImage HW(1), 400, 400, 2, 2, 0, 3
SLEEP
PRINT "Bottom Right corner! "
DisplayImage HW(1), 400, 400, 2, 2, 0, 4
SLEEP
_FREEIMAGE HW(1)
HW(1) = TextToImage("Hello World", 16, &HFFFF0000, &HFF0000FF, 1)
PRINT "Or Centered!"
DisplayImage HW(1), 400, 400, 2, 2, 0, 0
CIRCLE (400, 400), 10, -1
SLEEP
CLS
PRINT "With TextToImage, you can turn text into an image... It's that simple!"
PRINT
PRINT "With DisplayImage, you have a ton of options for how to display ANY image"
PRINT " (NOT just for use with text images!!)"
PRINT
PRINT "Scale them, stretch them, rotate them, position them by various corners..."
PRINT
PRINT "Between these two routines, I generally don't need anything else when working"
PRINT " with images in my programs. ;)"
PRINT
PRINT
PRINT "And that's THE END of this demo. Post any questions you have on the forums for me!"
' (Image As Long, x As Integer, y As Integer, xscale As Single, yscale As Single,
' angle As Single, mode As _Byte)
FUNCTION TextToImage& (text$, font&, fc&, bfc&, mode AS _BYTE)
'text$ is the text that we wish to transform into an image.
'font& is the handle of the font we want to use.
'fc& is the color of the font we want to use.
'bfc& is the background color of the font.
'Mode 1 is print forwards
'Mode 2 is print backwards
'Mode 3 is print from top to bottom
'Mode 4 is print from bottom up
'Mode 0 got lost somewhere, but it's OK. We check to see if our mode is < 1 or > 4 and compensate automatically if it is to make it one (default).
IF mode < 1 OR mode > 4 THEN mode = 1
dc& = _DEFAULTCOLOR: bgc& = _BACKGROUNDCOLOR
D = _DEST
F = _FONT
T2Idown = CSRLIN: T2Iright = POS(0)
IF font& <> 0 THEN _FONT font&
IF mode < 3 THEN
'print the text lengthwise
w& = _PRINTWIDTH(text$): h& = _FONTHEIGHT
ELSE
'print the text vertically
FOR i = 1 TO LEN(text$)
IF w& < _PRINTWIDTH(MID$(text$, i, 1)) THEN w& = _PRINTWIDTH(MID$(text$, i, 1))
NEXT
h& = _FONTHEIGHT * (LEN(text$))
END IF
TextToImage_temp& = _NEWIMAGE(w&, h&, 32)
TextToImage = TextToImage_temp&
_DEST TextToImage_temp&
IF font& <> 0 THEN _FONT font&
COLOR fc&, bfc&
SELECT CASE mode
CASE 1
'Print text forward
_PRINTSTRING (0, 0), text$
CASE 2
'Print text backwards
temp$ = ""
FOR i = 0 TO LEN(text$) - 1
temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
NEXT
_PRINTSTRING (0, 0), temp$
CASE 3
'Print text upwards
'first lets reverse the text, so it's easy to place
temp$ = ""
FOR i = 0 TO LEN(text$) - 1
temp$ = temp$ + MID$(text$, LEN(text$) - i, 1)
NEXT
'then put it where it belongs
FOR i = 1 TO LEN(text$)
fx = (w& - _PRINTWIDTH(MID$(temp$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
_PRINTSTRING (fx, _FONTHEIGHT * (i - 1)), MID$(temp$, i, 1)
NEXT
CASE 4
'Print text downwards
FOR i = 1 TO LEN(text$)
fx = (w& - _PRINTWIDTH(MID$(text$, i, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better
_PRINTSTRING (fx, _FONTHEIGHT * (i - 1)), MID$(text$, i, 1)
NEXT
END SELECT
_DEST D
COLOR dc&, bgc&
_FONT F
LOCATE T2Idown, T2Iright
END FUNCTION
SUB DisplayImage (Image AS LONG, x AS INTEGER, y AS INTEGER, xscale AS SINGLE, yscale AS SINGLE, angle AS SINGLE, mode AS _BYTE)
'Image is the image handle which we use to reference our image.
'x,y is the X/Y coordinates where we want the image to be at on the screen.
'angle is the angle which we wish to rotate the image.
'mode determines HOW we place the image at point X,Y.
'Mode 0 we center the image at point X,Y
'Mode 1 we place the Top Left corner of oour image at point X,Y
'Mode 2 is Bottom Left
'Mode 3 is Top Right
'Mode 4 is Bottom Right
DIM AS INTEGER px(3), py(3), w, h, w1, h1
DIM sinr AS SINGLE, cosr AS SINGLE, i AS _BYTE
w = _WIDTH(Image): h = _HEIGHT(Image)
w1 = w * xscale: h1 = h * yscale
SELECT CASE mode
CASE 0 'center
px(0) = -w1 / 2: py(0) = -h1 / 2: px(3) = w1 / 2: py(3) = -h1 / 2
px(1) = -w1 / 2: py(1) = h1 / 2: px(2) = w1 / 2: py(2) = h1 / 2
CASE 1 'top left
px(0) = 0: py(0) = 0: px(3) = w1: py(3) = 0
px(1) = 0: py(1) = h1: px(2) = w1: py(2) = h1
CASE 2 'bottom left
px(0) = 0: py(0) = -h1: px(3) = w1: py(3) = -h1
px(1) = 0: py(1) = 0: px(2) = w1: py(2) = 0
CASE 3 'top right
px(0) = -w1: py(0) = 0: px(3) = 0: py(3) = 0
px(1) = -w1: py(1) = h1: px(2) = 0: py(2) = h1
CASE 4 'bottom right
px(0) = -w1: py(0) = -h1: px(3) = 0: py(3) = -h1
px(1) = -w1: py(1) = 0: px(2) = 0: py(2) = 0
END SELECT
sinr = SIN(angle / 57.2957795131): cosr = COS(angle / 57.2957795131)
FOR i = 0 TO 3
x2 = (px(i) * cosr + sinr * py(i)) + x: y2 = (py(i) * cosr - px(i) * sinr) + y
px(i) = x2: py(i) = y2
NEXT
_MAPTRIANGLE (0, 0)-(0, h - 1)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MAPTRIANGLE (0, 0)-(w - 1, 0)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB
|
|
|
|
| Powershell Text To Speech |
|
Posted by: SMcNeill - 04-23-2022, 01:55 PM - Forum: SMcNeill
- No Replies
|
|
Code: (Select All) _Title "Steve's Powershell Speech Script"
SaP "Hello World. This is a normal speed demo of David's voice", "David", 0
_Delay 2
SaP "Hello again. This is a normal speed demo of Ziva's voice.", "Ziva", 0
_Delay 2
SaP "And now I'm speaking as David, but I'm speaking veeery slow.", "David", -10
_Delay 2
SaP "And now I'm a very hyper Ziva!", "Ziva", 5
_Delay 2
SaP "And now I'm done with my demo!", "", 0
Sub SaP (text$, who$, speed)
Print text$
If UCase$(who$) = "ZIVA" Then Speaker = 1
speak text$, Speaker, speed
End Sub
Sub speak (text As String, Speaker As Integer, Speed)
Dim message As String
message = text
'some symbols and such can't be used with Powershell like this, as they're command symbols
'we need to strip them out of our text. (Like apostrophes!)
remove$ = "'" + Chr$(34) 'add to remove$ here, if more symbols need to be removed as future testing showcases problems
For j = 1 To Len(remove$)
Do
i = InStr(message, Mid$(remove$, j, 1))
If i Then message = Left$(message, i - 1) + Mid$(message, i + 1)
Loop Until i = 0
Next
out$ = "Powershell -Command " + Chr$(34)
out$ = out$ + "Add-Type -AssemblyName System.Speech; "
out$ = out$ + "$Speech = New-Object System.Speech.Synthesis.SpeechSynthesizer; "
If Speaker = 0 Then out$ = out$ + "$Speech.SelectVoice('Microsoft David Desktop'); "
If Speaker = 1 Then out$ = out$ + "$Speech.SelectVoice('Microsoft Zira Desktop'); "
If Speed Then out$ = out$ + "$Speech.Rate =" + Str$(Speed) + "; "
out$ = out$ + "$Speech.Speak('" + message + "');" + Chr$(34)
Shell _Hide out$
End Sub
|
|
|
|
| qb64.org forum archive |
|
Posted by: luke - 04-23-2022, 01:20 PM - Forum: General Discussion
- Replies (16)
|
 |
Since the qb64.org forum has ceased to exist I have deployed a copy of it at https://qb64forum.alephc.xyz from the data I have locally from January when the site moved servers. I expect to keep it there mostly indefinitely, but I make no promises. Feel free to clone it with httrack or similar, but please be gentle to the machine.
This is intended to be an archival copy, so registration and login is disabled.
|
|
|
|
| CONTENTS (Categories with links) |
|
Posted by: Dav - 04-23-2022, 02:44 AM - Forum: Dav
- No Replies
|
|
Welcome to...
Dav's QB64 Corner
Click on links below to easily find my QB64 programs.
FUNCTIONS & SUBS
FileSelect - Simple to use file selector popup box
PPRINT - SUB to easily print larger text on screen.
GAMES & PUZZLES
10x10 - Addictive line puzzle game (woody clone)
GridWars - Strategy Board game with AI Play.
Make5 - Board clearing puzzle game.
Tents - QB64 version of popular 'Tents & Trees' puzzle game.
TriPegs - Classic wooden triangle peg jumping puzzle.
JackStack - Stacking jack-o-lanterns Halloween game.
SOUND & MUSIC
KEYS48 - 48 note piano to play and record songs with
MemWave - Play WAV from string memory, not external file (WINDOWS ONLY)
TANKDRUM - Virtual tankdrum instrument to play and record
TUTORIALS
UTILITIES & TOOLS
BASFILE - Converts small files into BAS code
BASIMAGE - Put image files in you BAS code to use with _PUTIMAGE
BASFONT - Turns a FONT into BAS code SUB for using in your programs.
DavsIDE - An Alternative IDE for the QB64 compiler
XE - Simple file viewer & editor
|
|
|
|
|
![[Image: Calendar.png]](https://i.ibb.co/9NFDDhK/Calendar.png)
