Qbasicnews.com
February 25, 2021, 10:24:10 PM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: here's something handy for screen 12 sprites  (Read 1974 times)
dumbledore
Ancient Guru
****
Posts: 520



WWW
« on: February 21, 2005, 03:15:32 AM »

bsaved qb screen 12 sprites -> bsaved fb screen 12 sprites.
(compile this with fbc, of course)
Code:
DECLARE FUNCTION Dec$ (num$)
DECLARE SUB RipImageData (Array%(), ArrayIndex%(), i%, PixelData$())
DECLARE FUNCTION Math.Ceiling% (num!)
DECLARE FUNCTION Dec2Bin$ (a%)
'$DYNAMIC
DEFINT A-Z
CLS
line input "qb - bsaved image file?", qb$
line input "fb - bsaved output file?", otpt$
SCREEN 12
open qb$ for binary as #1
dim shared w as integer,h as integer
b$="       ":get #1,,b$
b$=" ":get #1,,b$:lo=asc(b$):get #1,,b$:hi=asc(b$):w=lo+hi*256
get #1,,b$:lo=asc(b$):get #1,,b$:hi=asc(b$):h=lo+hi*256
DIM Square(0 TO (4+(w*h)+3)\4-1), SquarePix$(1 TO 2)
DIM SquareIndex(1)
SquareIndex(1) = 1
RipImageData Square(), SquareIndex(), 1, SquarePix$()
FOR y = 1 TO h
     FOR X = 1 TO w
          PSET (X - 1, y - 1), VAL(SquarePix$((X - 1) + (y - 1) * w + 1))
     NEXT X
NEXT y
get(0,0)-(w-1,h-1),square(0)
bsave otpt$ varptr(square(0)) 4+(w*h)
sleep

REM $STATIC
FUNCTION Dec2Bin$ (a)
DIM m AS DOUBLE
m = 1
FOR n = 0 TO 7
IF (a AND m) = 0 THEN
  b$ = "0" + b$
ELSE
  b$ = "1" + b$
END IF
m = m + m
NEXT

Dec2Bin$ = b$
END FUNCTION

FUNCTION Dec$ (num$)
num% = VAL(num$)
FOR i = 0 TO LEN(num$) - 1
     decc% = decc% + VAL(MID$(num$, LEN(num$) - i, 1)) * 2 ^ i
NEXT i
Dec$ = LTRIM$(STR$(decc%))
END FUNCTION

FUNCTION Math.Ceiling% (num!)
IF INT(num!) <> num! THEN Math.Ceiling% = INT(num!) + 1 ELSE Math.Ceiling% = num!
END FUNCTION

SUB RipImageData (Array%(), ArrayIndex%(), i%, PixelData$())
'this code was originally written by relsoft for screen 13, but i ported it to
'screen 9 because it has a higher resoution.  code should be pretty much self-
'explanatory (better than i could try to explain using comments!)
'by relsoft
'ported by the unknown qb programmer
numineachgroup = Math.Ceiling%(w / 8)
DIM DataArray$(1 TO h * 4 * numineachgroup)
REDIM PixelData$(1 TO UBOUND(DataArray$) * 8)
b$=" "
FOR X = 1 TO numineachgroup * 4 * h
     get #1,,b$
     C%=asc(b$)
     DataArray$(X) = Dec2Bin$(C%)
NEXT X
FOR g = 1 TO h
     FOR H1 = 1 TO 4
          FOR z = 1 TO numineachgroup
               FOR j = 1 TO 8
                    a = j + (z - 1) * 8 + (g - 1) * (numineachgroup * 8 - (8 - w MOD 8))
                    b = z + (H1 - 1) * numineachgroup + (g - 1) * Math.Ceiling%(w / 8) * 4
                    PixelData$(a) = MID$(DataArray$(b), j, 1) + PixelData$(a)
                    IF z = numineachgroup AND j = w MOD 8 THEN EXIT FOR
               NEXT j
          NEXT z
     NEXT H1
NEXT g
FOR z = 1 TO UBOUND(PixelData$)
     PixelData$(z) = Dec$(PixelData$(z))
NEXT z
END SUB

 :wink:
edit:  forgot to add inputs... :oops:
Logged

ttp://m0n573r.afraid.org/
Quote from: "HexDude"
quote: "<+whtiger> you... you don't know which way the earth spins?" ... see... stupidity leads to reverence, reverence to shakiness, shakiness to... the dark side
...phear
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!