Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 533
» Latest member: JimmyvoW
» Forum threads: 2,944
» Forum posts: 27,451

Full Statistics

Latest Threads
PDF Generation and Myster...
Forum: Programs
Last Post: justsomeguy
8 hours ago
» Replies: 39
» Views: 627
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: aurel
9 hours ago
» Replies: 112
» Views: 8,116
The quotation marks and t...
Forum: Help Me!
Last Post: SMcNeill
Yesterday, 04:54 PM
» Replies: 5
» Views: 138
Internal IDE error
Forum: Help Me!
Last Post: eoredson
Yesterday, 04:53 AM
» Replies: 8
» Views: 174
printing characters > chr...
Forum: Help Me!
Last Post: madscijr
Yesterday, 02:11 AM
» Replies: 17
» Views: 241
Adding memmem() to QB64PE
Forum: One Hit Wonders
Last Post: Sanmayce
Yesterday, 02:08 AM
» Replies: 17
» Views: 385
Locate command on the ttf...
Forum: Help Me!
Last Post: SMcNeill
03-09-2025, 05:47 PM
» Replies: 5
» Views: 57
GX Platformer Tutorial
Forum: Works in Progress
Last Post: dbox
03-08-2025, 06:03 AM
» Replies: 7
» Views: 224
Is there a square monospa...
Forum: Help Me!
Last Post: madscijr
03-08-2025, 12:26 AM
» Replies: 9
» Views: 528
using a custom tileset as...
Forum: Help Me!
Last Post: madscijr
03-08-2025, 12:20 AM
» Replies: 10
» Views: 188

 
  Cave Fighter (with scrolling background maps)
Posted by: SierraKen - 10-24-2024, 07:39 PM - Forum: SierraKen - No Replies

This is a good example of scrolling background picture maps. Bplus made the saucer fighter graphic. Download the zip file and put all the files in the same directory. 
Use the arrow keys (or WASD keys) to move and also change the direction of your laser. Press the space bar to fire. The object of the game is to shoot the cannons, dodge the cannonballs and to make it to the end of the cave.



Attached Files
.zip   Cave Fighter.zip (Size: 1.13 MB / Downloads: 45)
Print this item

  QB Missle
Posted by: SMcNeill - 10-24-2024, 07:02 AM - Forum: Games - Replies (4)

Here's an ancient game from long ago and far away that still seems to run more-or-less as intended on QB64PE -- QB Missle!

Quote: Fully playable, unfinished version of Qbasic Missile Command clone. Defend your city's against a barrage of nuclear missile attacks. Features sprite graphics, FX sounds, mouse control and unlimited levels. This game is not compiled.


Game comments are here, for details:

' Program : QBMissle
' Version : Unfinished
' Author  : Tim Truman
' Date    : 7/5/97
' Type    : Freeware
' Copyright (c) Tim Truman 1997
' Feel free to use any routines or code found this program in your own.
' I just ask that you do not distribute this source code program modified
' and/or recompile the program for reasons other than personal use.
'
' About :
'  Graphics made with Sprite 2.0
'  FM Sounds made with FX. (requires soundcard for playback)
'  ( Programs available at my FTP : http://members.aol.com/TimTruman )
'
' Author :
'  Qbmissle is unfinished. I wanted to add smart bombs and a high score
'  screen but i just haven't had the time. I don't plan on finishing it
'  but I though Qbasic fans would like it anyway. It's still a playable
'  game and shows that Qbasic is capable gaming platform.
'
' To play :
'  Move the targeting cursor with the mouse and press a mouse button to
'  fire an antiballistic missle. Progressive levels will get harder.
'
' Comments:
' AOL - TimTruman
' NET - TimTruman@aol.com
' CS  - 74734,2203

And for folks who like to ask, "Will QB64PE still run my anicent and outdated QBASIC code, without needing changes?", I think this is a good example of how hard we work to be able to do that.

Take old code.
Load into QB64PE compiler.
Run executable!

Big Grin



Attached Files
.zip   qbmissle.zip (Size: 196.56 KB / Downloads: 49)
Print this item

  program that stitches together a bunch of image files into one giant poster?
Posted by: madscijr - 10-23-2024, 07:55 PM - Forum: Help Me! - Replies (15)

Before I go and reinvent the wheel, I'm wondering if this or something similar already exists...? 

I'm thinking a program that 

  • looks in a directory like "c:\Users\MyUser\Pictures"
    (extra points if it can handle environment variables like "%USERPROFILE%\Pictures") 
  • finds all images (extra points if it lets you specify 1 or more wildcards to match like "*.jpg;*.png;*.gif")
  • gets the size of all of them and figures out (based on layout chosen) how big the final image will be & initialize it
    (I'm not sure what kind of limitations QB64PE has for image size, I am thinking this prog would limit the size only based on the computer memory & hard drive space)
  • for each pic:
    loads it into memory,
    resize/scale/rotate (depending on options)
    copies to a new giant image (depending on the layout you choose,
    e.g., if we have 16 pictures, maybe 4 columns x 4 rows, or 8 columns x 2 rows)
  • outputs a new image file in the selected format. 

I'm thinking of some fancy features like if the pictures are different sizes, it can resize them / rotate them / stretch them, depending on what you can choose, to whatever the largest common dimension is, or maybe it can detect a picture's orientation, and auto rotate so they are all landscape or portrait, or figure out how to lay them out so there is minimal blank space. 

Maybe an option to not rotate but fill in the blank space with a given background color, or if there are not enough pics for an even # of rows/columns, fill in empty areas with some default color or pattern.

Some of the things I'm going to have to figure out how to do for this include 
  • list files from a folder
  • match based on *? wildcards
  • load an image file into a _NewImage
  • detect image height/width
  • rotate image
  • scale/resize image
  • stretch/skew image
  • display an image bigger than the screen shrunk down to fit the screen (to preview on screen)
  • save image from memory to a file

Simple use cases: 
  • make a pic collage for your PC's desktop 
  • take a bunch of pictures and turn them into a poster you can have printed at somewhere like CVS (the web site says 24"x36" is $15.99 ?!)
  • make a background for a game

Has anyone seen or done anything like that?

Print this item

  WPF Message Boxes
Posted by: SpriggsySpriggs - 10-23-2024, 05:36 PM - Forum: General Discussion - Replies (8)

This is not something new. This is something I made a long time ago that I may or may not be trying to work on again. I like message boxes. Always have. Especially customizable ones. These are highly customizable and can replace the built-in error message boxes in QB64.

Print this item

  Zeller's congruence pass 3: test day-of-week calculation algorythms for accuracy
Posted by: TDarcos - 10-23-2024, 05:04 PM - Forum: Utilities - No Replies

After my recent debacles with getting a Zeller's congruence (determine day of week from date) formula, I repeated my foray into software archeology, by searching my collection of 90,142 files (many being zip files) and more than 12 gb of Basic source and basic-related files, I found an old file that purports to return day of week from date. It was old enough to be from the days when Basic programs had to have line numbers:

Code: (Select All)
_Title "Possibly_accurate_zellers_congruence"
10 ' DAYOPFWK = Calculates the day of the week given date
20 '
30 Cls: Print
40 Print "  This routine calculates the day of the week given the date"
50 Dim DAYS$(6): For I = 0 To 6: Read DAY$(I): Next
60 Data Saturday,Sunday,Monday,Tuesday,Wednesday,Thursday,Friday
70 Line Input "Enter date as mm/dd/yyyy "; EDATE$: S$ = EDATE$
80 PS = InStr(S$, "/"): MONTH = Val(Left$(S$, PS - 1)): S$ = Mid$(S$, PS + 1)
90 PS = InStr(S$, "/"): DAY = Val(Left$(S$, PS - 1)): S$ = Mid$(S$, PS + 1)
100 YEAR = Val(S$)
110 '
120 If MONTH > 2 Then 140
130 MONTH = MONTH + 12: YEAR = YEAR - 1
140 N = DAY + 2 * MONTH + Int(.6 * (MONTH + 1)) + YEAR + Int(YEAR / 4) - Int(YEAR / 100) + Int(YEAR / 400) + 2
150 N = Int((N / 7 - Int(N / 7)) * 7 + .5)
160 Print DAY$(N)
A few tests seem to confirm it is accurate, but let's really put it to the test. Rerun it thousands, or hundreds of thousands of times, and see if it's right. I have my Zeller's Congruence test harness; let's "strap it in, fire up the motor and see if it lights, or explodes on the test site."

The operative part of the above program is lines numbered 120-150. So, I have this:

Code: (Select All)
' Date_testbed.bas - load every date and test a Zeller's congrence algorithm for correctness
' Paul Robinson October 23, 2024

Option _Explicit
_Title "Zeller_testbed"

' The system time function can be used from QB64, I was mistaken it could not
Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Declare Dynamic Library "kernel32"
    Function GetLocalTime& (lpSystemTime As SYSTEMTIME)
    Function GetLastError& ()
    Function FormatMessageA& (ByVal f As Long, f$, Byval e As Long, Byval d As Long, g$, Byval s As Long, h$)
End Declare

Dim As SYSTEMTIME StartTime, EndTime
Dim TimeString As String


Color 15
Cls
Const Saturday = 0
Const Sunday = Saturday + 1
Const Monday = Sunday + 1
Const Tuesday = Monday + 1
Const Wednesday = Tuesday + 1
Const Thursday = Wednesday + 1
Const Friday = Thursday + 1

Const January = 1, February = 2, March = 3, April = 4, May = 5, June = 6
Const July = 7, August = 8, September = 9, October = 10, November = 11, December = 12

Const LimitYear = 9999


Dim Shared YD(1800 To LimitYear, December, 31) As Integer
'    Dim As Integer Month
Dim Shared As Integer Year, Month, Day, Hour, Minute, Second, Leap
'Dim Shared Year$, Month$, Day$, WeekDay$, Minute$, Second$, AmPm$
'Dim Shared As String DateString
Dim As Integer DayStart, I, WindowsOffset, ZellersOffset
Dim As Long RecCount

' these use 1-12 for convenience
Dim Shared MonthDays(1, December) As Integer, MonthNames(December) As String
' This one uses 0
Dim Shared DayNames(12) As String
Data "January",31,"February",28,"March",31,"April",30,"May",31
Data "June",30,"July",31,"August",31,"September",30
Data "October",31,"November",30,"December",31

Data "Saturday","Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday","Monday","Tuesday","Wednesday","Thursday"

For Month = January To December: Read MonthNames(Month), MonthDays(0, Month): Next
For Month = January To December: MonthDays(1, Month) = MonthDays(0, Month): Next ' Leap years
For Day = 0 To 12: Read DayNames(Day): Next

' We start Saturday =0 as most Zeller's congruence algorhythms do
' If either the test routine or Windows starts any other day, add the offset

WindowsOffset = 1 ' Windows starts Sunday
ZellersOffset = 0 ' The Zeller's Congruence starts Saturday

MonthDays(1, February) = 29 'Adjust for leap year

' Start the clock
I = GetLocalTime(StartTime)

TimeString = DayNames(StartTime.wDayOfWeek + WindowsOffset) + ", "
TimeString = TimeString + " " + MonthNames(StartTime.wMonth)
TimeString = TimeString + Str$(StartTime.wDay) + "," + Str$(StartTime.wYear) + " at"
TimeString = TimeString + Str$(StartTime.wHour) + ":"
TimeString = TimeString + Right$("0" + LTrim$(Str$(StartTime.wMinute)), 2) + ":"
TimeString = TimeString + Right$("0" + LTrim$(Str$(StartTime.wSecond)), 2)
Open "L:\ZteatResults.txt" For Output As #1
DPrint "Program begins, " + TimeString
DPrint "Initialization: Collecting dates from 1-1-1800 to 12-31-" + LTrim$(Str$(LimitYear))
DPrint "Please wait while initialization is completed"
Dim As _Byte ok, PP, Sc, InitialDay
ok = -1
InitialDay = Wednesday ' January 1, 1800
DayStart = InitialDay
RecCount = 0
PP = 0
For Year = 1800 To LimitYear
    '    Leap Year Calcultions
    GoSub GetLeap

    ' Now count the days
    For Month = January To December
        For Day = 1 To MonthDays(Leap, Month) ' if leap year, uses alternate
            YD(Year, Month, Day) = DayStart
            DayStart = DayStart + 1
            RecCount = RecCount + 1

            If DayStart = 7 Then DayStart = 0
        Next
    Next
Next


I = GetLocalTime(EndTime) ' Stop the clock

' Compute elapsed time

Hour = EndTime.wHour
If StartTime.wHour < EndTime.wHour Then Hour = Hour + 24
Hour = Hour - StartTime.wHour

Minute = EndTime.wMinute
If StartTime.wMinute < EndTime.wMinute Then Minute = Minute + 60: Hour = Hour - 1
Minute = Minute - StartTime.wMinute

Second = EndTime.wSecond
If StartTime.wSecond < EndTime.wSecond Then Minute = Minute - 1: Second = Second + 60
Second = Second - StartTime.wSecond
Dim As Single St, Et
Et = EndTime.wMilliseconds / 1000
St = StartTime.wMilliseconds / 1000
If Et < St Then Second = Second - 1: Et = Et + 1

Et = (Et - St)

TimeString = ""
If Hour > 0 Then
    TimeString = Str$(Hour) + "hour"
    If Hour <> 1 Then TimeString = TimeString + "s"
    TimeString = TimeString + " "
End If
If Minute > 0 Then
    TimeString = TimeString + Str$(Minute) + "minute"
    If Minute <> 1 Then TimeString = TimeString + "s"
    TimeString = TimeString + " "
End If
If TimeString <> "" Then TimeString = TimeString + "and "
If Second < 0 Then Second = 0
TimeString = TimeString + LTrim$(Str$(Second + Et)) + " seconds."

DPrint "Initialization completed;" + Str$(RecCount) + " records initialized. "
DPrint "Initialization took " + TimeString
Second = Hour * 3600 + Minute * 60 + Second
Dim As Integer ProcessCount
If Second + Et > 3 Then
    ProcessCount = RecCount / (Second + Et)
    DPrint "Initilization rate was approx. " + Str$(ProcessCount) + "records per second."
End If
DPrint ""
DPrint "A check will be made to see how accurate the Zeller's congruence algorhythm is."
' Insert code to test here
Dim DOW As Single

Month = 1
Day = 1
Year = 1800

I = 0

GoSub Zeller
DPrint "January 1, 1800 was a " + DayNames(YD(Year, Month, Day)) + ", the algorhythm says it was " + DayNames(DOW) + "."
If YD(Year, Month, Day) <> DOW Then DPrint "": DPrint "Algorhythm fails.": Close: End

Locate 10, 1
DPrint "Now let's see how accurate it is:"

Locate 12, 1
Print "Year"
RecCount = 0

For Year = 1800 To LimitYear
    Locate 12, 5
    Print Year
    Leap = 0
    GoSub GetLeap
    For Month = January To December
        For Day = 1 To MonthDays(Leap, Month)
            GoSub Zeller
            If DOW <> YD(Year, Month, Day) + ZellersOffset Then
                Locate 15, 1
                Color 4
                DPrint "Mismatch on " + MonthNames(Month) + Str$(Day) + ", " + Str$(Year)
                DPrint "Precalc is :" + DayNames(YD(Year, Month, Day) + ZellersOffset) + " but Zeller says " + DayNames(DOW + ZellersOffset)
                Color 15
                I = I + 1
            End If

        Next
    Next
Next
Locate 17, 1
Dim ERCMsg$
If I = 0 Then ERCMsg$ = "NO " Else ERCMsg$ = Str$(I)
DPrint "Completed with " + ERCMsg$ + "errors."

DPrint "There were " + Str$(RecCount) + " date computations."
DPrint ""
If I = 0 Then
    DPrint ""
    DPrint "I believe this certifies the algorhythm is accurate."
Else
    DPrint "Algorhythm fails."
End If

Close
End

GetLeap:
'    Leap Year Calcultions
Leap = 0
' Year mod 4 = 0 for a leap year (in most cases)
If Year Mod 4 = 0 Then ' It is virtually certain it is a leap year with one exception

    ' If it is a century year (year where last two digits are 00)
    If Year Mod 100 <> 0 Then ' Not a century year
        Leap = 1 ' regular leap year
    Else ' It is a century year, it must also be divisible by 400
        If Year Mod 400 = 0 Then Leap = 1 ' Century leap year
    End If
End If
Return


Dim As Integer Zmonth, ZYear
Zeller:
If Month < 3 Then
    Zmonth = Month + 12
    ZYear = Year - 1
Else
    Zmonth = Month
    ZYear = Year
End If
DOW = Day + 2 * Zmonth + Int(.6 * (Zmonth + 1)) + ZYear + Int(ZYear / 4) - Int(ZYear / 100) + Int(ZYear / 400) + 2
DOW = Int((DOW / 7 - Int(DOW / 7)) * 7 + .5)

RecCount = RecCount + 1
Return

' Text output can't be captured off screen through
' mouse or hilighting, so we also print to a file
Sub DPrint (P$)
    Print P$
    Print #1, P$
End Sub
Note I did not change the original algorhythm even if there might be more succinct ways of doing it, for one simple reason: i believe it works, and I can always come back later and "modernize" it

Let's run it and see how accurate it is:

Program begins, Wednesday,  October 23, 2024 at 12:55:05
Initialization: Collecting dates from 1-1-1800 to 12-31-9999
Please wait while initialization is completed
Initialization completed; 2994988 records initialized.
Initialization took .09 seconds.

A check will be made to see how accurate the Zeller's congruence algorhythm is.
January 1, 1800 was a Wednesday, the algorhythm says it was Wednesday.
Now let's see how accurate it is:
Completed with NO errors.
There were  2994988 date computations.


I believe this certifies the algorhythm is accurate.

Print this item

  suggestion - show search string in search results
Posted by: madscijr - 10-23-2024, 04:36 PM - Forum: Site Suggestions - Replies (2)

I noticed that when I use the search bar to find something in the forums, 

for example, "read image file into memory", 

that after you click Search and the results are displayed, the search string is nowhere to be seen. 

The URL is no help either, because instead of the search terms, just it contains some ID, for example 

Code: (Select All)
https://qb64phoenix.com/forum/search.php?action=results&sid=87e359e46ab483cc3b0f10a8e9f25f0b&sortby=&order=desc

So to remember what it was you were searching for, you have to click Back in the browser, and see what's in the Search box. 

Would it be possible to show the original search string on the search results page? 

Because when I'm researching how to do things for a project, I might have 5 or more searches open in the browser, and it would be helpful to be able to, at a glance, see what I was looking for in each tab.

Print this item

Question question or suggestion - save drafts?
Posted by: madscijr - 10-23-2024, 04:30 PM - Forum: Site Suggestions - Replies (9)

First, I was editing a rather long post, and then something happened and everything reset to the blank editor - I don't know what I did, hit the wrong key on the keyboard or clicked the wrong thing on the browser. Anyway, everything I typed was gone - POOF! 

So my question is, is my draft saved somewhere, and if so, how do I get it back to continue editing? 

And if not, my suggestion is, can we configure the site to auto-save drafts, and if a user exits without posting it, they can go to some page that lists their unfinished posts, where they can continue editing or delete them? 

I have seen that kind of feature on other Web sites so I know it can be done, not sure if it can be done here, but I figure it's worth asking, after losing all that content!

Print this item

  Pete's Dumb Idea of the Day!
Posted by: Pete - 10-21-2024, 07:53 PM - Forum: General Discussion - Replies (18)

Wouldn't it be nice to have this feature for Data Restore?

On x Restore data1, data2, data3

instead of needing to code...

Select Case x
Case 1: Restore data1
Case 2: Restore data2
Case 3: Restore data3
End Select

data1:
data eof
data2:
data eof
data3:
data eof

Be sure to post your hate comments in a respectful, non-micro-aggressive and culturally appropriate manner. Oh who am I kidding? Comment however the hell you want!

Pete

Print this item

  Making files more portable
Posted by: JRace - 10-21-2024, 12:40 AM - Forum: Programs - Replies (9)

Steve's $Embed thread (https://qb64phoenix.com/forum/showthread.php?tid=3142) got my curiosity going.


But first, an FYI:
For several years now I've been using the 7Zip self-extractor to compress software packages, such as editors or compiler suites, into single-file EXEs for easy transport on a thumbdrive.

7Zip's cleverly designed self-extractor stub (which I will call the .SFX) can extract these files into a temporary folder, and then execute a file of my choice.  Normally the executed file would be a script to copy files into a more permanent installation folder, but I instead run that now unpacked editor or a batch file to perform compilation steps.  The .SFX waits patiently and when all programs in the temp folder have ended, the .SFX conscientiously deletes that temp folder.  No muss, no fuss.

This saves a lot of space on a thumbdrive, compressing a 512 megabyte (after the deletion of some non-essential MinGW files) QB64PE suite down to just 53.48 megs.
It also saves a LOT! of time.  I don't know how long it would take to copy all 6350 (again, fat-trimmed) files of QB64PE to a thumbdrive, but copying MinGW alone can take several HOURS.  (At least, it took that long on the thumbdrives I was using.  I will never buy another SanDisk flash drive.  I own several and those turkeys are all SLOW.)

(If anyone is thinking of trying the .SFX stunt described above I have to warn you that it's not for the faint-of-heart.  It's a manual process that cannot be done from the 7Zip GUI.  It took much time, trial, and error to get it all working the way I envisioned.)



Anyway, I created a small executable ("Hello, World", written in C) and embedded it into a QB64PE test program which would extract HELLO.EXE to disk and run it.  The tester compiled and ran as it should.

Ohhhkay, now a slightly bigger test.  For this one I chose CharlieJV's Basic Anywhere Machine and modded the test program to fit:
Code: (Select All)
_Title "ExtractRun"

$Embed:'./BAM.html','embhandle'

o$ = _Embedded$("embhandle")
_WriteFile "./BAM_extracted.html", o$
If _FileExists("./BAM_extracted.html") Then Shell "start BAM_extracted.html"
End
(the filenames in ExtractRun can be changed as needed)

The compiled ExtractRun with a small executable is 1.95 megs.  Let's consider that the baseline, minimal ExtractRun size.
Uncompressed Basic Anywhere Machine weighs in at 4.54 megabytes.
The compiled ExtractRun with BAM is 2.81 megs (UPX can compress that down to about 1.5 megs.)
That means PE's $EMBED squeezes BAM down to just 0.86 megs.

Just posting this in case anyone wants to tinker or build with it.

Print this item

  Expanding SELECT CASE
Posted by: NakedApe - 10-20-2024, 06:08 PM - Forum: GitHub Discussion - Replies (5)

I've been trying to clean up IF statements in the game I'm working on. Would it be hard to have SELECT CASE work not just with variables but also with arrays and UDTs?

Imagine:
            SELECT CASE flag '        (booleans)
                CASE .drawShip: .........
                CASE .explode: .........
                CASE .endRound: .........
             END SELECT
Or:
            SELECT CASE fatArray()
                CASE 0 TO 50: ..............
                CASE 51 TO UBOUND(fatArray): ..........
            END SELECT

Would this be cool / useful?

Print this item