QBasic and QB64 Discussion Board

[QB Forum Archives (1999-2009)/ ] [QB FAQ] [QB Links and Downloads] [Subforums and Chat Room] [Search]

QB64.Net Homepage   QB/QB64 Keywords   QB Graphics Forum   Homework Policy



QuickBasic 4.5 to QuickBasic64

by (no login)

I am working on converting an old QB 4.5 program to the newer QB64.

The problem I am having is in this line:

' FNOffOn$ returns "Off" if switch is 0, and returns "On" if
' switch is non-zero.

DEF FNOffOn$ (Switch) = MID$("OffOn", 1 - 3 * (Switch <> 0), 3)

The Error is: Command not implemented

Posted on Sep 9, 2012, 6:36 PM

Respond to this message   

Return to Index


Re: QuickBasic 4.5 to QuickBasic64

by (Login MCalkins)
Moderator

Just convert it to a FUNCTION. Since it doesn't rely on external variables, it's pretty straightforward.

FUNCTION FNOffOn$ (Switch)
FNOffOn = MID$("OffOn", 1 - 3 * (Switch <> 0), 3)
END FUNCTION

or perhaps:

FUNCTION FNOffOn$ (Switch)
IF Switch THEN
FNOffOn = "On"
ELSE
FNOffOn = "Off"
END IF
END FUNCTION

You might consider making Switch a LONG, unless that causes problems with the rest of your program.

Regards,
Michael

Posted on Sep 9, 2012, 8:07 PM

Respond to this message   

Return to Index


Serial port question

by (no login)

Gentlemen,

I was wondering if anyone on the forum could help me with the following.

I have an X10 Motion Sensor at the back and front of the property and when triggered a W800RF32 receiver connected to COM1 detects the four bytes.

I also have a relay module connected to my parallel port.

Do any of you fellows know of a QBasic program that can capture these four bytes in such a way that they can be acted upon. I mean, for example:

If the four bytes received were (00 FF 0E F1) THEN OUT 888, 64. This would cause one of the relays to turn on the outside camera or any other device.

I am a retired Railroad worker in my 80's and trying desperately to get a handle on this, that's why I'm attempting to contact the younger generation.

Thank you very much for taking the time.

Lyle

Posted on Sep 9, 2012, 6:30 PM

Respond to this message   

Return to Index


Lisztfr: More regarding backups

by Moneo (no login)

See my new post dated August 31st on this subject.

Posted on Aug 31, 2012, 5:13 PM

Respond to this message   

Return to Index


POKE & Graphics

by James (no login)

Hello @all.

I am interested in fractals and found some code written in QBASIC.
The problem is that I don't know how to translate the POKE-commands.

I know what the program writes to which address, but I don't know how QB uses this information to generate the graphics. Maybe somebody here knows how this works.

Thanks in advance for every answer I get.
Regards, James

Posted on Aug 25, 2012, 7:57 AM

Respond to this message   

Return to Index


Code

by minx (no login)

Here is our code in QB4.5 so far:
http://www.workupload.com/file/BqBykEQ

Posted on Aug 25, 2012, 8:02 AM

Respond to this message   

Return to Index


Re: POKE & Graphics

by James (no login)

If I would be able to translate the POKEs to Coordinates, I could use the SetPixel function in GDI.

Posted on Aug 25, 2012, 8:16 AM

Respond to this message   

Return to Index


In Screen 13, it's quite straightforward.

by (Login MCalkins)
Moderator

In some other screen modes, "planes" complicate things, but "screen 13" is simple.

offset = y * 320 + x

or:

x = offset MOD 320
y = offset \ 320

The POKE line in the .bas file in the other post could be replaced with:
PSET ((p& + c) MOD 320, (p& + c) \ 320), sins(r + f) + sins(c + f) + sins(r + c) + rands(f2 * r + c)

Regards,
Michael

Posted on Aug 25, 2012, 5:26 PM

Respond to this message   

Return to Index


Soduko

by (no login)

Hi, can someone please pinpoint the error in this? I don't really want to start over and I can't seem to find the error.
It is supposed to solve soduko puzzles but the guess array isnt keeping itself correctly somewhere and then the puzzle array isnt being updated at all and after one loop it stops because it didnt update. Please help:


_TITLE "Soduko Solver"
SCREEN 12
DO
REDIM puzzle(9, 9)
REDIM guess(9, 9, 9)
REDIM set(9)

puzzle(1, 1) = 4
puzzle(1, 2) = 0
puzzle(1, 3) = 0
puzzle(1, 4) = 0
puzzle(1, 5) = 0
puzzle(1, 6) = 0
puzzle(1, 7) = 6
puzzle(1, 8) = 7
puzzle(1, 9) = 0
puzzle(2, 1) = 0
puzzle(2, 2) = 8
puzzle(2, 3) = 9
puzzle(2, 4) = 0
puzzle(2, 5) = 0
puzzle(2, 6) = 1
puzzle(2, 7) = 3
puzzle(2, 8) = 2
puzzle(2, 9) = 5
puzzle(3, 1) = 0
puzzle(3, 2) = 3
puzzle(3, 3) = 0
puzzle(3, 4) = 2
puzzle(3, 5) = 0
puzzle(3, 6) = 0
puzzle(3, 7) = 0
puzzle(3, 8) = 0
puzzle(3, 9) = 0
puzzle(4, 1) = 0
puzzle(4, 2) = 0
puzzle(4, 3) = 4
puzzle(4, 4) = 0
puzzle(4, 5) = 8
puzzle(4, 6) = 5
puzzle(4, 7) = 7
puzzle(4, 8) = 0
puzzle(4, 9) = 0
puzzle(5, 1) = 0
puzzle(5, 2) = 6
puzzle(5, 3) = 1
puzzle(5, 4) = 0
puzzle(5, 5) = 3
puzzle(5, 6) = 0
puzzle(5, 7) = 8
puzzle(5, 8) = 5
puzzle(5, 9) = 0
puzzle(6, 1) = 0
puzzle(6, 2) = 0
puzzle(6, 3) = 5
puzzle(6, 4) = 4
puzzle(6, 5) = 6
puzzle(6, 6) = 0
puzzle(6, 7) = 1
puzzle(6, 8) = 0
puzzle(6, 9) = 0
puzzle(7, 1) = 0
puzzle(7, 2) = 0
puzzle(7, 3) = 0
puzzle(7, 4) = 0
puzzle(7, 5) = 0
puzzle(7, 6) = 8
puzzle(7, 7) = 0
puzzle(7, 8) = 4
puzzle(7, 9) = 0
puzzle(8, 1) = 6
puzzle(8, 2) = 4
puzzle(8, 3) = 8
puzzle(8, 4) = 5
puzzle(8, 5) = 0
puzzle(8, 6) = 0
puzzle(8, 7) = 2
puzzle(8, 8) = 3
puzzle(8, 9) = 0
puzzle(9, 1) = 0
puzzle(9, 2) = 2
puzzle(9, 3) = 3
puzzle(9, 4) = 0
puzzle(9, 5) = 0
puzzle(9, 6) = 0
puzzle(9, 7) = 0
puzzle(9, 8) = 0
puzzle(9, 9) = 7

DO
_LIMIT 64
CLS
GOSUB drawboard
GOSUB printboard
PRINT "Enter what you know then press Enter"
k$ = INKEY$
IF k$ >= CHR$(49) AND k$ <= CHR$(57) THEN puzzle(xsector, ysector) = VAL(k$)
IF k$ = CHR$(8) THEN puzzle(xsector, ysector) = 0
DO WHILE _MOUSEINPUT
IF _MOUSEBUTTON(1) THEN
x = _MOUSEX
y = _MOUSEY
DO
xsector = INT((x - 144) / 32)
IF xsector < 1 OR xsector > 9 THEN
xsector = 0
ysector = 0
EXIT DO
END IF
ysector = INT((y - 64) / 32)
IF ysector < 1 OR ysector > 9 THEN
xsector = 0
ysector = 0
EXIT DO
END IF
EXIT DO
LOOP
END IF
LOOP
_DISPLAY
LOOP UNTIL k$ = CHR$(13)
DO
FOR ychecker = 1 TO 9
FOR setter = 1 TO 9
set(setter) = setter
NEXT setter
FOR xcheck = 1 TO 9
IF puzzle(xcheck, ychecker) <> 0 THEN set(puzzle(xcheck, ychecker)) = 0
NEXT xcheck
FOR guessupdatex = 1 TO 9
FOR sets = 1 TO 9
IF puzzle(guessupdatex, ychecker) = 0 AND set(sets) <> 0 THEN
setchecker = 0
FOR setcheck = 1 TO 9
IF guess(guessupdatex, ychecker, setcheck) = set(sets) THEN setchecker = 1
NEXT setcheck
IF setchecker = 0 THEN
guess(guessupdatex, ychecker, 0) = guess(guessupdatex, ychecker, 0) + 1
guess(guessupdatex, ychecker, set(sets)) = set(sets)
END IF
END IF
NEXT sets
NEXT guessupdatex
NEXT ychecker
FOR xchecker = 1 TO 9
FOR setter = 1 TO 9
set(setter) = setter
NEXT setter
FOR ycheck = 1 TO 9
IF puzzle(xchecker, ycheck) <> 0 THEN set(puzzle(xchecker, ycheck)) = 0
NEXT ycheck
FOR guessupdatey = 1 TO 9
FOR sets = 1 TO 9
IF puzzle(xchecker, guessupdatey) = 0 AND set(sets) <> 0 THEN
setchecker = 0
FOR setcheck = 1 TO 9
IF guess(xchecker, guessupdatey, setcheck) = set(sets) THEN setchecker = 1
NEXT setcheck
IF setchecker = 0 THEN
guess(xchecker, guessupdatey, 0) = guess(xchecker, guessupdatey, 0) + 1
guess(xchecker, guessupdatey, set(sets)) = set(sets)
END IF
END IF
NEXT sets
NEXT guessupdatey
NEXT xchecker
FOR setter = 1 TO 9
set(setter) = setter
NEXT setter
FOR blockcheckx1 = 1 TO 3
FOR blockchecky1 = 1 TO 3
IF puzzle(blockcheckx1, blockchecky1) <> 0 THEN set(puzzle(blockcheckx1, blockchecky1)) = 0
NEXT blockchecky1
NEXT blockcheckx1
FOR guessupdatexblock = 1 TO 3
FOR guessupdateyblock = 1 TO 3
FOR sets = 1 TO 9
IF puzzle(guessupdatexblock, guessupdateyblock) = 0 AND set(sets) <> 0 THEN
setchecker = 0
FOR setcheck = 1 TO 9
IF guess(guessupdatexblock, guessupdateyblock, setcheck) = set(sets) THEN setchecker = 1
NEXT setcheck
IF setchecker = 0 THEN
guess(guessupdatexblock, guessupdateyblock, 0) = guess(guessupdatexblock, guessupdateyblock, 0) + 1
guess(guessupdatexblock, guessupdateyblock, set(sets)) = set(sets)
END IF
END IF
NEXT sets
NEXT guessupdateyblock
NEXT guessupdatexblock
FOR setter = 1 TO 9
set(setter) = setter
NEXT setter
FOR blockcheckx1 = 4 TO 6
FOR blockchecky1 = 1 TO 3
IF puzzle(blockcheckx1, blockchecky1) <> 0 THEN set(puzzle(blockcheckx1, blockchecky1)) = 0
NEXT blockchecky1
NEXT blockcheckx1
FOR guessupdatexblock = 4 TO 6
FOR guessupdateyblock = 1 TO 3
FOR sets = 1 TO 9
IF puzzle(guessupdatexblock, guessupdateyblock) = 0 AND set(sets) <> 0 THEN
setchecker = 0
FOR setcheck = 1 TO 9
IF guess(guessupdatexblock, guessupdateyblock, setcheck) = set(sets) THEN setchecker = 1
NEXT setcheck
IF setchecker = 0 THEN
guess(guessupdatexblock, guessupdateyblock, 0) = guess(guessupdatexblock, guessupdateyblock, 0) + 1
guess(guessupdatexblock, guessupdateyblock, set(sets)) = set(sets)
END IF
END IF
NEXT sets
NEXT guessupdateyblock
NEXT guessupdatexblock
FOR setter = 1 TO 9
set(setter) = setter
NEXT setter
FOR blockcheckx1 = 7 TO 9
FOR blockchecky1 = 1 TO 3
IF puzzle(blockcheckx1, blockchecky1) <> 0 THEN set(puzzle(blockcheckx1, blockchecky1)) = 0
NEXT blockchecky1
NEXT blockcheckx1
FOR guessupdatexblock = 7 TO 9
FOR guessupdateyblock = 1 TO 3
FOR sets = 1 TO 9
IF puzzle(guessupdatexblock, guessupdateyblock) = 0 AND set(sets) <> 0 THEN
setchecker = 0
FOR setcheck = 1 TO 9
IF guess(guessupdatexblock, guessupdateyblock, setcheck) = set(sets) THEN setchecker = 1
NEXT setcheck
IF setchecker = 0 THEN
guess(guessupdatexblock, guessupdateyblock, 0) = guess(guessupdatexblock, guessupdateyblock, 0) + 1
guess(guessupdatexblock, guessupdateyblock, set(sets)) = set(sets)
END IF
END IF
NEXT sets
NEXT guessupdateyblock
NEXT guessupdatexblock
FOR setter = 1 TO 9
set(setter) = setter
NEXT setter
FOR blockcheckx1 = 1 TO 3
FOR blockchecky1 = 4 TO 6
IF puzzle(blockcheckx1, blockchecky1) <> 0 THEN set(puzzle(blockcheckx1, blockchecky1)) = 0
NEXT blockchecky1
NEXT blockcheckx1
FOR guessupdatexblock = 1 TO 3
FOR guessupdateyblock = 4 TO 6
FOR sets = 1 TO 9
IF puzzle(guessupdatexblock, guessupdateyblock) = 0 AND set(sets) <> 0 THEN
setchecker = 0
FOR setcheck = 1 TO 9
IF guess(guessupdatexblock, guessupdateyblock, setcheck) = set(sets) THEN setchecker = 1
NEXT setcheck
IF setchecker = 0 THEN
guess(guessupdatexblock, guessupdateyblock, 0) = guess(guessupdatexblock, guessupdateyblock, 0) + 1
guess(guessupdatexblock, guessupdateyblock, set(sets)) = set(sets)
END IF
END IF
NEXT sets
NEXT guessupdateyblock
NEXT guessupdatexblock
FOR setter = 1 TO 9
set(setter) = setter
NEXT setter
FOR blockcheckx1 = 4 TO 6
FOR blockchecky1 = 4 TO 6
IF puzzle(blockcheckx1, blockchecky1) <> 0 THEN set(puzzle(blockcheckx1, blockchecky1)) = 0
NEXT blockchecky1
NEXT blockcheckx1
FOR guessupdatexblock = 4 TO 6
FOR guessupdateyblock = 4 TO 6
FOR sets = 1 TO 9
IF puzzle(guessupdatexblock, guessupdateyblock) = 0 AND set(sets) <> 0 THEN
setchecker = 0
FOR setcheck = 1 TO 9
IF guess(guessupdatexblock, guessupdateyblock, setcheck) = set(sets) THEN setchecker = 1
NEXT setcheck
IF setchecker = 0 THEN
guess(guessupdatexblock, guessupdateyblock, 0) = guess(guessupdatexblock, guessupdateyblock, 0) + 1
guess(guessupdatexblock, guessupdateyblock, set(sets)) = set(sets)
END IF
END IF
NEXT sets
NEXT guessupdateyblock
NEXT guessupdatexblock
FOR setter = 1 TO 9
set(setter) = setter
NEXT setter
FOR blockcheckx1 = 7 TO 9
FOR blockchecky1 = 4 TO 6
IF puzzle(blockcheckx1, blockchecky1) <> 0 THEN set(puzzle(blockcheckx1, blockchecky1)) = 0
NEXT blockchecky1
NEXT blockcheckx1
FOR guessupdatexblock = 7 TO 9
FOR guessupdateyblock = 4 TO 6
FOR sets = 1 TO 9
IF puzzle(guessupdatexblock, guessupdateyblock) = 0 AND set(sets) <> 0 THEN
setchecker = 0
FOR setcheck = 1 TO 9
IF guess(guessupdatexblock, guessupdateyblock, setcheck) = set(sets) THEN setchecker = 1
NEXT setcheck
IF setchecker = 0 THEN
guess(guessupdatexblock, guessupdateyblock, 0) = guess(guessupdatexblock, guessupdateyblock, 0) + 1
guess(guessupdatexblock, guessupdateyblock, set(sets)) = set(sets)
END IF
END IF
NEXT sets
NEXT guessupdateyblock
NEXT guessupdatexblock
FOR setter = 1 TO 9
set(setter) = setter
NEXT setter
FOR blockcheckx1 = 1 TO 3
FOR blockchecky1 = 7 TO 9
IF puzzle(blockcheckx1, blockchecky1) <> 0 THEN set(puzzle(blockcheckx1, blockchecky1)) = 0
NEXT blockchecky1
NEXT blockcheckx1
FOR guessupdatexblock = 1 TO 3
FOR guessupdateyblock = 7 TO 9
FOR sets = 1 TO 9
IF puzzle(guessupdatexblock, guessupdateyblock) = 0 AND set(sets) <> 0 THEN
setchecker = 0
FOR setcheck = 1 TO 9
IF guess(guessupdatexblock, guessupdateyblock, setcheck) = set(sets) THEN setchecker = 1
NEXT setcheck
IF setchecker = 0 THEN
guess(guessupdatexblock, guessupdateyblock, 0) = guess(guessupdatexblock, guessupdateyblock, 0) + 1
guess(guessupdatexblock, guessupdateyblock, set(sets)) = set(sets)
END IF
END IF
NEXT sets
NEXT guessupdateyblock
NEXT guessupdatexblock
FOR setter = 1 TO 9
set(setter) = setter
NEXT setter
FOR blockcheckx1 = 4 TO 6
FOR blockchecky1 = 7 TO 9
IF puzzle(blockcheckx1, blockchecky1) <> 0 THEN set(puzzle(blockcheckx1, blockchecky1)) = 0
NEXT blockchecky1
NEXT blockcheckx1
FOR guessupdatexblock = 4 TO 6
FOR guessupdateyblock = 7 TO 9
FOR sets = 1 TO 9
IF puzzle(guessupdatexblock, guessupdateyblock) = 0 AND set(sets) <> 0 THEN
setchecker = 0
FOR setcheck = 1 TO 9
IF guess(guessupdatexblock, guessupdateyblock, setcheck) = set(sets) THEN setchecker = 1
NEXT setcheck
IF setchecker = 0 THEN
guess(guessupdatexblock, guessupdateyblock, 0) = guess(guessupdatexblock, guessupdateyblock, 0) + 1
guess(guessupdatexblock, guessupdateyblock, set(sets)) = set(sets)
END IF
END IF
NEXT sets
NEXT guessupdateyblock
NEXT guessupdatexblock
FOR setter = 1 TO 9
set(setter) = setter
NEXT setter
FOR blockcheckx1 = 7 TO 9
FOR blockchecky1 = 7 TO 9
IF puzzle(blockcheckx1, blockchecky1) <> 0 THEN set(puzzle(blockcheckx1, blockchecky1)) = 0
NEXT blockchecky1
NEXT blockcheckx1
FOR guessupdatexblock = 7 TO 9
FOR guessupdateyblock = 7 TO 9
FOR sets = 1 TO 9
IF puzzle(guessupdatexblock, guessupdateyblock) = 0 AND set(sets) <> 0 THEN
setchecker = 0
FOR setcheck = 1 TO 9
IF guess(guessupdatexblock, guessupdateyblock, setcheck) = set(sets) THEN setchecker = 1
NEXT setcheck
IF setchecker = 0 THEN
guess(guessupdatexblock, guessupdateyblock, 0) = guess(guessupdatexblock, guessupdateyblock, 0) + 1
guess(guessupdatexblock, guessupdateyblock, set(sets)) = set(sets)
END IF
END IF
NEXT sets
NEXT guessupdateyblock
NEXT guessupdatexblock
updates = 0
FOR guesspuzzlex = 1 TO 9
FOR guesspuzzley = 1 TO 9
IF guess(guesspuzzlex, guesspuzzley, 0) = 1 AND guess(guesspuzzlex, guesspuzzley, 1) <> 0 THEN
FOR findset = 1 TO 9
IF guess(guesspuzzlex, guesspuzzley, findset) <> 0 THEN puzzle(guesspuzzlex, guesspuzzley) = guess(guesspuzzlex, guesspuzzley, findset)
NEXT findset
updates = 1
END IF
NEXT guesspuzzley
NEXT guesspuzzlex

OPEN "x.txt" FOR OUTPUT AS #1
FOR y = 1 TO 9
FOR x = 1 TO 9
PRINT #1, puzzle(x, y);
NEXT x
PRINT #1, ""
NEXT y
CLOSE #1
REDIM guesser(9, 9)
FOR x = 1 TO 9
FOR y = 1 TO 9
guesser(x, y) = guess(x, y, 0)
NEXT y
NEXT x
OPEN "y.txt" FOR OUTPUT AS #1
FOR y = 1 TO 9
FOR x = 1 TO 9
PRINT #1, guesser(x, y);
NEXT x
PRINT #1, ""
NEXT y
CLOSE #1
SLEEP

LOOP UNTIL updates = 0
done = 1
FOR checkdonex = 1 TO 9
FOR checkdoney = 1 TO 9
IF puzzle(checkdonex, checkdoney) = 0 THEN done = 0
NEXT checkdoney
NEXT checkdonex
DO
_LIMIT 64
CLS
GOSUB drawboard
GOSUB printboard
IF done = 1 THEN PRINT "The puzzle has been completed"
IF done = 0 THEN
PRINT "This puzzle was either unsolvable or required guesswork"
PRINT "I have solved it as far as I can"
END IF
PRINT
PRINT "Press Escape to exit, Enter to do another puzzle"
k$ = INKEY$
_DISPLAY
LOOP UNTIL k$ = CHR$(13) OR k$ = CHR$(27)
LOOP UNTIL k$ = CHR$(27)
SYSTEM

drawboard:
FOR drawx = 176 TO 464 STEP 32
PSET (drawx, 96), 7
DRAW "D288"
NEXT drawx
FOR drawy = 96 TO 384 STEP 32
PSET (176, drawy), 7
DRAW "R288"
NEXT drawy
FOR darken1x = 175 TO 463 STEP 96
PSET (darken1x, 96), 7
DRAW "D288"
NEXT darken1x
FOR darken2x = 177 TO 465 STEP 96
PSET (darken2x, 96), 7
DRAW "D288"
NEXT darken2x
FOR darken1y = 95 TO 383 STEP 96
PSET (176, darken1y), 7
DRAW "R288"
NEXT darken1y
FOR darken2y = 97 TO 385 STEP 96
PSET (176, darken2y), 7
DRAW "R288"
NEXT darken2y
RETURN

printboard:
xprint = 0
yprint = 0
DO
FOR printx = 182 TO 470 STEP 32
xprint = xprint + 1
IF xprint = 10 THEN EXIT DO
yprint = 0
DO
FOR printy = 105 TO 393 STEP 32
yprint = yprint + 1
IF yprint = 10 THEN EXIT DO
IF puzzle(xprint, yprint) <> 0 THEN _PRINTSTRING (printx, printy), STR$(puzzle(xprint, yprint))
NEXT printy
EXIT DO
LOOP
NEXT printx
EXIT DO
LOOP
RETURN

Posted on Aug 23, 2012, 5:30 PM

Respond to this message   

Return to Index


Re: Soduko

by (no login)

The puzzle that comes up is just a preset to make it easier to test, normally you would enter the puzzle manually.

Posted on Aug 23, 2012, 5:31 PM

Respond to this message   

Return to Index


I need help with making my antialiasing program more efficient

by (no login)

I made an antialiasing program a while ago (which i posted here) and have been working on it since then. I made a new antialiasing subroutine (called SUB blaa) which looks better than the original and is much faster. The problem is, it's still too slow. Is there any way I can make either of these subroutines more efficient?


Source Code :

SCREEN _NEWIMAGE(1280, 720, 32)
CIRCLE (100, 100), 75, _RGB(255, 0, 0)
PAINT (100, 100), _RGB(255, 0, 0), _RGB(255, 0, 0)
CIRCLE (1180, 100), 75, _RGB(255, 0, 0)
PAINT (1180, 100), _RGB(255, 0, 0), _RGB(255, 0, 0)
LINE (640, 0)-(640, 720)
SLEEP
CALL antialias(640, 0, 1280, 720, 6)
CALL blaa(0, 0, 640, 720, 2, 1)

SUB antialias (minx, miny, screenx, screeny, quality)
$CHECKING:OFF
IF quality > 16 THEN quality = 16
FOR main = 1 TO quality
ws& = _NEWIMAGE(screenx + 1, screeny + 1, 32)
_PUTIMAGE (0, 0)-(screenx, screeny), , ws&, (0, 0)-(screenx, screeny)
_SOURCE ws&
FOR dx = minx TO screenx - 1 'goes through each pixel for the entire area of the screen
FOR dy = miny TO screeny - 1
ra = 0
ga = 0
ba = 0 'reset color and other values
difpix = 0
weightednum = 0
op~&& = POINT(dx, dy) ' get the color of the main pixel
FOR cx = -1 TO 1 'gets the 8 pixels around (dx,dy)
FOR cy = -1 TO 1
cp~&& = POINT(dx + cx, dy + cy) 'get the color of each of the 8 pixels
value = 45
IF ABS(_RED32(op~&&) - _RED32(cp~&&)) > value OR ABS(_BLUE32(op~&&) - _BLUE32(cp~&&)) > value OR ABS(_GREEN32(cp~&&) - _GREEN32(op~&&)) > value OR ABS(_RED32(cp~&&) - _RED32(op~&&)) + ABS(_GREEN32(cp~&&) - _GREEN32(op~&&)) + ABS(_BLUE32(cp~&&) - _BLUE32(op~&&)) > value THEN
difpix = difpix + 1
END IF
weightednum = weightednum + 1
ra = ra + (_RED32(cp~&&))
ga = ga + (_GREEN32(cp~&&))
ba = ba + (_BLUE32(cp~&&))

'check if the colors of the pixels are different enough to antialias them
'find the average color of (dx,dy) and the 8 pixels surrounding it regardless of whether the pixel needs antialiasing
NEXT cy
NEXT cx
IF difpix = 4 THEN 'if there are different colored pixels among the 8
'(but not too many otherwise it would antialias a 1-pixel line causing it to lose color. EG. any point on a vertical 1-pixel line has 6 different colored pixels around it)
' antialiasing this sort of line would only cause it to lose color

PSET (dx, dy), _RGB((ra / weightednum), (ga / weightednum), (ba / weightednum))

'PRINT , dx, dy, _RED32(averagecolor~&&), _GREEN32(averagecolor~&&), _BLUE32(averagecolor~&&)
'SLEEP
'For debugging - goes through each pixel which needs to be antialiased and gives its
' coordinates and RGB values.
END IF
NEXT dy
NEXT dx
_FREEIMAGE ws&
NEXT main
END SUB

SUB blaa (minx, miny, screenx, screeny, quality1, quality2)
$CHECKING:OFF
IF quality1 > 16 THEN quality1 = 16
IF quality2 > quality1 THEN quality2 = quality1
FOR main = 1 TO quality1 + quality2
ws& = _NEWIMAGE(screenx + 1, screeny + 1, 32)
_PUTIMAGE (0, 0)-(screenx, screeny), , ws&, (0, 0)-(screenx, screeny)
_SOURCE ws&
FOR dx = minx TO screenx - 1 'goes through each pixel for the entire area of the screen
FOR dy = miny TO screeny - 1
ra = 0
ga = 0
ba = 0 'reset color and other values
difpix = 0
weightednum = 0
op~&& = POINT(dx, dy) ' get the color of the main pixel
FOR cx = -1 TO 1 'gets the 8 pixels around (dx,dy)
FOR cy = -1 TO 1
cp~&& = POINT(dx + cx, dy + cy) 'get the color of each of the 8 pixels
value = 45
IF ABS(_RED32(op~&&) - _RED32(cp~&&)) > value OR ABS(_BLUE32(op~&&) - _BLUE32(cp~&&)) > value OR ABS(_GREEN32(cp~&&) - _GREEN32(op~&&)) > value OR ABS(_RED32(cp~&&) - _RED32(op~&&)) + ABS(_GREEN32(cp~&&) - _GREEN32(op~&&)) + ABS(_BLUE32(cp~&&) - _BLUE32(op~&&)) > value THEN
difpix = difpix + 1
END IF
weightednum = weightednum + 1
ra = ra + (_RED32(cp~&&))
ga = ga + (_GREEN32(cp~&&))
ba = ba + (_BLUE32(cp~&&))

'check if the colors of the pixels are different enough to antialias them
'find the average color of (dx,dy) and the 8 pixels surrounding it regardless of whether the pixel needs antialiasing
NEXT cy
NEXT cx
IF main > quality1 THEN
IF difpix < 6 THEN PSET (dx, dy), _RGB((ra / weightednum), (ga / weightednum), (ba / weightednum))
ELSE
IF difpix = 4 THEN PSET (dx, dy), _RGB((ra / weightednum), (ga / weightednum), (ba / weightednum))
END IF
NEXT dy
NEXT dx
_FREEIMAGE ws&
NEXT main
END SUB

Posted on Aug 22, 2012, 4:35 PM

Respond to this message   

Return to Index


Image with QB64.EXE

by (no login)

Hello
I want to insert an image (png, jpg or gif) on a point of a geographical chat using the compiler QB64.exe.
How to do it.
The point on the chart is represented bye tha latitude and longitude.

Many thanks for responding and helping me.

Posted on Aug 19, 2012, 5:44 AM

Respond to this message   

Return to Index


Tell us more

by (Login burger2227)
R

What are you doing and what chat? Explain your idea. We are not mind readers!

Posted on Aug 19, 2012, 12:34 PM

Respond to this message   

Return to Index


I think he has a map

by Anonymous (no login)


http://www.mathworks.com/matlabcentral/fx_files/30994/1/world1.jpg

He has a map displayed on the screen in QB64.

At a certain latitude and longitude on the map, he wants to put an image to mark that latitude and longitude.

Posted on Aug 19, 2012, 1:21 PM

Respond to this message   

Return to Index


* Well I hope that map can tell him how to get back here...:-)

by (Login burger2227)
R

Posted on Aug 21, 2012, 2:11 PM

Respond to this message   

Return to Index


Today is my landmark birthday.

by Solitaire (Login Solitaire1)
S

I am now three quarters of a century old.

When I got married in 1964, my husband was a COBOL programmer. He also looked into BASIC and showed me some code on paper.

When we visited the computer museum in Boston (don't remember the year), he showed me how to program a punch card, using one of the hands-on computers at the exhibit (the size of a refrigerator lying on its side). I still have that card. (My husband passed away 3 1/2 years ago.)

The first time I programmed on a computer was in 1980 on the TRS-80.

I got my Masters in "Computers in Education" in 1990. I had taken three programming courses -- GW BASIC, Pascal, and LogoWriter.

I was a grade-school teacher and had 3 computers in my classroom -- a Commodore 64, an Apple IIe, and an old IBM PC that someone had donated. I wrote programs for each of them in BASIC. I was known as the computer expert in my school.

I retired in 1996 and got two part-time jobs teaching computer science courses. One was at a parochial school using Apple IIe computers, and the other was at a local college using IBM PCs. The two part-time jobs kept me busier than one full-time job. I really preferred teaching adults, so after one year, I just kept the college job.

I soon specialized in computer programming, using QBASIC and Visual Basic 5, with samples of other (DOS-based) languages as part of the introductory class. I'm still at the college, but we had to drop QB after Vista came out, in favor of Visual Basic.NET. I now teach the "Introduction to Programming" course using VB 2010 with a sprinkling of C# at the last class session.

I'm a member of several computer users' groups. I attend regular monthly meetings of the VB SIG at the Microsoft office in NYC, and have been going to those meetings since VB 3 was released back in the early 90s. I never did come across a QB users' group.

I'm still using Windows XP so that I can run my old QB programs in full screen. My desktop computer is partitioned with Windows XP and Windows 7, but I hardly ever use the Win 7 partition. I really dread the new Windows 8 that's coming up. Maybe I'm getting too old.

Posted on Aug 15, 2012, 5:19 AM

Respond to this message   

Return to Index


*Congratulations!!

by AlGoreIthm (no login)

Posted on Aug 15, 2012, 5:33 AM

Respond to this message   

Return to Index


Hey, congratulations...

by (Login qb432l)
R

To be honest, you don't look a day over sixty, so I'll have to take your word for it that you're older. As for Windows 8, dreading it is not an age thing, although it is based on experience (and experience, and experience...).

Again, happy birthday!
-Bob

Posted on Aug 15, 2012, 8:26 PM

Respond to this message   

Return to Index


Only 25 more years until Willard Scott and the Jelly Jar!

by (Login burger2227)
R

I still use XP and I'm only 63...

wink.gif

Posted on Aug 16, 2012, 9:02 AM

Respond to this message   

Return to Index


Re: Today is my landmark birthday.

by Moneo (no login)

Happy belated birthday. You are one year older than I. Interesting synopsis of your computer related experience. Having done analysis, design and programming for 46 years, the history of my experiences is rather long. However, if you are interested, you can view my (Edward Moneo) profile on LinkedIn.

Posted on Aug 27, 2012, 9:45 AM

Respond to this message   

Return to Index


...

by gopus (no login)

I didnt know you were a female...

Posted on Sep 10, 2012, 4:48 AM

Respond to this message   

Return to Index


calculator and graphs

by Ben (no login)

DEFINT A-Z

DECLARE SUB graph (expression AS STRING)
DECLARE SUB mouse (ax, mb, mx, my)
DECLARE SUB push (item AS STRING)
DECLARE FUNCTION pop$ ()
DECLARE FUNCTION makerpn$ (expression AS STRING)
DECLARE FUNCTION evalrpn$ (rpn AS STRING, a AS DOUBLE, x AS DOUBLE)
DECLARE FUNCTION trim$ (s$)

DIM SHARED m(7) AS LONG
m(0) = &H8BE58955
m(1) = &H48B0C76
m(2) = &H768B33CD
m(3) = &H8B1C890A
m(4) = &HC890876
m(5) = &H8906768B
m(6) = &H8CA5D14
DIM SHARED mb, mx, my

DIM SHARED stack(1000) AS STRING
DIM SHARED stackindex AS INTEGER
stackindex = 0

DIM s(1000) AS STRING

SCREEN 0
VIEW PRINT 1 TO 25
CLS

s(0) = "examples of things to type here (a is variable holds previous answer):"
s(1) = "=ln(2.7^20)"
s(2) = "=2^2*2 + a + a"
s(3) = "=81^(1/2)"
s(4) = "=-cos3.14159"
s(5) = "x is variable in graph y to x"
s(6) = "graph x*x"
s(7) = "graph tanx"

FOR i = 0 TO 6
LOCATE i + 1, 1
PRINT s(i);
NEXT

c = 8
x = 1
y = 8

LOCATE y, x
COLOR 0, 7
PRINT CHR$(SCREEN(c + 1, x));
COLOR 7, 0

DIM SHARED a AS DOUBLE
a = 0

DO
key$ = INKEY$
IF key$ <> "" THEN

SELECT CASE key$
CASE CHR$(32) TO CHR$(128)
IF x < 80 AND LEN(s(c)) < 79 THEN
s(c) = LEFT$(s(c), x - 1) + key$ + MID$(s(c), x, LEN(s(c)) - x + 1)
LOCATE y, 1
PRINT s(c);
x = x + 1
END IF

CASE CHR$(0) + "K"'left
IF x > 1 THEN
x = x - 1
LOCATE y, 1
PRINT s(c) + " ";
END IF

CASE CHR$(0) + "M"'right
IF x <= LEN(s(c)) THEN
x = x + 1
LOCATE y, 1
PRINT s(c) + " ";
END IF

CASE CHR$(0) + "H"'up
s(c) = temp$
LOCATE y, 1
PRINT s(c) + SPACE$(80 - LEN(s(c)));
x = LEN(s(c)) + 1

CASE CHR$(0) + "P"'down
s(c) = ""
LOCATE y, 1
PRINT SPACE$(80)
x = 1

CASE CHR$(8) 'backspace
IF x > 1 THEN
s(c) = LEFT$(s(c), x - 2) + MID$(s(c), x, LEN(s(c)) - x + 1)
LOCATE y, 1
PRINT s(c) + SPACE$(80 - LEN(s(c)));
x = x - 1
END IF

CASE CHR$(13) 'enter

IF LEFT$(trim$(s(c)), 1) = "=" THEN
ans$ = trim$(evalrpn$(makerpn$(s(c) + " ") + " ", a, 0))
a = VAL(ans$)
temp$ = s(c)
s(c) = ans$

ELSEIF LEFT$(trim$(s(c)), 5) = "graph" THEN
graph RIGHT$(s(c), LEN(s(c)) - 5)

END IF

c = c + 1
x = 1

IF y = 25 THEN
CLS
FOR i = 1 TO 24
LOCATE i, 1
PRINT s(c - 25 + i);
NEXT
ELSE
LOCATE y, x
PRINT s(c - 1) + SPACE$(80 - LEN(s(c)));
y = y + 1
END IF
END SELECT

LOCATE y, x
COLOR 0, 7
PRINT CHR$(SCREEN(y, x));
COLOR 7, 0
END IF

LOOP UNTIL key$ = CHR$(27)
SYSTEM

mouse 0, mb, mx, my
mouse 1, mb, mx, my
DO
mouse 3, mb, mx, my

LOCATE 1, 1
PRINT mb, mx, my
LOOP UNTIL INP(&H60) = 1
SYSTEM

FUNCTION evalrpn$ (rpn AS STRING, a AS DOUBLE, x AS DOUBLE)

rpn = rpn + " "
DIM first AS STRING
DIM num AS STRING

DIM c AS INTEGER
DIM cc AS STRING * 1

FOR i = 1 TO LEN(rpn) - 1
cc = MID$(rpn, i, 1)
c = ASC(cc)

SELECT CASE c
CASE 46, 48 TO 57 '. and 0 to 9
num = num + CHR$(c)

CASE ELSE
IF num <> "" THEN
push num
num = ""
END IF

SELECT CASE c
CASE 97
push STR$(a)
CASE 120
push STR$(x)
CASE 95 '_
push STR$(-VAL(pop$))
CASE 43 '+
push STR$(VAL(pop$) + VAL(pop$))
CASE 45 '-
first = pop$
push STR$(VAL(pop$) - VAL(first))
CASE 42 '*
push STR$(VAL(pop$) * VAL(pop$))
CASE 47 '/
first = pop$
push STR$(VAL(pop$) / VAL(first))
CASE 94 '^
first = pop$
push STR$(VAL(pop$) ^ VAL(first))
CASE 115 's
push STR$(SIN(VAL(pop$)))
CASE 99 'c
push STR$(COS(VAL(pop$)))
CASE 116 't
push STR$(TAN(VAL(pop$)))
CASE 108 'l
push STR$(LOG(VAL(pop$)))
END SELECT
END SELECT
NEXT

evalrpn = pop$
END FUNCTION

SUB graph (expression AS STRING)

rpn$ = makerpn$(expression + " ")

SCREEN 12

LINE (0, 240)-(640, 240), 15
LINE (320, 0)-(320, 480), 15

FOR i = 0 TO 640 STEP 40
LINE (i, 235)-STEP(0, 10), 15
NEXT
FOR i = 0 TO 480 STEP 40
LINE (315, i)-STEP(10, 0), 15
NEXT

DIM x AS DOUBLE, y AS DOUBLE
y = VAL(evalrpn$(rpn$, a, -8))
PSET (-8 * 40 + 320, y * 40 + 240), 12
FOR x = -8 TO 8 STEP .1
y = VAL(evalrpn$(rpn$, a, x))
LINE -(x * 40 + 320, 480 - (y * 40 + 240)), 12
NEXT

mouse 0, mb, mx, my
mouse 1, mb, mx, my

LOCATE 1, 1
PRINT "y = " + expression
DO
key$ = INKEY$
mouse 3, mb, mx, my
LOCATE 2, 1
mm# = (mx - 1) / 40 - 8
PRINT "(" + trim$(STR$(mm#)) + "," + evalrpn$(rpn$, a, mm#) + ")"
LOOP UNTIL key$ = CHR$(27)

SCREEN 0
END SUB

FUNCTION makerpn$ (expression AS STRING)
DIM rpn AS STRING
DIM last AS INTEGER
last = -1
DIM temp AS STRING

DIM c AS INTEGER
DIM cc AS STRING * 1

FOR i = 1 TO LEN(expression) - 1
cc = MID$(expression, i, 1)
c = ASC(cc)

SELECT CASE c
CASE 97, 120, 46, 48 TO 57 'a, x, . and 0 to 9
rpn = rpn + CHR$(c)
last = 0
CASE 43, 45 '+, -
rpn = rpn + " "

IF last THEN
IF c = 45 THEN push "_"
ELSE
IF stack(stackindex) = "_" OR stack(stackindex) = "^" OR stack(stackindex) = "+" OR stack(stackindex) = "-" OR stack(stackindex) = "*" OR stack(stackindex) = "/" OR stack(stackindex) = "s" OR stack(stackindex) = "c" OR stack(stackindex) = "t" OR stack(stackindex) = "l" THEN
rpn = rpn + pop$
END IF

push CHR$(c)
last = -1
END IF
CASE 42, 47 '*, /
rpn = rpn + " "

IF stack(stackindex) = "_" OR stack(stackindex) = "^" OR stack(stackindex) = "*" OR stack(stackindex) = "/" OR stack(stackindex) = "s" OR stack(stackindex) = "c" OR stack(stackindex) = "t" OR stack(stackindex) = "l" THEN
rpn = rpn + pop$
END IF

push CHR$(c)
last = -1
CASE 94 '^
rpn = rpn + " "
IF stack(stackindex) = "_" OR stack(stackindex) = "s" OR stack(stackindex) = "c" OR stack(stackindex) = "t" OR stack(stackindex) = "l" THEN
rpn = rpn + pop$
END IF

push CHR$(c)
last = -1

CASE 115 's
i = i + 2
rpn = rpn + " "
push CHR$(c)
CASE 99 'c
i = i + 2
rpn = rpn + " "
push CHR$(c)
CASE 116 't
i = i + 2
rpn = rpn + " "
push CHR$(c)
CASE 108 'l
i = i + 1
rpn = rpn + " "
push CHR$(c)
CASE 40 '(
push "("
CASE 41 ')
DO WHILE stackindex > 0
temp = pop$
IF temp = "(" THEN EXIT DO
rpn = rpn + temp
LOOP
END SELECT
NEXT

FOR i = 1 TO stackindex
rpn = rpn + pop$
NEXT

makerpn$ = rpn
END FUNCTION

SUB mouse (ax, mb, mx, my)
DEF SEG = VARSEG(m(0))
CALL absolute(ax, mb, mx, my, VARPTR(m(0)))
END SUB

FUNCTION pop$
IF stackindex = 0 THEN
pop$ = "0"
ELSE
stackindex = stackindex - 1
pop$ = stack(stackindex + 1)
END IF
END FUNCTION

SUB push (item AS STRING)
stackindex = stackindex + 1
stack(stackindex) = item
END SUB

FUNCTION trim$ (s$)
trim$ = LTRIM$(RTRIM$(s$))
END FUNCTION

Posted on Aug 12, 2012, 3:35 PM

Respond to this message   

Return to Index


*Looks interesting Ben, but how do you use it -- and for what?

by (Login qb432l)
R

*

Posted on Aug 14, 2012, 4:49 AM

Respond to this message   

Return to Index


It is a calculator program

by Bill Gates (no login)

Each line of calculation needs to start with an equal sign:

=2+2

calculates 2+2

=ln(2.7^20)
OR
=log(2.7^20)
calculates LOG(2.7*20)


Now let's say that the previous answer was 2.608315993 and we want to find its square root.
It is too hard to retype that, so we can just type the letter a, and it expands to the previous answer. So =(a)^(1/2) would give you the square root.

The calculator also supports graphs

Type "graph x*x" to graph x^2.

Posted on Aug 15, 2012, 2:45 PM

Respond to this message   

Return to Index


* Hit ESC to get back from the graph to the calculator

by x (no login)

Posted on Aug 15, 2012, 2:46 PM

Respond to this message   

Return to Index


*Aha! Yeah, works great -- thanks!

by (Login qb432l)
R

*

Posted on Aug 15, 2012, 8:22 PM

Respond to this message   

Return to Index


Erroneous graphs

by Anonymous of Hungary (no login)

The graph subroutine is implemented in a rather simplistic way; some graphs are thus drawn wrong.

graph 1/x

puts a line between the two hyperbolae

graph sin(45*x)

shows a zigzag graph which appears to have a negative slope through the point (0,0), which is clearly incorrect.

Posted on Aug 15, 2012, 2:57 PM

Respond to this message   

Return to Index


what would you recommend?

by Ben (no login)

sometimes you can find assimtotes(or what do you call them) by looking for division by 0 errors in the graphing, but it can be at a place where it gets skipped because it finds the point by incrememnting x by 0.1 or something. there is algebric method and find it using limits and stuff but it would be complex to work with user input expression like that write a program to.

Posted on Aug 23, 2012, 5:24 PM

Respond to this message   

Return to Index


Critical Error: Out of Memory

by (no login)

Hi, I need to DIM this array:

Array(38, 2048, 8192)

It keeps giving me an Out of Memory Error. It is trying to use 1,275,068,416 bytes of memory, eh, but I need the array to be that size. How can I turn memory checking off or something?

Posted on Aug 11, 2012, 1:40 PM

Respond to this message   

Return to Index


Twice that size unless you specify data type...

by (Login qb432l)
R

I'm assuming you're using QB64, in QBasic that would be a joke. If you DIM your array as integer, it will work:

DIM Array(38, 2048, 8192) AS INTEGER

The real question is, why would you need an array so HUGE!!! I'm sure there is a more memory-efficient way of accomplishing what you want. Working in QBasic, memory is a constant problem, and you must constantly look for other ways of doing things. The irony is, they usually turn out to be better ways.

-Bob

P.S. As for details of memory methods and restrictions in QB64 you'd have to ask Galleon (QB64 forum?).

Posted on Aug 11, 2012, 3:16 PM

Respond to this message   

Return to Index


Re: Twice that size unless you specify data type...

by (no login)

Oh, youre right, I was thinking INTEGER was the default. Most of the data in the array was going to be empty space because I needed a defined string length to GET and PUT it to a file. Anyways, I found an easier way to store it in like a 500kb file.

Posted on Aug 11, 2012, 5:14 PM

Respond to this message   

Return to Index


*There you go!

by (Login qb432l)
R

*

Posted on Aug 12, 2012, 2:35 AM

Respond to this message   

Return to Index


also

by (Login MCalkins)
Moderator

In BASIC, you're specifying the upper bound, not the number of elements, so it would be 39 * 2049 * 8193, that is, 654,710,823 elements, 1,309,421,646 bytes if INTEGERs.

This is in contrast to C/C++, where you specify the number of elements, not the upper bound.

Win32 applications usually have only 2GB of virtual address space directly available to them, including their code and DLLs. So the largest contiguous array would have to be smaller than 2GB.

Regards,
Michael

Posted on Aug 11, 2012, 10:13 PM

Respond to this message   

Return to Index


Hey, Remember Me?

by Jonathan (no login)

Wow, I haven't been here in years, but last night I had this dream.. and sure enough, here I am! I dreamt that I visited the old Qbasic.com forum, except it was different, beautiful, amazing stuff, and I had the most hilarious amazing post ever to post, maybe about how it felt to watch Ren and Stimpy for the first time at the age of 6. I'm happy, in searching, that there's other nostalgics out there like me. Anyways, the message got interrupted cause I wrote the wrong thing, Ctrl+Z'd, and some how it all got messed up!
So here I am. The board really resembled the chat room for than anything, but I felt that fun again, of feeling connected. Like the internet, you know I just felt it in real life when seeing a review on Amazon and it was only from May 20-something of this year! So I felt that old feeling that the internet used to give - how you'd be a part of something, how there was someone out there, waiting to hear from you. I miss it. Luckily, now I'm so smart I can actually build the next "great" site! I plan on doing it to.. but it all comes back to QB for me, and those fun times we had. You gotta go with simplicity even if you are applying it to the new technologies. Everyone uses all these hacks to make stuff happen.. I want real programming!
Well, if anyone remembers me, that's a good thing. It's been soooo long, and it eats at you, right in the center of your heart. Wanting it to be like it used to be, when it was really fun, really happening.. but eventually, you just sorta realize that you have to keep voyaging on into the night, looking for that ray of hope at the end of the tunnel, or something like that!
Well, that's all for now. I'm not even sure if this is what I was "supposed" to find, haha.. I'll keep looking for a forum that looked like the one in the dream, although it never existed in my experience before... gee, I really miss being able to write on a board without logging in. It's coming back, though, ;).
-Jon

Posted on Aug 10, 2012, 7:34 PM

Respond to this message   

Return to Index


* Welcome back.

by (Login MCalkins)
Moderator

Posted on Aug 10, 2012, 7:50 PM

Respond to this message   

Return to Index


*Yeah, hi again!

by (Login qb432l)
R

*

Posted on Aug 10, 2012, 8:48 PM

Respond to this message   

Return to Index


HAHA YOURE CRAZY :-p

by gopus (no login)

Posted on Sep 10, 2012, 4:47 AM

Respond to this message   

Return to Index


Rewrit from scratch

by (no login)

How to rewrite from scratch ?

I have a 48 kb program, and i should rewrite it from scratch, because i though about some improvements, but it's just too much work... Every thing could be improved, the display for information, help, etc, the way buffer are handle for restoring the screen, the data structure, implement more user configuration, but there are so much variables, that the only thing is to pull a part the whole program, in all it parts, with a list of variables, and trying to build a new program from this collection of sub-routines...!

Prior i though about ending all lines with a

: line_number = line_number + 1

to spot unused lines of code.

Any way, maintaining code is a big deal, should be thought about while writing the first version, and i don't know so much how...

I feel just scared about this !

Posted on Aug 10, 2012, 6:28 AM

Respond to this message   

Return to Index


I would do one piece at a time....

by Solitaire (Login Solitaire1)
S

and save each major change by a different version number, making sure it works correctly. That way, if the next change doesn't work out, you can go back to the previous version and start again.

Clean up the main program first, and see that each call to a subprocedure is clearly marked. Use a DO loop with a menu in the main program and SELECT CASE to call each of the subs. Declare each of the variables by type at the top of the main program.

Then do the subprocedures one by one, making sure arguments and parameters match when variables are passed down from the main program. Declare all local variables by type in the sub.

Good luck.

Posted on Aug 10, 2012, 9:56 AM

Respond to this message   

Return to Index


Good advice, Solitaire

by Moneo (no login)

especially about changing and testing each changed piece (version) at a time. This way you don't have to re-think the entire program all at once.

Posted on Sep 21, 2012, 10:13 AM

Respond to this message   

Return to Index


consider this:

by AlGoreIthm (no login)

It's not essential to have an individual line counter to track which lines are being used, not used, or used the most:

If you set your code up with IF - THEN / END IF sections, you will be able to track which blocks of code are being used the most. Ex:

CONST TRUE = 1
CONST FALSE = 0

status% = TRUE ' or FALSE

IF status% = TRUE THEN
section1 = section1 + 1
..........
..........
..........
' possibility of one of these lines of code to change the status% variable
which in turn will decide if the next section will execute or not
END IF

IF status% = FALSE THEN
section2 = section2 + 1
..........
..........
..........
' possibility of one of these lines of code to change the status% variable etc.
END IF


This type of organization will allow you to track which areas are most active or not active, rather than line by line which is probably too much information anyway.

Where you have nested IF THEN / END IFs, you can add secondary counters like section1a, section1b, section2a, section2b etc.

At the end of execution, a listing of variables section1, section2, and all others will show where the execution spent the most time during the run, and any values of 0 will show that the related blocks of code were not used at all during execution.

Of course this type of technique should be understood as a programming and debugging aid, once the program is complete the section variables should probably all be removed unless you want to go on measuring performance even after your program is completed and in proper working order.

Posted on Aug 10, 2012, 11:31 AM

Respond to this message   

Return to Index


Hel with QBASIC errors

by (no login)

Hi guys!
I'm fairly new to QBASIC and i'm trying to make my first full program. The program has three "save slots" and a variable that makes sure that the player is playing in one of the save slots before they can play the game. It is this variable that is giving me difficulty.

This is the first line of code:

logincheck$ = "no"

And it has an error which says "SELECT without END SELECT"
Can anyone help me? I'll post the full code below for anyone who can help further.
Thanks,
Jake. :)

logincheck$ = "no"
clearscreen:
CLS
menu:
PRINT "Welcome to Learn French!"
PRINT "Please select an option!"
PRINT "Load Profile"
PRINT "New Profile"
PRINT "Start Learning"
PRINT "Exit"
INPUT "...", option1$
IF option1$ = "Load Profile" THEN GOTO load
IF option1$ = "New Profile" THEN GOTO NEW
IF option1$ = "Start Learning" THEN GOTO BEGIN
IF option1$ = "Exit" THEN GOTO FIN1
GOTO wrong
END
NEW:
PRINT "Welcome to the create an account wizard!"
PRINT "________________________________________"
PRINT "Please select a save slot:"
PRINT "1", oneavailability$
PRINT "2", twoavailability$
PRINT "3", treavailability$
INPUT "...", slotselectnew$
IF slotselectnew$ = "1" THEN GOTO newslotone
IF slotselectnew$ = "2" THEN GOTO newslottwo
IF slotselectnew$ = "3" THEN GOTO newslottre
GOTO wrong
newslotone:
INPUT "Please select a name...", name1$
OPEN "profile1.txt" FOR OUTPUT AS #7
WRITE #7, name1$
CLOSE #7
OPEN "p1points.txt" FOR OUTPUT AS #8
WRITE #8, "0"
CLOSE #8
points = 0
INPUT "New account has been created successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
newslottwo:
INPUT "Please select a name...", name1$
OPEN "profile2.txt" FOR OUTPUT AS #9
WRITE #9, name1$
CLOSE #9
OPEN "p2points.txt" FOR OUTPUT AS #10
WRITE #10, "0"
CLOSE #10
points = 0
INPUT "New account has been created successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
newslottre:
INPUT "Please select a name...", name1$
OPEN "profile3.txt" FOR OUTPUT AS #11
WRITE #11, name1$
CLOSE #11
OPEN "p3points.txt" FOR OUTPUT AS #12
WRITE #12, "0"
CLOSE #12
points = 0
INPUT "New account has been created successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
load:
PRINT "Welcome to the load an account wizard!"
PRINT "________________________________________"
PRINT "Please select a save slot:"
PRINT "1", oneavailability$
PRINT "2", twoavailability$
PRINT "3", treavailability$
INPUT "...", slotselectload$
IF slotselectload$ = "1" THEN GOTO loadslotone
IF slotselectload$ = "2" THEN GOTO loadslottwo
IF slotselectload$ = "3" THEN GOTO loadslottre
GOTO wrong
loadslotone:
OPEN "profile1.txt" FOR INPUT AS #1
INPUT #1, name1$
CLOSE #1
OPEN "p1points.txt" FOR INPUT AS #2
INPUT #2, points
CLOSE #2
INPUT "Loaded Successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
loadslottwo:
OPEN "profile2.txt" FOR INPUT AS #3
INPUT #3, name1$
CLOSE #3
OPEN "p2points.txt" FOR INPUT AS #4
INPUT #4, points
CLOSE #4
INPUT "Loaded Successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
loadslottre:
OPEN "profile3.txt" FOR INPUT AS #5
INPUT #5, name1$
CLOSE #5
OPEN "p3points.txt" FOR INPUT AS #6
INPUT #6, points
CLOSE #6
INPUT "Loaded Successfully! Press ENTER to continue...", cont1$
logincheck$ = "yes"
GOTO clearscreen
END
BEGIN:
IF logincheck$ = "no" THEN GOTO load
PRINT "Welcome to Learn French, "; name1$
PRINT "_______________________________"
PRINT "Instructions:"
PRINT "To play this game you must type the definition of the French word in "
PRINT "English to score a point, use a dictionary only if you have to!"
PRINT "To EXIT and SAVE the game at any time, you should type EXIT "
PRINT "into the answer box."
INPUT "Are you ready??? Press ENTER to continue...", cont1$
wordslist:
CLS
PRINT "You have "; points; "points!"

question = INT(RND * 6 + 1)
SELECT CASE question



CASE 1
PRINT "Bonjour"
INPUT "English Translation: ", answer1$
IF answer1$ = "hello" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist
CASE 2
PRINT "Bon"
INPUT "English Translation: ", answer1$
IF answer1$ = "good" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist

CASE 3
PRINT "Mal"
INPUT "English Translation: ", answer1$
IF answer1$ = "bad" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist

CASE 4
PRINT "D'accord"
INPUT "English Translation: ", answer1$
IF answer1$ = "ok" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist

CASE 5
PRINT "un"
INPUT "English Translation: ", answer1$
IF answer1$ = "one" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist

CASE 6
PRINT "deux"
INPUT "English Translation: ", answer1$
IF answer1$ = "two" THEN points = points + 1 ELSE GOTO wronganswer
PRINT "Well Done!"
INPUT "Press ENTER for another Question...", cont1$
GOTO wordslist

wronganswer:
PRINT "That's not right!"
INPUT "Press ENTER for another question...", cont1$






END
wrong:
PRINT "Incorrect Menu option! Please restart the program!"
FIN1:
END

Posted on Aug 6, 2012, 2:44 AM

Respond to this message   

Return to Index


Logically, add END SELECT, if it tells you so

by (no login)

END SELECT

and

CASE ELSE for any other responses you want to deal with,

Now the hint someone gave me is to put the Selection routine inside a SUB... anyway.

Posted on Aug 6, 2012, 6:10 AM

Respond to this message   

Return to Index


Thanks

by (no login)

Thanks I'll try it once I get round to editing it and then I'll post back with any changes I've made :)

Posted on Aug 8, 2012, 1:51 AM

Respond to this message   

Return to Index


Some suggestions

by Solitaire (Login Solitaire1)
S

You have a multitude of bugs in your program. Here are a few simple suggestions to start you off:

1. Add
END SELECT
just before the "wronganswer:"

2. Add
GOTO wordslist
and delete the END in the wronganswer section.

3. Add
IF cont1$ = "EXIT" THEN END
right after wordslist:
This will allow user to end the program after any of the words.

4. User input of a phrase to make a selection is very tricky. It's best to present a single number or letter for the user to enter. Here is how you can do it:

menu:
PRINT "Welcome to Learn French!"
PRINT "Please select an option!"
PRINT "1: Load Profile"
PRINT "2: New Profile"
PRINT "3: Start Learning"
PRINT "4: Exit"
INPUT "...", option1$
IF option1$ = "1" THEN GOTO load
IF option1$ = "2" THEN GOTO NEW
IF option1$ = "3" THEN GOTO BEGIN
IF option1$ = "4" THEN GOTO FIN1

===========================================================

The overall design of your program leaves a great deal to be desired. If you are starting out with QB, then you should be learning how to use structured programming and NOT using GOTO at all. At the least, you should use subroutines with GOSUB and RETURN for each of the separate sections.

Here is a simple example of a menu with subroutines. It uses a DO loop to repeat. Copy it and paste it into a new QB program to see how it works. Then see if you can adapt it to use with your own program.

============================================================
DO
  CLS
  PRINT "MENU"
  PRINT : PRINT "1- Chess"
  PRINT "2- Checkers"
  PRINT "3- Monopoly"
  PRINT "4- Quit"
  PRINT : INPUT "Enter 1, 2, 3, or 4: ", choice$
  CLS
  SELECT CASE choice$
    CASE "1"
      GOSUB Chess
    CASE "2"
      GOSUB Checkers
    CASE "3"
      GOSUB Monopoly
    CASE "4"
      END
  END SELECT
LOOP

Chess:
PRINT "Play chess here."
INPUT "Enter to return to menu. ", E$
RETURN

Checkers:
PRINT "Play checkers here."
INPUT "Enter to return to menu. ", E$
RETURN

Monopoly:
PRINT "Play Monopoly here."
INPUT "Enter to return to menu. ", E$
RETURN


Posted on Aug 6, 2012, 11:32 AM

Respond to this message   

Return to Index


Thanks

by (no login)

Thanks, I'll try all these suggestions, I've only just started really and I am trying to learn some basics as I go. Thanks for the advice anyway :)

Posted on Aug 8, 2012, 1:55 AM

Respond to this message   

Return to Index


QB64 and MySQL

by (no login)

Hi all;

I am in desperate need for some example code where QB64 can read a mysql db but ALL rows - the examples on the QB64 forum seem to only access the first row

for example, if data in SQL is

1, bob, toronto, canada
2, bill, hamilton, canada
3, frank, newyork, usa

the only thing the demo program shows is

bob
bill
frank


Please help ! any demo code is appreciated.

Posted on Aug 4, 2012, 2:38 PM

Respond to this message   

Return to Index


legacy program

by (no login)

i wrote a program in qb, 30 yrs ago that runs ok up to windows xp, never had vista. just got win7 home premium 64. can't run program, downloaded qb64 and freebasic, program comes up in gibberish. any thoughts on how to run my progam ?

(converted to lowercase - mc)

Posted on Aug 3, 2012, 1:11 PM

Respond to this message   

Return to Index


Your program is saved in Binary Format

by anon (no login)

Binary format is a tokenized format that saves space and makes QuickBasic load files faster. However, standard programs (like Notepad, Emacs, QB64, etc.) cannot read it, because it is not text.
Open it in QB4.5 and resave in "Text format" using the save as command.
Alternatively, there is a QB45 binary save decoder here: http://www.qb64.net/forum/index.php?topic=1771.0
which is available as BASIC source code.

Posted on Aug 3, 2012, 2:27 PM

Respond to this message   

Return to Index


* great, change to text solved problem, thanks

by joe (no login)

(added asterisk - mc)

Posted on Aug 4, 2012, 5:39 AM

Respond to this message   

Return to Index


*Please do NOT post in all capital letters. It's the same as shouting and considered rude.

by Solitaire (no login)

Posted on Aug 3, 2012, 11:36 PM

Respond to this message   

Return to Index


* get a life

by joe (no login)

(added asterisk - mc)

Posted on Aug 4, 2012, 5:38 AM

Respond to this message   

Return to Index


*If you say "get a life" why are you here annoying others?

by angros47 (no login)

Posted on Aug 5, 2012, 4:09 AM

Respond to this message   

Return to Index


Did you know that using ALL CAPITAL letters saved space

by Anon (no login)

On certain magnetic tape storage devices, such as cassete tapes on the original IBM PC (most people bought the IBM PC with a disk drive). The original IBM PC used Frequency Shift Keying with each bit represented by a single pulse. A 1 took more time than a 0 due to a lower frequency. So ALL CAPS used less tape space due to fewer one bits.

Posted on Aug 4, 2012, 10:07 AM

Respond to this message   

Return to Index


Forum conventions

by Solitaire (Login Solitaire1)
S

Interesting information regarding caps, but they do not save space in the forum posts. It is considered rude to shout, and using all caps is the same as shouting, according to forum conventions. This rule is pointed out to new posters who may not be aware of it.

The "get a life" comment joe posted was very rude. As one of the forum moderators, I was tempted to delete it.

In this forum, the convention is to use an asterisk * before the title if there is no content inside. This alerts users that they don't have to bother clicking on the title.

Welcome to the forum, and hope you can benefit from it as well as make any valuable contributions.

Please log in with a username instead of using anonymous. Thank you.

Posted on Aug 4, 2012, 10:58 AM

Respond to this message   

Return to Index


rules (URL) (edited)

by (Login MCalkins)
Moderator

The rules:

http://www.network54.com/Forum/171757/message/1067226652/How+to+post+on+the+QBasic+Forum+without+getting+flamed-

My opinions regarding them:

I would say that rules 4 and 5 should be lax within the bounds of common sense. For example, if your original topic has scrolled off of the first page, it might be good to start a new one, on subforums that don't bump topics to the top. I've also seen quite a few regulars change their "handle" (examples: Artelius and ChronoKitsune), or temporarily use joke handles (examples: Pete and Clippy), or post anonymously (example: ChronoKitsune). I've done it a few times. However, people who post anonymously shouldn't be too surprised if they get treated a little differently... Also, I don't think people should use anonymity as an excuse to be rude.

If a poster is anonymous, you don't have much "state" to work with. You don't know what the person's experience and capabilities are. Is he a beginner that you have to explain everything to, or is he an experienced programmer that you can give a more technical answer to? Sometimes, it is obvious from the post. But then, even within the same topic, you might not know how many "Anonymous"s you have. "Anon" and "Anonymous from Hungary" are a little more distinctive.

Personally, I like having something to identify someone by, if I am having a conversation with him. (Replying to a post is like having a conversation.) However, I recognize that some people might prefer various degrees of anonymity.

Regards,
Michael

P.S. I am getting cached versions of modified pages. I am having to manually refresh.

Posted on Aug 5, 2012, 1:41 PM

Respond to this message   

Return to Index


*Gopus will handle that, he's the best :-)

by (no login)

*

Posted on Aug 6, 2012, 8:56 AM

Respond to this message   

Return to Index


youre the best. asterickz!

by gopus (no login)

Posted on Sep 10, 2012, 4:42 AM

Respond to this message   

Return to Index

 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement