I have been trying to figure out how to do this, scroll program output when it fills more than one screenful , but I have had no luck so far. I am currently working on Lesson 4 of Terry's Tutorial. Some example programs, as well as my own experiments, use a lot more screen length than just one. For example, one of the example programs counts to 100 (from whatever starting point you give it); I would like to be able to see all of the output from it (as well as the results of my own hacks, which I do in order to make sure I can replicate and understand creatively what the lesson(s) teach).
i just tested lprint for making hardcopies of some code files. not bad
i added line numbers so you can see which lines are carry over from previous lines and which are the start of new program line
i tested the code below first for quick half page copy then I did an 842 line program [editor] i am working on and it handled multiple pages without skipping a beat in about 16 pages.
maybe you will find it handy or handy to mod for your purposes
Code: (Select All)
_Title "print file" 'b+ 2024-04-06
pfile$ = _OpenFileDialog$("Select file to print", _CWD$, "*.bas|*.txt", "text files", 0)
If pfile$ <> "" Then
t$ = _ReadFile$(pfile$)
ReDim f$(1 To 1)
Split t$, Chr$(13) + Chr$(10), f$()
For i = LBound(f$) To UBound(f$)
LPrint i; " "; f$(i)
Next
Print "All done."
End If
' note: I buggered this twice now, FOR base 1 array REDIM MyArray (1 to 1) AS ... the (1 to 1) is not same as (1) which was the Blunder!!!
'notes: REDIM the array(0) to be loaded before calling Split '<<<< IMPORTANT dynamic array and empty, can use any lbound though
'This SUB will take a given N delimited string, and delimiter$ and create an array of N+1 strings using the LBOUND of the given dynamic array to load.
'notes: the loadMeArray() needs to be dynamic string array and will not change the LBOUND of the array it is given. rev 2019-08-27
Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
dpos = InStr(curpos, SplitMeString, delim)
Do Until dpos = 0
loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
arrpos = arrpos + 1
If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
curpos = dpos + LD
dpos = InStr(curpos, SplitMeString, delim)
Loop
loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
End Sub
I'm struggling with sending some colored text to my printer. The wiki seems to suggest that this can be done using Lprint and _Printimage together but I'm getting error messages. Here is the simplest example of what I'm going -
Sub PrintText
LPrint
LPrint
Color Red
_printimage words$
END SUB
I'm guessing here but it would seem _printimage does not work in Screen 0 and it would also appear that _printimage is looking for a numeric value rather than a string value, which means it's looking a page number or its looking for an image number?
I'm also wondering if the Color Red call would go before the LPrint and not after the LPrint as I have it here?
I'm looking for a solution to display a MAX thread count in QB64 via API.
I'm writing a settings tool for another application and somehow need a solution to determine the maximum number of threads on the current computer.
I would be happy if someone could help me solve this via API.
The config parameter help says:
"# Display_ExtraScalerThreads=auto/0/1/... - number of extra threads used for advanced scaling. Auto means number of threads based on number of cpu cores."
UPDATE: Never mind. POINT(0) and POINT(1) already do this.
Thanks Steve
While working on example programs for the DRAW statement topic in Lesson 5 of the tutorial I had an idea for two new commands.
The LINE statement allows doing this:
LINE(0, 0)-(100, 100), _RGB32(255, 255, 255) ' a white line
LINE -(100, 200), _RGB(255, 255, 255) ' continue the line from last point
By omitting the first set of coordinates the LINE statement simply continues on from the last point. You always know the coordinates because they are explicitly given with numerical values or variables.
However, take this piece of code for instance:
DRAW "BM200,200" ' move pen to location
DRAW "TA45" ' rotate pen
DRAW "R100" ' draw line 100 pixels long
LINE -(300, 300), _RGB32(255, 255, 255) ' continue line from last DRAW point
By omitting the first set of coordinates the LINE statement will continue on from where DRAW left off. But, what was the first set of coordinates?
Before issuing the LINE statement I suggest two new commands to find out:
_DRAWX ' get current x position of pen (or _GETX ' get current graphics cursor x position)
_DRAWY ' get current y position of pen (or _GETY ' get current graphics cursor y position)
This could come in very handy:
TYPE TICKS
x AS INTEGER
y AS INTEGER
END TYPE
DIM Tick(359) AS TICKS
DIM Angle AS INTEGER
SCREEN _NEWIMAGE(800, 600, 32)
FOR Angle = 0 to -359 STEP -1
DRAW "BM399,299" ' center pen on screen
DRAW "TA" + STR$(Angle) ' rotate pen
DRAW "U200" ' draw line 200 pixels long
Tick(ABS(Angle)).x = _DRAWX ' get current pen x position
Tick(ABS(Angle)).y = _DRAWY ' get current pen y position
NEXT Angle
You now have the 360 locations around a circle without using any trigonometry.
You can always know where your graphics cursor (or pen) position is at any time while using DRAW to do complex "Spirograph" type images. This could allow sprites, images, or even text to be located at key points within your DRAW commands.
What do you think? Sound like something looking into to? All drawing commands need to keep track of the graphics cursor position already, right? Would it be a simple thing to extract this using the two new commands?
Can the Screen(row,column) function be used to find the character at a screen location after using _newImage and setting a font?
When I try to run these few lines, I don't get the results I expect:
' with lines 3 and 4 both in, an Illegal Function message is shown.
' with line 3 in, and line 4 out, the char number is reported as 219.
' with line 4 in and line 3 out, the expected code (88) is shown.
Not about the "Bat Signal" that's just for TheBOB's benefit. Helps him find his way here. It's about...
Clickable buttons for a graphics WP routine.
(Requires fonts in attachment. They are really nice ones for mono-spaced use.)
Code: (Select All)
$Color:32
Screen _NewImage(1100, 600, 32)
Color Black, _RGB32(255, 255, 255, 255)
Cls
_Display ' Turn off autodisplay.
_Delay .1
_ScreenMove _Middle
_Delay .1
_Clipboard$ = ""
Type textvar
initiate As Integer ' -1 Indicates the Subroutine has been Initiated.
nof As Integer ' Number of Fonts.
maxchrs As Integer ' The Max Characters of a Text String. IMPORTANT: Cannot be over 255.
fsn As Integer ' Font Selection Number 1 reg, 2 Bold, 3 Italic, 4 Bold Italic.
noa As Integer ' Number of Text Attributes.
lm As Integer ' Left Margin by Pixel.
row As Integer ' Row by Pixel.
rm As Integer ' Right Margin by Pixel.
ccol As Integer ' Numeric Column of a Character.
oldccol As Integer ' Numeric Column of the Previous Cursor Position.
pixcol As Integer ' The Pixel Column the Cursor is On Currently.
insreg As Integer ' Causes a Delay in Changing the Cursor Appearance When the Insert Key is Rapidly Pressed.
reprnt As Integer ' Only Reprints a Row of Characters When Non-zero.
ovr As Integer ' Overwrite mode When Non-zero, Otherwise Insert Mode.
xl As Integer ' Pixel Column for a Character that is Part of a Link.
xm As Integer ' Numeric Column of the Character Being Passed to the Matrix.
mindex As Integer ' Numeric Matrix Index.
fsize As Integer ' Font Size.
underline As Integer ' Underline Text.
link As Integer ' Hyperlink Text.
chr_wdth As Integer ' Character Width in Pixels.
chr_hght As Integer ' Character Height in Pixels.
c_wdth As Integer ' Cursor Width in Pixels
c_hght As Integer ' Cursor Height in Pixels.
numchrs As Integer ' Number of Characters in the Line of Text.
sa As Integer ' Special Attributes for Paragraph, highlighting markers, etc.
cchr As String ' Cursor Character.
t As String ' Row of Text.
m As String ' Text and Attributes to be Saved in an RA File.
url As String ' URL Link to Follow.
linkmap As String ' Maps Pixels for Link ID with Mouse.
shift As Integer ' Shift Keys.
autoshift As Integer ' Used for instances like mouse highlighting to mimic keyboard highighting.
ctrl As Integer ' Ctrl key.
alt As Integer ' Alt key.
hl As Integer ' Highlighting Left (-1) or Right (+1)
arrows As Integer ' Aids the Cursor Update Subroutine When Arrows are Used to Highliht Text.
mouse_button1_row As Integer
button1 As Integer
tcopy As String ' Copied Text
mcopy As String ' Copied Text Matrix
button_map1 As String
End Type
Dim tx As textvar
Type mousevar
mx As Integer
my As Integer
wh As Integer
lb As Integer
rb As Integer
lb_status As Integer
rb_status As Integer
locked As Integer
oldmx As Integer
CursorStyle As Integer
mousekey As String ' Auto Keyboard Input.
End Type
Dim m As mousevar
Type popup
nmi As Integer
setup As Integer
status As Integer
pr1 As Integer
pr2 As Integer
pc1 As Integer
pc2 As Integer
phshadow As Integer
pvshadow As Integer
pwdth As Integer
phght As Integer
pbgcolor As Integer
pbbxcolor As Integer
pbshdcolor As Integer
col_matrix As String
row_matrix As String
restrict As String
End Type
Dim pop As popup
Dim Shared bit As _Bit
ReDim Shared cl(3) As Integer, bc(3) As Integer
ReDim Shared default_cl(3), default_bc(3)
tx.nof = 4
tx.fsize = 18
tx.maxchrs = 256 ' IMPORTANT: Cannot be over 255.
ReDim Shared fnum(tx.nof) As Long
ReDim Shared index_col(tx.maxchrs)
default_cl(1) = 0: default_cl(2) = 0: default_cl(3) = 0
default_bc(1) = 255: default_bc(2) = 255: default_bc(3) = 255
tx.fsn = 1 ' Default font style number.
tx.noa = 12 ' Number of character attributes.
tx.row = 100 ' Current row in pixels.
tx.lm = 100 ' Left margin in pixels.
tx.rm = tx.lm + _Width - 2 * tx.lm
tx.sa = 10 ' Number of special attributes.
cl(1) = default_cl(1): cl(2) = default_cl(2): cl(3) = default_cl(3)
bc(1) = default_bc(1): bc(2) = default_bc(2): bc(3) = default_bc(3)
tx.m$ = String$(tx.sa + tx.maxchrs * (tx.noa + 1), Chr$(0)) ' Algorithm makes a 1 string field, 10 ID fields for highlighting, paragraph, plain text line, etc., and tx.noa attributes fields.
tx.t$ = String$(tx.maxchrs, Chr$(0)) ' Our text.
tx.linkmap$ = String$(_Width, Chr$(0))
' Matrix: 1-maxchrs text, maxchrs + 1 to maxchrs + 10 Special attributes, maxchrs + 11 on are attributes each tx.noa spaces long.
' Example: maxchrs = 255. tx.noa = 12. 1-255 text, 256-265 special attributes, 266-277 attributes for 1st character in text string, 278-289 2nd, etc.
main tx, m, pop
Sub main (tx As textvar, m As mousevar, pop As popup)
Do
_Limit 60
load_font tx, fnum()
skin tx, button1$()
mouse m
If m.my >= tx.mouse_button1_row And m.my <= tx.mouse_button1_row + 17 Then
If Mid$(tx.button_map1$, m.mx, 1) <> Chr$(0) Then
_MouseShow "LINK": m.CursorStyle = 1
Else
_MouseShow "DEFAULT": m.CursorStyle = 0
End If
ElseIf m.CursorStyle Then
_MouseShow "DEFAULT": m.CursorStyle = 0
End If
If m.lb_status = 1 And m.CursorStyle Then
i% = Asc(Mid$(tx.button_map1$, m.mx, 1))
If i% > 126 Then i% = i% - 126: j% = i% Else j% = i% + 126 ' Toggle
tx.button1 = -j%
Select Case i%
Case 1, 2, 3
Mid$(tx.button_map1$, tx.lm + (i% - 1) * 26, 17) = String$(17, Chr$(j%))
Case 4, 5, 6
If i% <> Asc(Mid$(tx.button_map1$, tx.lm + (i% - 1) * 26, 1)) - 126 Then ' Radio style buttons once highlighted cannot accept same button clicks.
For k% = 4 To 6
Mid$(tx.button_map1$, tx.lm + (k% - 1) * 26, 17) = String$(17, Chr$(k%))
Next
Mid$(tx.button_map1$, tx.lm + (i% - 1) * 26, 17) = String$(17, Chr$(j%))
Else
Beep
End If
Case 7
For k% = 4 To 6
Mid$(tx.button_map1$, tx.lm + (k% - 1) * 26, 17) = String$(17, Chr$(k%))
Next
Mid$(tx.button_map1$, tx.lm + (i% - 1) * 26, 17) = String$(17, Chr$(j%))
Case 8
a = tx.lm + (i% - 1) * 26: b = 30
Line (a, b)-(a + 17, b + 17), Black, B: _Display
_Delay .15
Line (a, b)-(a + 17, b + 17), DarkGray, B: _Display
_Delay .15
End Select
End If
''keyboard tx, m, b$
''text_input tx, m, pop, b$
''popup_main tx, m, pop
Loop
End Sub
Sub load_font (tx As textvar, fnum() As Long)
If fnum(0) = 0 Then ' Bypass this routine if fnum(0) = -1. Fonts in use were already loaded. Reset to zero to reuse this routine.
fnum(0) = -1 ' See remark above.
fnum(1) = _LoadFont("RobotoMono-regular.ttf", tx.fsize)
fnum(2) = _LoadFont("RobotoMono-bold.ttf", tx.fsize)
fnum(3) = _LoadFont("RobotoMono-italic.ttf", tx.fsize)
fnum(4) = _LoadFont("RobotoMono-bolditalic.ttf", tx.fsize)
For i% = 1 To tx.nof
If fnum(i%) <= 0 Then ' Try to load the Windows Lucida Console font.
fnum(1) = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", tx.fsize)
Exit For
End If
Next
If fnum(1) <= 0 Then
tx.fsize = 16 ' Default 8 x 16 font.
fnum(1) = tx.fsize
End If
End If
End Sub
Sub skin (tx As textvar, button1$())
Static initialize
If tx.button1 <= 0 Then
tx.button1 = Abs(tx.button1): If tx.button1 = 0 Then tx.button1 = 999 ' loced out until a button is clicked.
j% = _LoadFont("RobotoMono-regular.ttf", 14)
k% = _LoadFont("RobotoMono-italic.ttf", 14)
a = tx.lm: b = 30: c = 26
If Len(tx.button_map1$) = 0 Then tx.button_map1$ = String$(_Width, Chr$(0))
tx.mouse_button1_row = b
If tx.maxchrs * _PrintWidth("A") + tx.lm < tx.rm Then tx.rm = tx.maxchrs * _PrintWidth("A") + tx.lm
For i% = 1 To 8
If Asc(Mid$(tx.button_map1$, a, 1)) > 126 Then
Line (a, b)-(a + 17, b + 17), Black, B
Line (a + 2, b + 2)-(a - 2 + 17, b - 2 + 17), _RGB32(255, 255, 255, 255), BF
Else
Line (a, b)-(a + 17, b + 17), DarkGray, B
Line (a + 2, b + 2)-(a - 2 + 17, b - 2 + 17), _RGB32(230, 230, 230, 255), BF
End If
Line (a + 17 + 1, b + 3)-(a + 17 + 2, b + 17), _RGB32(210, 210, 210, 255), BF
Line (a + 3, b + 17 + 1)-(a + 17 + 1, b + 17 + 2), _RGB32(210, 210, 210, 255), BF
a = a + c
Next
a = tx.lm: b = 30: c = 26
_Font j%
If Asc(Mid$(tx.button_map1$, a, 1)) > 126 Then
Color _RGB32(0, 0, 0, 255), _RGB32(255, 255, 255, 0)
Else
Color _RGB32(0, 0, 0, 255), _RGB32(230, 230, 230, 0)
End If
For i% = 1 To 8
Select Case i%
Case 1
_PrintString (a + (i% - 1) * c + 5, b + 2), "B"
Case 2
_Font k%
_PrintString (a + (i% - 1) * c + 5, b + 2), "I"
Case 3
_Font j%
_PrintString (a + (i% - 1) * c + 5, b + 1), "u"
Line (a + (i% - 1) * c + 5, b + 17 - 2)-(a + (i% - 1) * c + 13, b + 17 - 2), Black, B
Case 4
Line (a + (i% - 1) * c + 5, b + 5)-(a + (i% - 1) * c + 12, b + 17 - 5), Black, BF
Case 5
Line (a + (i% - 1) * c + 5, b + 5)-(a + (i% - 1) * c + 12, b + 17 - 5), Blue, BF
Case 6
Line (a + (i% - 1) * c + 5, b + 5)-(a + (i% - 1) * c + 12, b + 17 - 5), Red, BF
Case 7
Line (a + (i% - 1) * c + 4, b + 4)-(a + (i% - 1) * c + 14, b + 17 - 4), Yellow, BF
Rem Circle (a + (i% - 1) * c + 8, b + 8), 2, _RGB32(90): Paint Step(0, 0), _RGB32(90)
_PrintString (a + (i% - 1) * c + 5, b + 2), "h"
Case 8
Color Blue, _RGB32(210, 210, 210, 0)
_PrintString (a + (i% - 1) * c + 5, b + 2), "ì"
End Select
' Make mouse map.
If initialize = 0 Then
Mid$(tx.button_map1$, tx.lm + (i% - 1) * c, c) = String$(17, Chr$(i%)) + String$(c - 17, Chr$(0))
End If
Next
_Font fnum(1) ' Default font.
If initialize = 0 Then
Line (tx.lm - 5, tx.row - 5)-(tx.rm + 5, tx.row + _FontHeight + 5), Gray, B ' Text input field.
a = tx.lm + (4 - 1) * c
Line (a, b)-(a + 17, b + 17), Black, B ' Default black text button.
Line (a + 2, b + 2)-(a - 2 + 17, b - 2 + 17), _RGB32(255, 255, 255, 0), BF
Mid$(tx.button_map1$, tx.lm + (4 - 1) * c, c) = String$(17, Chr$(4 + 216))
initialize = -1
End If
_Display
End If
End Sub
Sub mouse (m As mousevar)
' Local vars: i%,j%
If Len(m.mousekey$) And m.lb_status <> 2 Then Exit Sub ' Bypass mouse when an automatic key was issued unless a drag event is occurring.
While _MouseInput
m.wh = m.wh + _MouseWheel
Wend
m.mx = _MouseX
m.my = _MouseY
m.lb = _MouseButton(1)
m.rb = _MouseButton(2)
Select Case m.lb
Case 0
Select Case m.lb_status
Case -2
m.lb_status = 0 ' The clicked event and the release triggered any event structured to occur on release.
If m.locked = -1 Then m.locked = 0
Case -1
m.lb_status = -2 ' The clicked event triggered any event structured to occur on initial button press.
Case 0
' Button has not been pressed yet.
Case 1
m.lb_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.
Case 2
m.lb_status = 0 ' The drag event is over because the button was released.
End Select
Case -1
Select Case m.lb_status ' Note drag is determined in the text highlighting routine.
Case -1
' An event occurred and the button is still down.
Case 0
m.lb_status = 1
Case 1
m.lb_status = -1 ' The button is down and triggered any event structured to occur on initial press. The status will remain -1 as long as the button is depressed.
End Select
End Select
Select Case m.rb
Case 0
Select Case m.rb_status
Case -1
m.rb_status = 0 ' An event occurred and the button was released.
Case 0
' Button has not been pressed yet.
Case 1
m.rb_status = 0 ' Button was released with no event occurring.
End Select
Case -1
Select Case m.rb_status
Case -1
' An event occurred and the button is still down.
Case 0
m.rb_status = 1
Case 1
' The button is still down but no event occurred.
End Select
End Select
m.oldmx = m.mx
End Sub
Well I nearly posted this in the help forum, but it works, so no actual help is needed with the coding. My question is more along the lines of the approach. If you had to make this type of routine, would you do it this way or another way such as using a hardware overlay method, using images with _putimage, etc. I'd figure I'd ask so I don't end up getting too comfortable with doing it one way, when using another method would demonstrate better results.
The part of the code that produces the buttons is in both in the main and skin routines.
