Hi,
Years ago when I wrote assembler in GWBASIC or QuickBASIC there was INT &H21 to see how much free space you have left on the disk.
See also https://ftp.zx.net.nz/pub/archive/ftp.mi...46/980.HTM
Is there such a thing for QB64-PE with modern PC's like Windows 7 and up??
After some thought (always bad for me), Either this will become a QB64pe enhancement or I Don't Get It.
I use drop files a lot since implemented a couple releases ago (v1.3). It's easy to use and setup. A couple of commands and your program can take a list of files dropped on a window. I want to take to the next level.
Drop them on the desktop icon link.! And process them. This a hidden feature (or not well known) in Microsoft windows. I read through the program doc's again. Not clear if it is already implemented.
Code optimized for QB64PE which we came up with several years back as a community. I thought I'd share it here, in case anyone ever needed it or wanted to make use of it again in the future.
Code: (Select All)
Screen _NewImage(800, 600, 32)
Dim TransRed As _Unsigned Long
Dim TransGreen As _Unsigned Long
Dim TransBlue As _Unsigned Long
TransRed = _RGBA(255, 0, 0, 128)
TransGreen = _RGBA(0, 255, 0, 128)
TransBlue = _RGBA(0, 0, 255, 128)
Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
' CX = center x coordinate
' CY = center y coordinate
' R = radius
' C = fill color
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Sub EllipseFill (CX As Integer, CY As Integer, a As Integer, b As Integer, C As _Unsigned Long)
' CX = center x coordinate
' CY = center y coordinate
' a = semimajor axis
' b = semiminor axis
' C = fill color
If a = 0 Or b = 0 Then Exit Sub
Dim h2 As _Integer64
Dim w2 As _Integer64
Dim h2w2 As _Integer64
Dim x As Integer
Dim y As Integer
w2 = a * a
h2 = b * b
h2w2 = h2 * w2
Line (CX - a, CY)-(CX + a, CY), C, BF
Do While y < b
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End Sub
Sub EllipseTilt (CX, CY, a, b, ang, C As _Unsigned Long)
' CX = center x coordinate
' CY = center y coordinate
' a = semimajor axis
' b = semiminor axis
' ang = clockwise orientation of semimajor axis in radians (0 default)
' C = fill color
For k = 0 To 6.283185307179586 + .025 Step .025
i = a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
j = -a * Cos(k) * Sin(ang) + b * Sin(k) * Cos(ang)
i = i + CX
j = -j + CY
If k <> 0 Then
Line -(i, j), C
Else
PSet (i, j), C
End If
Next
End Sub
Sub EllipseTiltFill (destHandle&, CX, CY, a, b, ang, C As _Unsigned Long)
' destHandle& = destination handle
' CX = center x coordinate
' CY = center y coordinate
' a = semimajor axis
' b = semiminor axis
' ang = clockwise orientation of semimajor axis in radians (0 default)
' C = fill color
Dim max As Integer, mx2 As Integer, i As Integer, j As Integer
Dim prc As _Unsigned Long
Dim D As Integer, S As Integer
D = _Dest: S = _Source
prc = _RGB32(255, 255, 255, 255)
If a > b Then max = a + 1 Else max = b + 1
mx2 = max + max
tef& = _NewImage(mx2, mx2)
_Dest tef&
_Source tef&
For k = 0 To 6.283185307179586 + .025 Step .025
i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)
If k <> 0 Then
Line (lasti, lastj)-(i, j), prc
Else
PSet (i, j), prc
End If
lasti = i: lastj = j
Next
Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer
For y = 0 To mx2
x = 0
While Point(x, y) <> prc And x < mx2
x = x + 1
Wend
xleft(y) = x
While Point(x, y) = prc And x < mx2
x = x + 1
Wend
While Point(x, y) <> prc And x < mx2
x = x + 1
Wend
If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x
Next
_Dest destHandle&
For y = 0 To mx2
If xleft(y) <> mx2 Then Line (xleft(y) + CX - max, y + CY - max)-(xright(y) + CX - max, y + CY - max), C, BF
Next
_Dest D: _Dest S
_FreeImage tef&
End Sub
COLOR 11: PRINT " STEP 1 *** Calc ASCII Frequenzy ***"
COLOR 7
FOR i = 0 TO UBOUND(Table)
PRINT Table(i).CHAR; " - "; Table(i).COUNT
NEXT i
OPEN "test_TABLE.txt" FOR OUTPUT AS #1
FOR i = 0 TO UBOUND(table)
PRINT #1, HEX$(Table(i).CHAR) + " - " + LTRIM$(STR$((Table(i).COUNT)))
NEXT i
CLOSE #1
'SLEEP
' Step 2 - Huffman Tree create
SUB InsertElement (Array() AS assignment, Index AS _UNSIGNED LONG)
DIM I AS _UNSIGNED LONG
DIM Empty AS assignment
IF Index > (UBOUND(Array) + 1) THEN EXIT SUB
REDIM _PRESERVE Array(UBOUND(Array) + 1) AS assignment
FOR I = UBOUND(Array) - 1 TO Index STEP -1
Array(I + 1) = Array(I)
NEXT I
Array(Index) = Empty
END SUB
SUB RemoveElement (Array() AS assignment, Index AS _UNSIGNED LONG)
DIM I AS _UNSIGNED LONG
FOR I = Index TO UBOUND(Array) - 1
Array(I) = Array(I + 1)
NEXT I
REDIM _PRESERVE Array(UBOUND(Array) - 1) AS assignment
END SUB
SUB CALC_Table (Table() AS assignment, Array() AS _UNSIGNED _BYTE)
' Step 1 - Calc ASCII Char Frequenzy
DIM i AS _UNSIGNED LONG ' <- Counter for Array
DIM r AS _UNSIGNED LONG ' <- Counter for Table
DIM TableIDX AS _UNSIGNED LONG ' <- MAX Index for Table
DIM NewEntry AS _UNSIGNED _BYTE ' <- becomes 1 if character is missing from table
Table(TableIDX).CHAR = Array(i)
FOR i = 0 TO UBOUND(Array)
FOR r = 0 TO UBOUND(Table)
' If the character is already in the table,
' then increase the number of characters by 1,
' otherwise create a new entry. '
IF Array(i) = Table(r).CHAR THEN
Table(r).COUNT = Table(r).COUNT + 1
NewEntry = 0
EXIT FOR
ELSE
NewEntry = 1
END IF
NEXT r
' New Entry in Table
IF NewEntry = 1 THEN
TableIDX = TableIDX + 1
REDIM _PRESERVE Table(TableIDX) AS assignment
Table(TableIDX).CHAR = Array(i)
Table(TableIDX).COUNT = 1
END IF
NEXT i
' Sort table by counter of characters
QUICKSORT Table(), LBOUND(Table), UBOUND(Table), 1
END SUB
SUB QUICKSORT (Array() AS assignment, LB AS _UNSIGNED LONG, UB AS _UNSIGNED LONG, Mode AS _UNSIGNED _BYTE)
DIM P1 AS _UNSIGNED LONG
DIM P2 AS _UNSIGNED LONG
DIM REF AS assignment
DIM temp AS assignment
Currently doing a complete sweep and cleanup/reorg of the documentation.
Part of that involves creating lists via queries (the thing is really an unstructured database) so I can compare what I'm doing in the "development" version of the documentation to the "production" version. For sanity checks: make sure I'm not losing anything along the way.
Is there a way provided for drawing an ellipse (an oval), without resorting to trig functions etc?
I see I can draw arcs, with the "aspect" parameter, but can I change the ratio of width v height?
Because I have little control over what my brain or heart finds interesting I became curious how many words can be made by replacing tr in a word with an f, just no accounting for what we humans will get into!
I was thinking about writing a little poem, haiku.... something with clever substitutions of tr with f.
So wouldn't it be helpful to have a double list of real words you can substitute tr with f.
I had a Collins_Word_List.RA file already used for checking for real words in Boggle or other Word Play apps so lets make a list of real words made by replacing tr's with f's
Code: (Select All)
'2023-06-29 took over an hour to get debugged
Dim tr$(1 To 100000), f$(1 To 100000)
Dim As Long trI, fI, i
Dim buf$, wd$
Dim Shared rec15 As String * 15
Dim Shared NTopWord As Long
Dim Shared n$
nl$ = Chr$(13) + Chr$(10) ' eh too much work here for little joke
Open "Collins_Word_List.RA" For Random As #1 Len = 15
NTopWord = LOF(1) / 15
For i = 1 To NTopWord
Get #1, i, rec15
wd$ = _Trim$(rec15)
If InStr(wd$, "TR") Then trI = trI + 1: tr$(trI) = wd$
Next
Open "tr to f.txt" For Output As #2
For i = 1 To trI
wd$ = strReplace$(tr$(i), "TR", "F")
If Find&(wd$) Then
Print tr$(i), wd$
Print #2, tr$(i), wd$
End If
Next
Close
Function Find& (x$) ' if I am using this only to find words in dictionary, I can mod to optimize
' the RA file is opened and ready for gets
Dim As Long low, hi, test
Dim w$
If Len(x$) < 2 Then Exit Function ' words need to be 3 letters
low = 1: hi = NTopWord
While low <= hi
test = Int((low + hi) / 2)
Get #1, test, rec15
w$ = _Trim$(rec15)
If w$ = x$ Then
Find& = test: Exit Function
Else
If w$ < x$ Then low = test + 1 Else hi = test - 1
End If
Wend
End Function
Function strReplace$ (s$, replace$, new$) 'case sensitive 2020-07-28 version
Dim p As Long, sCopy$, LR As Long, lNew As Long
If Len(s$) = 0 Or Len(replace$) = 0 Then
strReplace$ = s$: Exit Function
Else
LR = Len(replace$): lNew = Len(new$)
End If
sCopy$ = s$ ' otherwise s$ would get changed
p = InStr(sCopy$, replace$)
While p
sCopy$ = Mid$(sCopy$, 1, p - 1) + new$ + Mid$(sCopy$, p + LR)
p = InStr(p + lNew, sCopy$, replace$)
Wend
strReplace$ = sCopy$
End Function
Output in zip and RA (Random Access Dictionary). The RA file requires a String * 15 long record variable to do word lookups without having to load the whole file into an array.
I wonder if @TDarcos or anyone (I offer rep points!) would care to finish this thread with some cute conversion of tr words to f words
see "tr to f.txt" file in zip
Update: Download zip extracted and checked for proper "tr to f.txt" file, yep! OK 253 words but you either know the tr word or the f word but only rarely know both! So it will take a mind wackier than mine (maybe) to compose a cute little saying.
Hey! what a great way to kick off the Summer of Fun with a new banner and a little challenge!
I was looking for drop menus code and Search directed me to Chapter 20:
Quote:Lesson20 ... game; A button library to create Windows style clickable buttons on screen, a menu library to create Windows style drop down menus, and graphics ... Last modified on May 7, 2023
Looked like just what I wanted to see but I read through Ch 20 found a Collision Library building example and an API thing but nothing on Drop Menus and clickable buttons.
Is this an omission or misdirection (another Chapter has these things)?
