Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.

Topics - SMcNeill

Pages: 1 ... 14 15 [16]

226

Programs / PNG chunk information

« on: September 09, 2018, 02:05:02 pm »

Since TerryRichie was asking how to get the background color from a PNG file, I thought I'd go ahead and take a few moments to write up a program to do that for us:

Code: QB64: [Select]

DIM DataLength AS _UNSIGNED LONG
DIM code AS STRING * 4
DIM red AS _UNSIGNED _BYTE, blue AS _UNSIGNED _BYTE, green AS _UNSIGNED _BYTE
_CONTROLCHR OFF
f$ = "e1.png"
 
OPEN f$ FOR BINARY AS #1
DO
    GET #1, , DataLength
    DataLength = ConvertUL(DataLength)
    PRINT DataLength,
    GET #1, , code
    PRINT code
    IF code = "bKGD" THEN 'we found the background color
        junk$ = " "
        GET #1, , red
        GET #1, , junk$ 'PNG stores the data as 2 bytes, so we need to read an extra character to move file pointer
        GET #1, , blue
        GET #1, , junk$ 'same as before
        GET #1, , green
        GET #1, , junk$ 'same as before
        PRINT "BACKGROUND: "; red, blue, green
        junk$ = "    " 'the CRC check, which we don't really care about, but we need to advance the file pointer to the next chunk
        GET #1, , junk$
    ELSE
        junk$ = SPACE$(DataLength + 4)
        GET #1, , junk$
    END IF
    SLEEP
LOOP UNTIL code$ = "IEND"
 
FUNCTION ConvertUL~& (x AS _UNSIGNED LONG)
    ConvertUL = x \ 2 ^ 24 OR x * 2 ^ 24 OR (x AND &HFF0000) \ 2 ^ 8 OR (x AND &HFF00~&) * 2 ^ 8
END FUNCTION
 

Test image is below, which has a yellow background set as found here: http://www.schaik.com/pngsuite/pngsuite_bck_png.html

227

Programs / Game Maker 64 (GM64)

« on: August 25, 2018, 02:27:50 am »

After all this talk about map editing, map making, and such, I've finally decided to toss my hat into the ring and start working on a passable Game Map making program.

Attached is the start to my effort, but it should illustrate the interface and how things are going to work and interact for us, as development continues. Feel free to take a look at it, and tell me if it seems intuitive enough to work with, and feel free to offer suggestions as to what features you'd like to see it support as development progresses. ;)

(GM64.BAS is the file you'd want to compile and run, to test everything out.)

228

QB64 Discussion / Occassional Graphical Glitch

« on: August 24, 2018, 09:13:46 pm »

With all this discussion about map making and map editors, I thought I'd sit down and take a little time to write up a little map engine/maker, but from testing it as I get it started, I'm coming across a rather odd graphical glitch.

Graphics are set for 1024x800, 32-bit resolution, and $RESIZE is set to allow the user to STRETCH the screen if they so desire...

Normally, everything compiles and runs exactly as one would expect...

However, about once every 10th compile, the screen starts at a 640x480 resolution, much like we'd expect a SCREEN 0 screen to appear -- though it's still in 32-bit color mode and everything still runs as expected.

It seems as if there's a race condition occurring somewhere, which is affecting the $RESIZE, which "stretches" the screen to an undesirable size at startup...

My question: Has anyone else experienced this in any other programs? Can anyone else reproduce this issue? This is a behavior I've never seen before, and it's an issue that's intermittent -- though annoying -- and I'm wondering if anyone has any ideas where to start to debug it (or just work around the issue temporarily, so it doesn't keep popping up as I run/test this work-in-progress).

229

QB64 Discussion / Re: From strange to weird

« on: July 25, 2018, 10:27:29 pm »

Note: This message is awaiting approval by a moderator.

Sounds like an issue others have reported in the past with their antivirus deleting or quarantining the newly compiled executable seconds after its compiled.

Quick test: Completely disable anti-virus and try again. See what happens.

If things work as expected, then you'll need to whitelist QB64 and its folder so your AV doesn't keep interfering with the newly compiled (and unidentified) executables.

230

QB64 Discussion / Why _MEM.OFFSET?

« on: July 22, 2018, 08:33:17 am »

So here's a question: Why was the Mem commands built to use m.OFFSET as the second parameter? What's the purpose/reason for it? Why not have it work inherently behind the scene??

For example, why do we need to _MEMGET m, m.OFFSET + 100, var? Why wasn't it made to just be _MEMGET m, 100, var?

Think of it in comparison to using GET from a file... We GET #1, 100, var; we don't need to GET #1, #1.OFFSET + 100, var....

I know _MEM has been around and has been used in too many programs to change its syntax so much now, but is there a reason for m.OFFSET being there that I'm just overlooking? We're *always* going to reference memory from the start of a memblock, so shouldn't QB64 have just added _MEM.OFFSET to whatever pointer/variable we sent it, behind the scenes, and saved the programmer from ever having to type it out or worry about it??

I'm just curious if anyone knows why it is the way it is, and if there's just an obvious reason for it that I'm overlooking.

231

QB64 Discussion / QB64 x64 (10-17-2018)

« on: July 21, 2018, 02:24:05 pm »

I updated the version of the 64-bit windows copy of QB64 so recent changes, alterations, and additions will work for those who want/need to program in a 64-bit environment with Windows. Download can be found over here: http://qb64.freeforums.net/thread/100/qb64-x64-07-21-2018

One note to Luke and Felippe, which still requires a manual edit of libqb.cpp before a 64-bit version will build properly:

Code: QB64: [Select]

int32 func__handle(){
    #ifdef QB64_GUI
        #ifdef QB64_WINDOWS
            while (!window_handle){Sleep(100);}
            return (int32)window_handle;
        #endif
    #endif
    
    return 0;
}

The above will error and crap out on compilation for us, and the reason is simple -- you can't return a 64-bit window handle to a 32-bit integer. At least, not if you want it to work right at all. ;)

Change is simple and doesn't affect the 32-bit version at all -- simply return an integer based on the pointersize, as below:

Code: QB64: [Select]

int32 func__handle(){
    #ifdef QB64_GUI
        #ifdef QB64_WINDOWS
            while (!window_handle){Sleep(100);}
            return (ptrszint)window_handle;
        #endif
    #endif
    
    return 0;
}

If one of you could make and push the simple change into the repo with your next edit, all that's needed from this point forward is to swap out the 32-bit c-compiler for a 64-bit c-compiler and then run setup_win.bat, to build the 64-bit version whenever someone wants/needs to update it in the future. ;)

232

QB64 Discussion / ColorAll Library

« on: July 20, 2018, 03:32:59 pm »

I know a lot of folks have enjoyed my color name library for 32-bit colors, so sometime back, I decided to expand the library so that the color names could be used in any screen mode for us, as I'll illustrate below and in the next few posts.

First thing to do, grab the two library files below and put them in your QB64 library.

Next, be aware that the library now makes use of QB64's precompiler, so you'll need to set a precompiler value to tell it which screen mode your program is going to be working with. The variable for this is simply called KOLOR.

So, for a text screen (SCREEN 0) program, all you'd need to do is basically set KOLOR to 0 (to indicate it's going to be SCREEN 0 text graphics), and then include the ColorAll.BI at the top of your program, and then you can use the color names instead of the numbers for your program -- as indicated below.

Code: QB64: [Select]

'First, set the KOLOR value to tell the precompiler what color scheme we need.
 
$LET KOLOR = 0
 
 
'Then include the library file.
'$include:'ColorAll.BI'
 
 
'Then use the names
COLOR White, Yellow
PRINT "White on Yellow"
COLOR Red, Blue
PRINT "Red on Blue"
COLOR BrightWhite, Yellow
PRINT "Bright White on Yellow"
COLOR Blink + BrightWhite, Magenta
PRINT "Blink Bright White on Magenta"
 

Color values can be read by looking at the variables inside ColorAll.BI, but for simplicity's sake, I'll include them here since there's only a few to deal with in text mode:

$IF KOLOR = 0 THEN
CONST Black = 0~%%
CONST Blue = 1~%%
CONST Green = 2~%%
CONST Cyan = 3~%%
CONST Red = 4~%%
CONST Magenta = 5~%%
CONST Brown = 6~%%
CONST White = 7~%%
CONST Gray = 8~%%
CONST LightBlue = 9~%%
CONST LightGreen = 10~%%
CONST LightCyan = 11~%%
CONST LightRed = 12~%%
CONST LightMagenta = 13~%%
CONST Yellow = 14~%%
CONST BrightWhite = 15~%%
CONST Blink = 16~%%
$END IF

233

Programs / Math Flash Card Trainer for Children

« on: July 28, 2017, 01:29:30 pm »

Code: QB64: [Select]

TYPE ResultsType
    num1 AS LONG
    op AS LONG
    num2 AS LONG
    num3 AS LONG
    answer AS LONG
    correct AS LONG
END TYPE
 
 
_TITLE "Flash Card Math Trainer"
DEFLNG A-Z
$RESIZE:SMOOTH
_DELAY 0.5
WS = _NEWIMAGE(1280, 720, 32) 'WorkScreen
SCREEN WS
 
DIM SHARED WF 'Workfont
WF = _LOADFONT("C:\Windows\Fonts\Cour.ttf", 150)
 
 
DIM SHARED RST 'Result Font
RST = _LOADFONT("C:\Windows\Fonts\Cour.ttf", 50)
 
REDIM SHARED Results(0) AS ResultsType
DIM SHARED GameTime, Difficulty
 
CONST Red = _RGB32(255, 0, 0)
CONST White = _RGB32(255, 255, 255)
CONST Black = _RGB32(0, 0, 0)
CONST Blue = _RGB32(0, 0, 255)
CONST Green = _RGB32(0, 255, 0)
CONST Yellow = _RGB32(255, 255, 0)
 
CONST Plus = 1, Minus = 2, Times = 3, Divide = 4
 
 
 
RANDOMIZE TIMER
 
 
t1 = _FREETIMER
ON TIMER(t1, 1) CountDown
 
 
 
MainChoiceScreen mode, Difficulty, length
 
SELECT CASE length 'This is the number of seconds we're going to test ourselves
    CASE 1: GameTime = 15
    CASE 2: GameTime = 30
    CASE 3: GameTime = 60
    CASE 4: GameTime = 120
    CASE 5: GameTime = 300
END SELECT
 
SELECT CASE Difficulty 'This determines how hard the game will be
    CASE 1: LowLimit = 0: HighLimit = 10
    CASE 2: LowLimit = 0: HighLimit = 12
    CASE 3: LowLimit = 0: HighLimit = 99
    CASE 4: LowLimit = 10: HighLimit = 89
END SELECT
 
 
TIMER(t1) ON
 
 
 
DO
    _LIMIT 10
    num1 = RND * HighLimit + LowLimit
 
    SELECT CASE mode 'Only give the user the numbers they wanted to play with
        CASE 1: op = 1
        CASE 2: op = 2
        CASE 3: op = RND + 1
        CASE 4: op = 3
        CASE 5: op = 4
        CASE 6: op = RND + 3
        CASE 7: op = RND: IF op = 0 THEN op = 1 ELSE op = 3
        CASE 8: op = INT(RND * 4) + 1
    END SELECT
 
    num2 = RND * HighLimit + LowLimit
 
    IF op = 4 THEN 'it's divide, let's get the numbers in the proper order
        DO
            num1 = RND * HighLimit + LowLimit
            num2 = RND * HighLimit + LowLimit
            num1 = num1 * num2
        LOOP UNTIL num1 < 100
    END IF
    IF op = 2 AND num1 < num2 THEN SWAP num1, num2
    DrawCard num1, op, num2
    DrawUserClickAreas
    GetUserAnswer answer$
    CheckAnswer num1, op, num2, answer$
    DisplayTime
    _DISPLAY
LOOP
 
 
SUB MainChoiceScreen (mode, difficulty, length)
CLS
_FONT RST
PRINT "Welcome to Math Flash!"
_FONT 16
LOCATE 5, 1: PRINT "Your personal math trainer!"
PRINT
PRINT "What would you like to learn to work with today?"
PRINT "1) Addition"
PRINT "2) Subtraction"
PRINT "3) Addition and Subtraction"
PRINT "4) Multiplication"
PRINT "5) Division"
PRINT "6) Multiplication and Division"
PRINT "7) Addition and Multiplication"
PRINT "8) ALL of them"
PRINT "9) QUIT THE TRAINER"
 
DO
    _LIMIT 10
    a = VAL(INKEY$)
LOOP UNTIL a > 0 AND a < 10
IF a = 9 THEN SYSTEM
 
PRINT
PRINT
PRINT "How difficult do you wish for this game to be?"
PRINT "1) Easy"
PRINT "2) Normal"
PRINT "3) Hard"
PRINT "4) Grueling"
DO
    _LIMIT 10
    b = VAL(INKEY$)
LOOP UNTIL b > 0 AND b < 5
 
PRINT
PRINT
PRINT "How long a game do you want?"
PRINT "1) Very Short"
PRINT "2) Short"
PRINT "3) Average"
PRINT "4) Long"
PRINT "5) Bring It On, Long!"
 
DO
    c = VAL(INKEY$)
LOOP UNTIL c > 0 AND c < 6
 
_FONT RST
CLS
LOCATE 7
DO: LOOP UNTIL INKEY$ = "" 'Clear the keyboard buffer
PRINT "<LEFT CLICK> TO BEGIN MATH FLASH CARDS!"
DO
    _LIMIT 10
    x = mouseclick
LOOP UNTIL x = 1
 
CLS
_FONT WF
mode = a: difficulty = b: length = c
END SUB
 
 
 
SUB DisplayTime
_FONT RST
COLOR White, Black
LOCATE 1, 1000: PRINT GameTime; "LEFT  "
_FONT WF
END SUB
 
SUB CountDown
GameTime = GameTime - 1
IF GameTime <= 0 THEN ShowResults 'Clock has ran out
 
END SUB
 
SUB ShowResults
Score = 0
_AUTODISPLAY
CLS , Black
_FONT 16
COLOR White, Black
PRINT "YOUR ANSWER"; TAB(40); "CORRECT ANSWER"
FOR i = 1 TO UBOUND(results)
    text$ = Num2Str(Results(i).num1)
    SELECT CASE Results(i).op
        CASE 1: text$ = text$ + " + "
        CASE 2: text$ = text$ + " - "
        CASE 3: text$ = text$ + " * "
        CASE 4: text$ = text$ + " / "
    END SELECT
 
    IF Results(i).correct = -1 THEN
        COLOR Green, Black
        Correct = Correct + 1
        YourText$ = text$ + Num2Str(Results(i).num2) + " = " + Num2Str(Results(i).answer)
    ELSE
        COLOR Red, Black
        Wrong = Wrong + 1
        IF Results(i).correct = 1 THEN
            YourText$ = text$ + Num2Str(Results(i).num2) + " = " + "SKIPPED"
        ELSE
            YourText$ = text$ + Num2Str(Results(i).num2) + " = " + Num2Str(Results(i).answer)
        END IF
    END IF
    CorrectText$ = text$ + Num2Str(Results(i).num2) + " = " + Num2Str(Results(i).num3)
    PRINT YourText$; TAB(40);
    COLOR White, Black
    PRINT CorrectText$
NEXT
PRINT
PRINT "You got "; Correct; " correct answers, and "; Wrong; " wrong."
PRINT "If this was a test, you would have scored "; INT(100 * (Correct / (i - 1))); "%"
ScoreMultiplier = 25 * Difficulty
Score = ScoreMultiplier * Correct + ScoreMultiplier * -Wrong
PRINT
PRINT
PRINT "YOUR GAME SCORE IS: "; Score
PRINT
SELECT CASE Difficulty
    CASE 1: file$ = "Easy.txt": diff$ = "EASY"
    CASE 2: file$ = "Average.txt": diff$ = "NORMAL"
    CASE 3: file$ = "Hard.txt": diff$ = "HARD"
    CASE 4: file$ = "Grueling.txt": diff$ = "GRUELING"
END SELECT
IF _FILEEXISTS(file$) THEN
    'life should be good as we have an existing file.
ELSE
    'if not, then let's make a blank highscore file for the proper difficulty.
    OPEN file$ FOR OUTPUT AS #1
    FOR i = 1 TO 25
        PRINT #1, "None"
        PRINT #1, 0
        PRINT #1, "None"
    NEXT
    CLOSE #1
END IF
OPEN file$ FOR INPUT AS #1
DIM person(25) AS STRING, score(25), diff$(25)
HS = 0 'no high score until we validate it
FOR i = 1 TO 25
    LINE INPUT #1, person(i)
    INPUT #1, score(i)
    LINE INPUT #1, diff$(i)
    IF Score > score(i) AND NOT HS THEN
        PRINT "CONGRATULATIONS!!  YOU GOT A HIGH SCORE!"
        PRINT "What name would you like to be known by? ";
        INPUT person$
        IF i < 25 THEN person(i + 1) = person(i): score(i + 1) = score(i): diff$(i + 1) = diff$(i)
        person(i) = person$: score(i) = Score: diff$(i) = diff$
        i = i + 1: HS = -1
    END IF
NEXT
CLOSE #1
 
PRINT "Press <ANY KEY> to see the "; diff$; " HIGH SCORES"
SLEEP
CLS
PRINT diff$; " HIGH SCORERS"
FOR i = 1 TO 25
    PRINT person(i); TAB(20); score(i); TAB(40); diff$(i)
NEXT
 
OPEN file$ FOR OUTPUT AS #1
FOR i = 1 TO 25
    PRINT #1, person(i)
    PRINT #1, score(i)
    PRINT #1, diff$(i)
NEXT
CLOSE
 
 
PRINT
PRINT "Do the test again? (Y/N)"
DO
    _LIMIT 10
    a$ = UCASE$(INKEY$)
LOOP UNTIL a$ = "Y" OR a$ = "N"
IF a$ = "Y" THEN
    SHELL _DONTWAIT "Untitled.exe"
END IF
_DELAY 1
SYSTEM
 
END SUB
 
SUB CheckAnswer (num1, op, num2, answer$)
ans = VAL(answer$)
SELECT CASE op
    CASE Plus: num3 = num1 + num2
    CASE Minus: num3 = num1 - num2
    CASE Times: num3 = num1 * num2
    CASE Divide: num3 = num1 / num2
END SELECT
QuestionsAsked = UBOUND(results) + 1
REDIM _PRESERVE Results(QuestionsAsked) AS ResultsType
Results(QuestionsAsked).num1 = num1
Results(QuestionsAsked).op = op
Results(QuestionsAsked).num2 = num2
Results(QuestionsAsked).num3 = num3
Results(QuestionsAsked).answer = ans
 
_FONT RST
COLOR White, Black
LOCATE 1, 1: PRINT "Last Answer:"
IF ans = num3 AND answer$ <> "" THEN
    Correct = Correct + 1
    GameTime = GameTime + 1 'A bonus to time for each correct answer
    COLOR Green, Black
    LOCATE 1, 400: PRINT "CORRECT!"
    Results(QuestionsAsked).correct = -1
ELSE
    Wrong = Wrong + 1
    GameTime = GameTime - 2 'A penalty to time for each wrong answer
    COLOR Red, Black
    LOCATE 1, 400: PRINT "WRONG!  "
    Results(QuestionsAsked).correct = 0
    IF answer$ = "" THEN Results(QuestionsAsked).correct = 1
END IF
COLOR White, Black
_FONT WF
DisplayTime
_DISPLAY
END SUB
 
 
SUB DisplayUserAnswer (answer$)
COLOR Black, White
LINE (700, 100)-(1100, 300), White, BF
top = 125
left = (400 - GetPrintWidth(answer$, WF)) / 2 + 700
_PRINTSTRING (left, top), answer$
END SUB
 
 
SUB GetUserAnswer (answer$)
done = 0: answer$ = ""
DO
    _LIMIT 30
    Button = mouseclick
    IF Button = 1 THEN 'We have a mouse click somewhere
        x = _MOUSEX: y = _MOUSEY
        IF y >= 400 AND y <= 600 THEN 'they clicked down where the numbers and OK button are
            num = 0
            IF x \ 100 = (x + 10) \ 100 THEN num = x \ 100 'they didn't click on the 10 pixel blank space between numbers
            IF num > 0 AND num < 12 THEN 'It's a click on either a number or the OK button on the top row
                IF num = 10 THEN num = 0
                IF num = 11 THEN
                    done = -1
                ELSE
                    answer$ = answer$ + LTRIM$(RTRIM$(STR$(num)))
                END IF
            END IF
        END IF
        IF y >= 610 AND y <= 710 AND x >= 100 AND x <= 1200 THEN done = -1 'Click on the bottom ENTER area
    END IF
    DisplayUserAnswer answer$
    DisplayTime
    _DISPLAY
LOOP UNTIL done
END SUB
 
 
 
SUB DrawUserClickAreas
FOR i = 1 TO 10
    left = 100 * i
    LINE (left, 400)-(left + 90, 600), Yellow, BF
    COLOR Black, 0
    _PRINTSTRING (left + 10, 425), Num2Str$(i MOD 10)
NEXT
LINE (100, 610)-(1200, 710), Green, BF
LINE (1100, 400)-(1200, 710), Green, BF
_PRINTSTRING (425, 595), "ENTER"
END SUB
 
 
 
SUB DrawCard (num1, operator, num2) 'Pass it our 3 numbers like 3, plus, 3 would be 3 + 3 = ?
COLOR Red, 0
LINE (100, 100)-(650, 300), White, BF
text$ = Num2Str(num1)
SELECT CASE operator
    CASE Plus: text$ = text$ + "+"
    CASE Minus: text$ = text$ + "-"
    CASE Times: text$ = text$ + "*"
    CASE Divide: text$ = text$ + "/"
END SELECT
text$ = text$ + Num2Str(num2) + "="
top = 125
left = (550 - GetPrintWidth(text$, WF)) / 2 + 100
_PRINTSTRING (left, top), text$
END SUB
 
FUNCTION Num2Str$ (num)
Num2Str$ = LTRIM$(RTRIM$(STR$(num)))
END FUNCTION
 
FUNCTION GetPrintWidth (text AS STRING, fonthandle)
w = _WIDTH: h = _HEIGHT
dc = _DEFAULTCOLOR: bg = _BACKGROUNDCOLOR
d = _DEST: s = _SOURCE
t = _NEWIMAGE(w, h, 32)
_DEST t: _SOURCE t
_FONT fonthandle
COLOR _RGB32(255, 0, 0), _RGB32(255, 255, 255)
PRINT text;
DIM m AS _MEM
m = _MEMIMAGE(t)
p = 0 'pointer
DO
    _MEMGET m, m.OFFSET + p, c 'Get our color
    p = p + 4 'increase 4 as we're working with 4-byte long values for RGBA color
    GetPrintWidth = GetPrintWidth + 1
LOOP UNTIL NOT c 'until we don't have no color no more
_MEMFREE m
_FREEIMAGE t
_DEST d: _SOURCE s
END FUNCTION
 
FUNCTION mouseclick%
DO WHILE _MOUSEINPUT 'check mouse status
    scroll% = scroll% + _MOUSEWHEEL ' if scrollwheel changes, watch the change here
    IF _MOUSEBUTTON(1) THEN 'left mouse pushed down
        speedup = 1
    ELSEIF _MOUSEBUTTON(2) THEN 'right mouse pushed down
        speedup = 2
    ELSEIF _MOUSEBUTTON(3) THEN 'middle mouse pushed down
        speedup = 3
    END IF
    IF speedup THEN 'buton was pushed down
        mouseclickxxx1% = _MOUSEX: mouseclickyyy1% = _MOUSEY 'see where button was pushed down at
        DO WHILE _MOUSEBUTTON(speedup) 'while button is down
            i% = _MOUSEINPUT
        LOOP 'finishes when button is let up
        IF mouseclickxxx1% >= _MOUSEX - 2 AND mouseclickxxx1% <= _MOUSEX + 2 AND mouseclickyyy1% >= _MOUSEY - 2 AND mouseclickyyy1% <= _MOUSEY + 2 THEN 'if mouse hasn't moved (ie  clicked down, dragged somewhere, then released)
            mouseclick% = speedup
        ELSE
            mouseclick% = 0
        END IF
    END IF
LOOP
IF scroll% < 0 THEN mouseclick% = 4
IF scroll% > 0 THEN mouseclick% = 5
END FUNCTION
 

A simple little game which kids can use to help them learn basic math. Does addition, subtraction, multiplication, and division.

Just copy and paste into the QB64 IDE, compile and you're good to go! :)

234

Programs / SHUFFLE (GL Version)

« on: July 28, 2017, 01:25:03 pm »

The very first thing I ever wrote and shared for [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] was my little Shuffle Game,back all the way in April 2012. Since then, it's been downloaded over 240 times! (WOW!!)

Only thing ism all those downloads were expecting the user to have the SDL version of QB64 to compile and run the program -- and QB64 swapped over to the GL version several years ago. Ergo, I now present a freshly patched up, compiled, and tested version which runs on works with QB64-GL!

Enjoy!!

https://www.dropbox.com/s/sfzazmv2qtah9ri/Shuffle%20%28GL%20Version%29.7z?dl=0

Note 1: My connection is too low to upload the file here, so the link above will give you a dropbox version which you can download and play around with instead.

Note 2: Linux/Mac users will need to change the location of the font files to point to where they'd be on their system before compiling.

Note 3: Be certain the EXE is in the main SHUFFLE directory with the BAS file before running. It needs to be there to find the sound and image files necessary to run properly, without tossing a thousand ERROR messages up on screen.

235

Programs / DBF conversion/use programs

« on: July 28, 2017, 12:18:03 pm »

Two programs here which might be useful for someone who needs to access data from a DBF file for use inside a QB64 program.

First, we have a simple program to change DBF files to CSV (Comma Separated Value) Text files:

Code: QB64: [Select]

'DBF to CSV text converter
 
'Program written by Steve McNeill @ 9/19/2012
 
'Code is free to use, abuse, modify, destroy, steal, copy, share, and alter in any way anyone wishes.
'Just be aware, I'm not responsible if it melts your computer, fries your brain, or makes you sing like a drunken sailor.
'Use is purely at your own risk, but it seems safe enough to me!
 
'All this does is convert old dbf files into a simple CSV text file, which can then be read into any program which you wish to use the data with.
'Your old files stay as they are, and it does nothing to them except read them and then give you a new, converted file to work with.
 
'change file$ and file1$ to the name of your DBF and new converted filename, respectively.
 
'No credit, cash, check, or money order needed for this.  Enjoy!!
 
REM $DYNAMIC
 
TYPE DBF_Header
    FileType AS _UNSIGNED _BYTE
    Year AS _UNSIGNED _BYTE
    Month AS _UNSIGNED _BYTE
    Day AS _UNSIGNED _BYTE
    RecordNumber AS _UNSIGNED LONG
    FirstRecord AS _UNSIGNED INTEGER
    RecordLength AS _UNSIGNED INTEGER
    ReservedJunk AS STRING * 16
    TableFlag AS _UNSIGNED _BYTE
    CodePageMark AS _UNSIGNED _BYTE
    ReservedJunk1 AS STRING * 2
END TYPE
 
TYPE Field_Subrecord
    FieldName AS STRING * 11
    FieldType AS STRING * 1
    Displacement AS _UNSIGNED LONG
    FieldLength AS _UNSIGNED _BYTE
    FieldDecimal AS _UNSIGNED _BYTE
    FieldFlags AS _UNSIGNED _BYTE
    AutoNext AS _UNSIGNED LONG
    AutoStep AS _UNSIGNED _BYTE
    ReservedJunk AS STRING * 8
END TYPE
 
TYPE DBF_HeaderTerminator
    EndCode AS _UNSIGNED _BYTE 'Our End of Field Code is a CHR$(13), or 13 if we read it as a byte
END TYPE
 
TYPE DBF_VFPInfo
    Info AS STRING * 263
END TYPE
 
DIM DataH AS DBF_Header
DIM DataFS(1) AS Field_Subrecord
DIM DataHT AS DBF_HeaderTerminator
DIM DataVFP AS DBF_VFPInfo
 
file$ = ".\tempdata.dbf"
file2$ = ".\converted.txt"
 
Get_Header file$, DataH
'Display_Header DataH
Get_Fields file$, DataFS()
'Display_Fields DataFS()
Print_Data file$, DataH, DataFS(), file2$
PRINT "Your file has been converted."
PRINT "The original file was: "; file$
PRINT "The converted file is: "; file2$
 
END
 
 
SUB Display_Header (DataH AS DBF_Header)
PRINT "Data File Type: ";
SELECT CASE DataH.FileType
    CASE 2: PRINT "FoxBASE"
    CASE 3: PRINT "FoxBASE+/Dbase III plus, no memo"
    CASE 48: PRINT "Visual FoxPro"
    CASE 49: PRINT "Visual FoxPro, autoincrement enabled"
    CASE 50: PRINT "Visual FoxPro with field type Varchar or Varbinary"
    CASE 67: PRINT "dBASE IV SQL table files, no memo"
    CASE 99: PRINT "dBASE IV SQL system files, no memo"
    CASE 131: PRINT "FoxBASE+/dBASE III PLUS, with memo"
    CASE 139: PRINT "dBASE IV with memo"
    CASE 203: PRINT "dBASE IV SQL table files, with memo"
    CASE 229: PRINT "HiPer-Six format with SMT memo file"
    CASE 245: PRINT "FoxPro 2.x (or earlier) with memo"
    CASE 251: PRINT "FoxBASE"
    CASE ELSE: PRINT "Unknown File Type"
END SELECT
PRINT "Date: "; DataH.Month; "/"; DataH.Day; "/"; DataH.Year
PRINT "Number of Records: "; DataH.RecordNumber
PRINT "First Record: "; DataH.FirstRecord
PRINT "Record Length: "; DataH.RecordLength
PRINT "Reserved Junk: "; DataH.ReservedJunk
PRINT "Table Flags: ";
none = 0
IF DataH.TableFlag AND 1 THEN PRINT "file has a structural .cdx ";: none = -1
IF DataH.TableFlag AND 2 THEN PRINT "file has a Memo field ";: none = -1
IF DataH.TableFlag AND 4 THEN PRINT "file is a database (.dbc) ";: none = -1
IF none THEN PRINT ELSE PRINT "None"
PRINT "Code Page Mark: "; DataH.CodePageMark
PRINT "Reserved Junk: "; DataH.ReservedJunk1
END SUB
 
SUB Display_Fields (DataH() AS Field_Subrecord)
FOR r = 1 TO UBOUND(DataH)
    PRINT "Field Name :"; DataH(r).FieldName
    PRINT "Field Type :"; DataH(r).FieldType
    PRINT "Field Displacement :"; DataH(r).Displacement
    PRINT "Field Length :"; DataH(r).FieldLength
    PRINT "Field Decimal :"; DataH(r).FieldDecimal
    PRINT "Field Flags :"; DataH(r).FieldFlags
    PRINT "Field AutoNext :"; DataH(r).AutoNext
    PRINT "Field SutoStep :"; DataH(r).AutoStep
    PRINT "Field Reserved Junk :"; DataH(r).ReservedJunk
    SLEEP
    PRINT "**************************"
NEXT
END SUB
 
SUB Get_Header (file$, DataH AS DBF_Header)
OPEN file$ FOR BINARY AS #1 LEN = LEN(DataH)
GET #1, 1, DataH
CLOSE
END SUB
 
SUB Get_Fields (file$, DataH() AS Field_Subrecord)
DIM databyte AS _UNSIGNED _BYTE
DIM temp AS Field_Subrecord
OPEN file$ FOR BINARY AS #1 LEN = 1
counter = -1: s = 33
DO
    counter = counter + 1
    GET #1, s, databyte
    s = s + 32
LOOP UNTIL databyte = 13
REDIM DataH(counter) AS Field_Subrecord
IF counter < 1 THEN BEEP: BEEP: PRINT "Database has no file records.": END
CLOSE
OPEN file$ FOR BINARY AS #1 LEN = 32
FOR r = 1 TO counter
    GET #1, 32 * r + 1, DataH(r) 'record 1 is our header info, so we need to start our field info at record 2
NEXT
 
CLOSE
END SUB
 
SUB Print_Data (file$, DataH AS DBF_Header, DataFS() AS Field_Subrecord, file2$)
DIM databyte AS _UNSIGNED _BYTE
OPEN file$ FOR BINARY AS #1
OPEN file2$ FOR OUTPUT AS #2
SEEK #1, DataH.FirstRecord + 1
DO
    GET #1, , databyte 'This is the first byte which tells us if the record is good, or has been deleted.
    IF databyte = 32 THEN WRITE #2, "Good Record", ELSE WRITE #2, "Deleted Record",
    FOR i = 1 TO UBOUND(DataFS)
        SELECT CASE DataFS(i).FieldType
            CASE "C", "0"
                'C is for Characters, or basically STRING characters.
                '0 is for Null Flags, which I have no clue what they're for.  I'm basically reading them here as worthless characters until I learn otherwise.
                temp$ = ""
                FOR j = 1 TO DataFS(i).FieldLength
                    GET #1, , databyte
                    temp$ = temp$ + CHR$(databyte)
                NEXT
            CASE "Y"
                'Y is for currency, which is an _INTEGER 64, with an implied 4 spaces for decimal built in.
                REDIM temp AS _INTEGER64
                GET #1, , temp
                temp$ = STR$(temp)
                l = LEN(temp$)
                temp$ = LEFT$(temp$, l - 4) + "." + RIGHT$(temp$, 4)
            CASE "N", "F", "M", "G"
                'N is for numberic, F is for Floating numbers, and both seem to work in the same manner.
                'M is for Memo's, which are stored in a different  DBT file.  What we have here is the block number of the memo location in that file, stored as a simple set of characters.
                'G is for OLE files.  We store the info for it just the same as we do for a Memo.
                'we read the whole thing as a string, which is an odd way for dBase to write it, but I don't make the rules.  I just convert them!
                temp$ = ""
                FOR j = 1 TO DataFS(i).FieldLength
                    GET #1, , databyte
                    temp$ = temp$ + CHR$(databyte)
                NEXT
            CASE "D"
                'D is for Date fields.
                'Dates are stored as a string, in the format YYYYMMDD
                temp$ = ""
                FOR j = 1 TO DataFS(i).FieldLength
                    GET #1, , databyte
                    temp$ = temp$ + CHR$(databyte)
                NEXT
                year$ = LEFT$(temp$, 4)
                month$ = MID$(temp$, 5, 2)
                day$ = RIGHT$(temp$, 2)
                temp$ = day$ + "/" + month$ + "/" + year$
            CASE "L"
                'L is our logical operator.  Basically, it's simply True or False Boolean logic
                GET #1, , databyte
                IF databyte = 32 THEN temp$ = "True" ELSE temp$ = "false"
            CASE "@", "O"
                '@ are Timestamps, which I'm too lazy to fully support at the moment.
                'They are 8 bytes - two longs, first for date, second for time.
                'The date is the number of days since  01/01/4713 BC.
                'Time is hours * 3600000L + minutes * 60000L + Seconds * 1000L
                'All I'm going to do is read both longs as a single _Integer64 and then write that data to the disk.
                'Be certain to convert it as needed to make use of the Timestamp.
                'I'm just lazy and don't wanna convert anything right now!  :P
 
                'O are double long integers -- basically Integer 64s.  Since I'm reading a timestamp as an Int64, this routine works for them as well.
                REDIM temp1 AS _INTEGER64
                GET #1, , temp1
                temp$ = STR$(temp1)
            CASE "I", "+"
                'Long Integers.  Basically 4 byte numbers
                '+ are auto-increments.  Stored the same way as a Long.
                REDIM temp2 AS LONG
                GET #1, , temp2
                temp$ = STR$(temp2)
        END SELECT
        IF i = UBOUND(datafs) THEN WRITE #2, temp$ ELSE WRITE #2, temp$,
    NEXT
LOOP UNTIL EOF(1)
CLOSE
END SUB

Useage here is simple:
1) Download the file below and put it in your QB64 folder
2) copy and paste the code above into your QB64 IDE.
3) compile and run
4) Enjoy looking at the "converted.txt" file which we created in that same folder, which now has all the DATA in that DBF file converted over to CSV TXT for ease of use in QB64 (or any other program which you might need it for).

236

Programs / Epub book creation program

« on: July 28, 2017, 11:59:48 am »

A demo of something a little different from most of the things other people like to post, this one is an illustration of using QB64 to create an EPUB-formatted ebook.

Code: QB64: [Select]

DIM SHARED Id$ 'The unique identifier used for our book, to be created automagically.
 
 
_TITLE "Epub Creation Demo"
'We'll need some content to use for our book.
'For this, we're going to store some information in a few diffent arrays.
'The first array will be for the Chapters (or Pages) for the book.
'the next array will be for the information in those chapters.
'I'm making these redimable at this point so that someone could alter them to suit their needs as required.
REDIM SHARED Chapters(0) AS STRING
REDIM SHARED Content(0) AS STRING
'Now, let's toss some actual information into these Chapters.
REDIM Chapters(2) AS STRING 'a good number for a demo
'This information just names our chapters and helps set the order by which we'd go to them.
Chapters(0) = "Title Page"
Chapters(1) = "Chapter One"
Chapters(2) = "Chapter Two"
 
'And since we have a the chapters, let's toss something in them so they're not just blank...
REDIM Content(2) AS STRING
Content(0) = "Steve's Epub Demo Book!"
Content(1) = "This is the Steve Demo for Epub creation!"
Content(2) = "If you study it carefully, you'll see that it's not actually that hard to create or use EPUB files." + CHR$(13) + CHR$(10) + "This page is a quick demo of how we'd write more than a single line onto a page, and this is also quite a long line of text itself so that it will hopefully auto-wrap and auto-format itself to illustrate that we don't usually have to worry about such things manually -- that should be the job of our E-reader!"
 
 
'Some optional content we can toss into our book if we want.
'I'm going to include it here, but it can be stripped out if wanted.
DIM SHARED Author$: Author$ = "Steve McNeill"
DIM SHARED Language$: Language$ = "en"
DIM SHARED Rights$: Rights$ = "Public Domain"
DIM SHARED Publisher$: Publisher$ = "Nobody, Nowhere"
 
 
'So now we can actually make the book
 
MakeEpub "Steve Book" 'notice I didn't actually add the .epub extension here.  We just need the book title
 
 
 
SUB MakeEpub (book$)
'First we check to make the main folders for our book
'and the basic files which define our folder structure
result = MakeFolders(book$)
IF result = 0 THEN EXIT SUB
'then we have to create our  content file
MakeContent book$
MakeToC book$
MakeXPGT book$
MakeCSS book$
MakeChapters book$
END SUB
 
 
SUB MakeChapters (book$)
'And here we write our actual content to our files.
FOR i = 0 TO UBOUND(chapters)
    OPEN book$ + "\OEBPS\Text\" + Chapters(i) + ".xhtml" FOR OUTPUT AS #1
    PRINT #1, "<?xml version="; CHR$(34); "1.0"; CHR$(34); " encoding="; CHR$(34); "utf-8"; CHR$(34); "?>"
    PRINT #1, "<!DOCTYPE html PUBLIC "; CHR$(34); "-//W3C//DTD XHTML 1.1//EN"; CHR$(34); ""
    PRINT #1, "  "; CHR$(34); "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"; CHR$(34); ">"
    PRINT #1, ""
    PRINT #1, "<html xmlns="; CHR$(34); "http://www.w3.org/1999/xhtml"; CHR$(34); ">"
    PRINT #1, "<head>"
    PRINT #1, "  <title>Chapter 1</title>"
    PRINT #1, "  <link rel="; CHR$(34); "stylesheet"; CHR$(34); " href="; CHR$(34); "../Styles/stylesheet.css"; CHR$(34); " type="; CHR$(34); "text/css"; CHR$(34); " />"
    PRINT #1, "  <link rel="; CHR$(34); "stylesheet"; CHR$(34); " type="; CHR$(34); "application/vnd.adobe-page-template+xml"; CHR$(34); " href="; CHR$(34); "../Styles/page-template.xpgt"; CHR$(34); " />"
    PRINT #1, "</head>"
    PRINT #1, ""
    PRINT #1, "<body>"
    PRINT #1, ""
    PRINT #1, "  <div>"
    PRINT #1, "    <h3 id="; CHR$(34); "heading_id_2"; CHR$(34); ">"; Chapters(i); "</h3>"
    PRINT #1, ""
    PRINT #1, "    <p>"; Content(i); "</p>"
    PRINT #1, "  </div>"
    PRINT #1, "</body>"
    PRINT #1, "</html>"
    CLOSE #1
 
NEXT
END SUB
 
 
SUB MakeCSS (book$)
'Nothing more than a style sheet to format our pages and such.
'I'm just going to make this one about as simple as we can and center our stuff on the page.
OPEN book$ + "\OEBPS\Styles\stylesheet.css" FOR OUTPUT AS #1
PRINT #1, "/* Style Sheet */"
PRINT #1, "/* This defines styles and classes used in the book */"
PRINT #1, "body { margin-left: 5%; margin-right: 5%; margin-top: 5%; margin-bottom: 5%; text-align: justify; }"
PRINT #1, "pre { font-size: x-small; }"
PRINT #1, "h1 { text-align: center; }"
PRINT #1, "h2 { text-align: center; }"
PRINT #1, "h3 { text-align: center; }"
PRINT #1, "h4 { text-align: center; }"
PRINT #1, "h5 { text-align: center; }"
PRINT #1, "h6 { text-align: center; }"
PRINT #1, ".CI {"
PRINT #1, "    text-align:center;"
PRINT #1, "    margin-top:0px;"
PRINT #1, "    margin-bottom:0px;"
PRINT #1, "    padding:0px;"
PRINT #1, "    }"
PRINT #1, ".center   {text-align: center;}"
PRINT #1, ".smcap    {font-variant: small-caps;}"
PRINT #1, ".u        {text-decoration: underline;}"
PRINT #1, ".bold     {font-weight: bold;}"
CLOSE #1
END SUB
 
SUB MakeXPGT (book$)
'page-template.xpgt
'This file isn't part of the IDPF spec, but Adobe Digital Editions uses it for formatting
'and setting column settings and whatnot.
'You don't need this file at all, but your book will look nicer in Digital Editions if you include it.
'Other readers should just ignore it.
OPEN book$ + "\OEBPS\Styles\page-template.xpgt" FOR OUTPUT AS #1
PRINT #1, "<ade:template xmlns="; CHR$(34); "http://www.w3.org/1999/xhtml"; CHR$(34); " xmlns:ade="; CHR$(34); "http://ns.adobe.com/2006/ade"; CHR$(34); ""
PRINT #1, "         xmlns:fo="; CHR$(34); "http://www.w3.org/1999/XSL/Format"; CHR$(34); ">"
PRINT #1, ""
PRINT #1, "  <fo:layout-master-set>"
PRINT #1, "   <fo:simple-page-master master-name="; CHR$(34); "single_column"; CHR$(34); ">"
PRINT #1, "        <fo:region-body margin-bottom="; CHR$(34); "3pt"; CHR$(34); " margin-top="; CHR$(34); "0.5em"; CHR$(34); " margin-left="; CHR$(34); "3pt"; CHR$(34); " margin-right="; CHR$(34); "3pt"; CHR$(34); "/>"
PRINT #1, "    </fo:simple-page-master>"
PRINT #1, ""
PRINT #1, "    <fo:simple-page-master master-name="; CHR$(34); "single_column_head"; CHR$(34); ">"
PRINT #1, "        <fo:region-before extent="; CHR$(34); "8.3em"; CHR$(34); "/>"
PRINT #1, "        <fo:region-body margin-bottom="; CHR$(34); "3pt"; CHR$(34); " margin-top="; CHR$(34); "6em"; CHR$(34); " margin-left="; CHR$(34); "3pt"; CHR$(34); " margin-right="; CHR$(34); "3pt"; CHR$(34); "/>"
PRINT #1, "    </fo:simple-page-master>"
PRINT #1, ""
PRINT #1, "    <fo:simple-page-master master-name="; CHR$(34); "two_column"; CHR$(34); " margin-bottom="; CHR$(34); "0.5em"; CHR$(34); " margin-top="; CHR$(34); "0.5em"; CHR$(34); " margin-left="; CHR$(34); "0.5em"; CHR$(34); " margin-right="; CHR$(34); "0.5em"; CHR$(34); ">"
PRINT #1, "        <fo:region-body column-count="; CHR$(34); "2"; CHR$(34); " column-gap="; CHR$(34); "10pt"; CHR$(34); "/>"
PRINT #1, "    </fo:simple-page-master>"
PRINT #1, ""
PRINT #1, "    <fo:simple-page-master master-name="; CHR$(34); "two_column_head"; CHR$(34); " margin-bottom="; CHR$(34); "0.5em"; CHR$(34); " margin-left="; CHR$(34); "0.5em"; CHR$(34); " margin-right="; CHR$(34); "0.5em"; CHR$(34); ">"
PRINT #1, "        <fo:region-before extent="; CHR$(34); "8.3em"; CHR$(34); "/>"
PRINT #1, "        <fo:region-body column-count="; CHR$(34); "2"; CHR$(34); " margin-top="; CHR$(34); "6em"; CHR$(34); " column-gap="; CHR$(34); "10pt"; CHR$(34); "/>"
PRINT #1, "    </fo:simple-page-master>"
PRINT #1, ""
PRINT #1, "    <fo:simple-page-master master-name="; CHR$(34); "three_column"; CHR$(34); " margin-bottom="; CHR$(34); "0.5em"; CHR$(34); " margin-top="; CHR$(34); "0.5em"; CHR$(34); " margin-left="; CHR$(34); "0.5em"; CHR$(34); " margin-right="; CHR$(34); "0.5em"; CHR$(34); ">"
PRINT #1, "        <fo:region-body column-count="; CHR$(34); "3"; CHR$(34); " column-gap="; CHR$(34); "10pt"; CHR$(34); "/>"
PRINT #1, "    </fo:simple-page-master>"
PRINT #1, ""
PRINT #1, "    <fo:simple-page-master master-name="; CHR$(34); "three_column_head"; CHR$(34); " margin-bottom="; CHR$(34); "0.5em"; CHR$(34); " margin-top="; CHR$(34); "0.5em"; CHR$(34); " margin-left="; CHR$(34); "0.5em"; CHR$(34); " margin-right="; CHR$(34); "0.5em"; CHR$(34); ">"
PRINT #1, "        <fo:region-before extent="; CHR$(34); "8.3em"; CHR$(34); "/>"
PRINT #1, "        <fo:region-body column-count="; CHR$(34); "3"; CHR$(34); " margin-top="; CHR$(34); "6em"; CHR$(34); " column-gap="; CHR$(34); "10pt"; CHR$(34); "/>"
PRINT #1, "    </fo:simple-page-master>"
PRINT #1, ""
PRINT #1, "    <fo:page-sequence-master>"
PRINT #1, "        <fo:repeatable-page-master-alternatives>"
PRINT #1, "            <fo:conditional-page-master-reference master-reference="; CHR$(34); "three_column_head"; CHR$(34); " page-position="; CHR$(34); "first"; CHR$(34); " ade:min-page-width="; CHR$(34); "80em"; CHR$(34); "/>"
PRINT #1, "            <fo:conditional-page-master-reference master-reference="; CHR$(34); "three_column"; CHR$(34); " ade:min-page-width="; CHR$(34); "80em"; CHR$(34); "/>"
PRINT #1, "            <fo:conditional-page-master-reference master-reference="; CHR$(34); "two_column_head"; CHR$(34); " page-position="; CHR$(34); "first"; CHR$(34); " ade:min-page-width="; CHR$(34); "50em"; CHR$(34); "/>"
PRINT #1, "            <fo:conditional-page-master-reference master-reference="; CHR$(34); "two_column"; CHR$(34); " ade:min-page-width="; CHR$(34); "50em"; CHR$(34); "/>"
PRINT #1, "            <fo:conditional-page-master-reference master-reference="; CHR$(34); "single_column_head"; CHR$(34); " page-position="; CHR$(34); "first"; CHR$(34); " />"
PRINT #1, "            <fo:conditional-page-master-reference master-reference="; CHR$(34); "single_column"; CHR$(34); "/>"
PRINT #1, "        </fo:repeatable-page-master-alternatives>"
PRINT #1, "    </fo:page-sequence-master>"
PRINT #1, ""
PRINT #1, "  </fo:layout-master-set>"
PRINT #1, ""
PRINT #1, "  <ade:style>"
PRINT #1, "    <ade:styling-rule selector="; CHR$(34); ".title_box"; CHR$(34); " display="; CHR$(34); "adobe-other-region"; CHR$(34); " adobe-region="; CHR$(34); "xsl-region-before"; CHR$(34); "/>"
PRINT #1, "  </ade:style>"
PRINT #1, ""
PRINT #1, "</ade:template>"
CLOSE #1
 
END SUB
 
 
SUB MakeToC (book$)
'this is the table of Contents for our book.
'Note that not all e-readers will use (or even look for) this file.
'For those that do, it makes us a nice little table of contents at the front of our book
'for ease of navigation and jumping to different chapters.
OPEN book$ + "\OEBPS\toc.ncx" FOR OUTPUT AS #1
 
PRINT #1, "<?xml version="; CHR$(34); "1.0"; CHR$(34); " encoding="; CHR$(34); "UTF-8"; CHR$(34); "?>"
PRINT #1, "<ncx xmlns="; CHR$(34); "http://www.daisy.org/z3986/2005/ncx/"; CHR$(34); " version="; CHR$(34); "2005-1"; CHR$(34); ">"
PRINT #1, ""
PRINT #1, "<head>"
PRINT #1, "    <meta name="; CHR$(34); "dtb:uid"; CHR$(34); " content="; CHR$(34); Id$; CHR$(34); "/>"
PRINT #1, "    <meta name="; CHR$(34); "dtb:depth"; CHR$(34); " content="; CHR$(34); LTRIM$(STR$(UBOUND(chapters) + 1)); CHR$(34); "/>"
PRINT #1, "    <meta name="; CHR$(34); "dtb:totalPageCount"; CHR$(34); " content="; CHR$(34); "0"; CHR$(34); "/>"
PRINT #1, "    <meta name="; CHR$(34); "dtb:maxPageNumber"; CHR$(34); " content="; CHR$(34); "0"; CHR$(34); "/>"
PRINT #1, "</head>"
PRINT #1, ""
PRINT #1, "<docTitle>"
PRINT #1, "    <text>"; book$; "</text>"
PRINT #1, "</docTitle>"
PRINT #1, ""
PRINT #1, "<navMap>"
FOR i = 0 TO UBOUND(chapters)
    PRINT #1, "    <navPoint id="; CHR$(34); "navPoint-"; LTRIM$(STR$(i + 1)); CHR$(34); " playOrder="; CHR$(34); LTRIM$(STR$(i + 1)); CHR$(34); ">"
    PRINT #1, "        <navLabel>"
    PRINT #1, "            <text>"; Chapters(i); "</text>"
    PRINT #1, "        </navLabel>"
    PRINT #1, "        <content src="; CHR$(34); "Text/"; Chapters(i); ".xhtml"; CHR$(34); "/>"
    PRINT #1, "    </navPoint>"
NEXT
PRINT #1, "</navMap>"
PRINT #1, "</ncx>"
CLOSE #1
END SUB
 
 
SUB MakeContent (book$)
'This file gives a list of all files in the .epub container, defines the order of files,
'and stores meta data (author, genre, publisher, etc.) information.
OPEN book$ + "\OEBPS\content.opf" FOR OUTPUT AS #1
PRINT #1, "<?xml version="; CHR$(34); "1.0"; CHR$(34); " encoding="; CHR$(34); "UTF-8"; CHR$(34); "?>"
PRINT #1, "<package xmlns="; CHR$(34); "http://www.idpf.org/2007/opf"; CHR$(34); " unique-identifier="; CHR$(34); "BookID"; CHR$(34); " version="; CHR$(34); "2.0"; CHR$(34); " >"
PRINT #1, "    <metadata xmlns:dc="; CHR$(34); "http://purl.org/dc/elements/1.1/"; CHR$(34); " xmlns:opf="; CHR$(34); "http://www.idpf.org/2007/opf"; CHR$(34); ">"
PRINT #1, "        <dc:title>"; book$; "</dc:title>"
PRINT #1, "        <dc:language>"; Language$; "</dc:language>"
'PRINT #1, "        <dc:rights>"; Rights$; "</dc:rights>"
'PRINT #1, "        <dc:creator opf:role="; CHR$(34); "aut"; CHR$(34); ">"; Author$; "</dc:creator>"
'PRINT #1, "        <dc:publisher>"; Publisher$; "</dc:publisher>"
'Now for the next part here, each book needs to have an unique identifier.
'To keep this simple, I'm going to name these books after QB64 with a date and time included
Id$ = "QB64Ebook" + DATE$ + LTRIM$(STR$(TIMER))
PRINT #1, "        <dc:identifier id="; CHR$(34); "BookID"; CHR$(34); " opf:scheme="; CHR$(34); "UUID"; CHR$(34); ">"; Id$; "</dc:identifier>"
PRINT #1, "    </metadata>"
 
'Next comes the manifest. This is just a listing of the files in the .epub container, and their file type.
'Each item is also assigned an item ID that's used in the spine section of content.opf.
'This list does not have to be in any particular order.
'(But you'll be happier if it is.)
'Also, see the section below on the NCX file for more information on the id attribute.
PRINT #1, "    <manifest>"
'And now we identify the types of files which we're using in the book
PRINT #1, "        <item id="; CHR$(34); "ncx"; CHR$(34); " href="; CHR$(34); "toc.ncx"; CHR$(34); " media-type="; CHR$(34); "application/x-dtbncx+xml"; CHR$(34); " />"
PRINT #1, "        <item id="; CHR$(34); "style"; CHR$(34); " href="; CHR$(34); "Styles/stylesheet.css"; CHR$(34); " media-type="; CHR$(34); "text/css"; CHR$(34); " />"
PRINT #1, "        <item id="; CHR$(34); "pagetemplate"; CHR$(34); " href="; CHR$(34); "Styles/page-template.xpgt"; CHR$(34); " media-type="; CHR$(34); "application/vnd.adobe-page-template+xml"; CHR$(34); " />"
FOR i = 0 TO UBOUND(chapters)
    PRINT #1, "        <item id="; CHR$(34); Chapters(i); CHR$(34); " href="; CHR$(34); "Text/"; Chapters(i); ".xhtml"; CHR$(34); " media-type="; CHR$(34); "application/xhtml+xml"; CHR$(34); " />"
NEXT
'If we included any images (which should be PNG format and thus not easily exported in QB64-GL edition yet
'They would basically be included as the following format
'        <item id="imgl" href="images/sample.png" media-type="image/png" />
PRINT #1, "    </manifest>"
 
'Since we've now identified the page types, let's tell whatever E-Reader we're using
'the proper order to read the pages/chapters in.
'The spine section lists the reading order of the contents.
'The spine doesn't have to list every file in the manifest, just the reading order.
'For example, if the manifest lists images, they do not have to be listed in the spine, and in fact, can't be.
'Only content (i.e. the XHTML files) can be listed here.
 
 
PRINT #1, "    <spine toc="; CHR$(34); "ncx"; CHR$(34); ">"
FOR i = 0 TO UBOUND(chapters)
    PRINT #1, "        <itemref idref="; CHR$(34); Chapters(i); CHR$(34); " />"
NEXT
PRINT #1, "    </spine>"
PRINT #1, "</package>"
CLOSE #1
'And at this point we should now have our table of contents and such written so we now know the proper order
'to read our book in.  ;)
END SUB
 
 
FUNCTION MakeFolders (mainfolder$)
'Returns a 0 if we fail, -1 if we succeed.
'This should create our main folder structure, and write the basic files needed for EPUB support.
'This will create the mimetype and container.xml files for us since they shouldn't change
'and are mainly used to help our OS know where and what type of folders we're using for EPUB format.
IF NOT _DIREXISTS(mainfolder$) THEN
    MKDIR mainfolder$
    CHDIR mainfolder$
    MKDIR "META-INF" + "\"
    MKDIR "OEBPS"
    MKDIR "OEBPS\images"
    MKDIR "OEBPS\Styles"
    MKDIR "OEBPS\Text"
    CHDIR "..\"
ELSE
    PRINT "Warning: Directory already exists.  Using this name will overwrite or alter existing files inside this folder.  Do you wish to proceed? (Y/N)"
    DO
        i$ = UCASE$(INKEY$)
        IF i$ = "N" THEN MakeFolders = 0: EXIT SUB
    LOOP UNTIL i$ = "Y"
END IF
p$ = mainfolder$ + "\"
OPEN p$ + "mimetype" FOR OUTPUT AS #1
PRINT #1, "application/epub+zip"
CLOSE #1
OPEN p$ + "META-INF\container.xml" FOR OUTPUT AS #1
PRINT #1, "<?xml version="; CHR$(34); "1.0"; CHR$(34); "?>"
PRINT #1, "<container version="; CHR$(34); "1.0"; CHR$(34); " xmlns="; CHR$(34); "urn:oasis:names:tc:opendocument:xmlns:container"; CHR$(34); ">"
PRINT #1, "    <rootfiles>"
PRINT #1, "         <rootfile full-path="; CHR$(34); "OEBPS/content.opf"; CHR$(34); " media-type="; CHR$(34); "application/oebps-package+xml"; CHR$(34); "/>"
PRINT #1, "    </rootfiles>"
PRINT #1, "</container>"
CLOSE #1
MakeFolders = -1
END SUB
 

Usage here is easy enough:
1) compile and run to create a folder called "Steve Book"
2) use whatever ZIP program you have on your machine to zip that folder up and give it a EPUB extension instead of a ZIP extension.

Note that I didn't bother to even try to have the program do step two for us, as QB64 doesn't come packaged with any sort of specific ZIP compression toolset. In the SDL version, I would've used zlib1.dll, which comes packaged with SDL for use with PNG files, to handle the process, but the GL version doesn't come prepacked with any compression tools. Since there's a ton of utilities to zip up files and folders out there (winrar, 7z, winzip, countless others), I'm not going to try and even guess what an user has installed on their machine.

EPUB files are just glorified ZIP files with a different extension to them (Don't believe it? Just rename a few sometime and then look at their contents.), so this program simply makes all the necessary files for an EPUB format ebook and leaves it up to the end-user to finish the process by compressing and renaming the ZIP to EPUB for themselves.

Try it out, have fun, and let me know if you have any questions about any part of the process.

237

Programs / Steve's Poker Playhouse

« on: July 27, 2017, 09:45:51 am »

It's a solo game of poker. What more could you want?

Extract, compile, run. ;)

238

Programs / File Listing

« on: July 27, 2017, 09:00:57 am »

Lots of folks like to ask for a way to easily grab the contents of a directory and import a list of the contents of that directory into their programs, so for them, I introduce my little File Grab Library.

Code: QB64: [Select]

'$INCLUDE:'Filegrab.BI'
 
REDIM Results(0) AS STRING
SCREEN _NEWIMAGE(1280, 720, 32)
 
SelectFile _CWD$, "*.*", Results()
FOR i = 1 TO UBOUND(results)
    PRINT Results(i)
NEXT
 
 
'$INCLUDE:'Filegrab.BM'

As you can see, usage is fairly straight forward.
Extract to your QB64 folder.
Include the header.
Include the footer.
REDIM an array to hold the results.
Call the routine with SelectFile _CWD$, "*.*", Results(),

SelectFile is the name of the routine.
First Parameter _CWD$ can be replaced with whatever directory you want the contents of.
Second Parameter "*.*" is the filter of whatever you want for that directory. Use "*.txt" for a listing of all text files, for example.
Third Parameter Results() is the REDIM array which you use to store the results of the file listing.

Works on Windows, Linux, and Mac.

239

Programs / SaveImage

« on: July 27, 2017, 08:43:57 am »

Since [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] is down, and nobody knows when it might be back up, I thought I'd take time to post some useful little routines on the forums here so people can find and make use of them.

First up is my SaveImage library.

Inside is a couple of quick demos which illustrate how to save a QB64 screen image in either BMP or PNG format, how one can easily turn a text screen into a 256 color graphic screen with one simple command, and how to compress and inflate strings or programs quickly and easily.

Commands should be simple enough that everyone can figure them out without any real effort involved.

To Deflate/Inflate a string/file:

Code: QB64: [Select]

'$include:'saveimage.bi'
text$ = "Whatever the heck it is that we might want to compress, be that a long string of input, a binary file (just load the whole file into a single string and then deflate it), or whatever else is wanted)."
de$ = Deflate(text$) ' <-- This is how simple it is to deflate the string
t$ = Inflate(de$) '  <-- This is how simple it is to inflate that deflated string
'$include:'saveimage.bm'

To turn a text screen into a graphic screen:

Code: QB64: [Select]

'$include:'saveimage.bi'
PRINT "Hello World.  This is a SCREEN 0 screen which I'm printing on."
x = TextScreenToImage256(0) 'And a quick example of how to turn a text screen into a 256 color image screen
SCREEN x 'swap screens
CIRCLE (320, 240), 100, 40 'And draw a circle on it
LOCATE 2,1: PRINT "And now it's been converted to a 256 color graphical screen.  See the circle on it??"
'$include:'saveimage.bm'
 

To save an image (from any QB64 screen mode -- even SCREEN 0 text screens work!):

Code: QB64: [Select]

'$Include:'SaveImage.BI'
SCREEN _NEWIMAGE(1280, 720, 32)
InitialImage$ = "Volcano Logo.jpg"
exportimage1$ = "testimage.png"
exportimage2$ = "testimage.bmp"
 
 
l& = _LOADIMAGE(InitialImage$)
_PUTIMAGE , l& 'And this line
 
Result = SaveImage(exportimage1$, 0, 0, 0, _WIDTH, _HEIGHT)
IF Result = 1 THEN 'file already found on drive
    KILL exportimage1$ 'delete the old file
    Result = SaveImage(exportimage1$, 0, 0, 0, _WIDTH, _HEIGHT) 'save the new one again
END IF
PRINT Result
PRINT "Our initial Image"
IF Result < 0 THEN PRINT "Successful PNG export" ELSE PRINT "PNG Export failed.": ' END
 
SLEEP
 
 
Result = SaveImage(exportimage2$, 0, 0, 0, _WIDTH, _HEIGHT)
IF Result = 1 THEN 'file already found on drive
    KILL exportimage2$ 'delete the old file
    Result = SaveImage(exportimage2$, 0, 0, 0, _WIDTH, _HEIGHT) 'save the new one again
END IF
PRINT Result
PRINT "Our initial Image"
IF Result < 0 THEN PRINT "Successful BMP export" ELSE PRINT "BMP Export failed.": END
 
SLEEP
 
 
 
 
CLS
zz& = _LOADIMAGE(exportimage1$, 32) 'Even though we saved them in 256 color mode, we currently have to force load them as 32 bit images as _LOADIMAGE doesn't support 256 color pictures yet
IF zz& <> -1 THEN
    SCREEN zz&
    PRINT "Image Handle: "; zz&, exportimage1$
    PRINT "Successful Import using _LOADIMAGE"
ELSE
    PRINT "ERROR - Not Loading the new image with _LOADIMAGE."
END IF
 
SLEEP
 
 
CLS
zz& = _LOADIMAGE(exportimage1$, 32) 'Even though we saved them in 256 color mode, we currently have to force load them as 32 bit images as _LOADIMAGE doesn't support 256 color pictures yet
IF zz& <> -1 THEN
    SCREEN zz&
    PRINT "Image Handle: "; zz&, exportimage2$
    PRINT "Successful Import using _LOADIMAGE"
ELSE
    PRINT "ERROR - Not Loading the new image with _LOADIMAGE."
END IF
 
 
SLEEP
CLS
 
SYSTEM
 
'$INCLUDE:'SaveImage.BM'

Pages: 1 ... 14 15 [16]

News:

Show Posts

Topics - SMcNeill

Programs / PNG chunk information

Programs / Game Maker 64 (GM64)

QB64 Discussion / Occassional Graphical Glitch

QB64 Discussion / Re: From strange to weird

QB64 Discussion / Why _MEM.OFFSET?

QB64 Discussion / QB64 x64 (10-17-2018)

QB64 Discussion / ColorAll Library

Programs / Math Flash Card Trainer for Children

Programs / SHUFFLE (GL Version)

Programs / DBF conversion/use programs

Programs / Epub book creation program

Programs / Steve's Poker Playhouse

Programs / File Listing

Programs / SaveImage