×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

QBasic FAQ

Graphical Techniques in QB

3D Graphics Using Qbasic by Alt255
Posted: 8 Jul 00

    Okay, so you want to create realistic 3D graphics with Qbasic. You can do it with the standard MS QB... but there is a trade-off. You have to do it in grayscale.
    The following code offers an example of palette shifting. The code in the DO...LOOP is merely offered as a sample of the graphic manipulation that can be performed in Qbasic.
    You would have to write many lines of code to draw a realistic human face with Qbasic... but it is entirely possible.


' $DYNAMIC
DEFINT A-Z
DECLARE SUB GrayScale ()
DECLARE FUNCTION RandomInt (Lb, Ub)

'The following arrays will be used to
'shift the Qbasic color palette.
REDIM PalArray(0 TO 128) AS LONG
REDIM DefPal(16, 3) AS INTEGER

SCREEN 12'640x480
CALL GrayScale 'shift from color to grayscale

DO
    'This loop creates 3D organic shapes
    'at random screen locations until the user taps a key.
    Cx = RandomInt(0, 639) 'get a random center X and Y
    Cy = RandomInt(0, 479)
    CcircInc = 1
    Ccirc = 1
    XC = RandomInt(0, 1)
    YC = RandomInt(0, 1)
    IF XC THEN cxPos = -1 ELSE cxPos = 1
    IF YC THEN cyPos = -1 ELSE cyPos = 1
    'Asp! is random mask for the circle commands that follow.
    Asp! = 5! / (RandomInt(2, 15))
    cxDir = RandomInt(1, 2): IF cxDir = 2 THEN cxDir = -1
    cyDir = RandomInt(1, 2): IF cyDir = 2 THEN cyDir = -1
    Rend = RandomInt(4, 64) 'pick a random size for the organic
    FOR Re = 1 TO 1
        FOR R = 1 TO Rend
            IF INKEY$ <> "" THEN 'The user has tapped a key.
                 SCREEN 0 'Revert to text mode.
                 END 'Quit the program.
            END IF
            Ccirc = Ccirc + CcircInc
            IF Ccirc > 15 THEN Ccirc = 15: CcircInc = -1
            IF Ccirc < 1 THEN Ccirc = 1: CcircInc = 1
            CIRCLE (Cx, Cy), R, Ccirc, , , Asp!
            CIRCLE (Cx + cxPos, Cy + cyPos), R, 16 - Ccirc, , , Asp!
        NEXT
    NEXT
LOOP

SUB GrayScale
'This subroutine shifts the 16 color Qbasic palette so that
'references to each color result in shades of gray.
REDIM PalArray(0 TO 128) AS LONG
REDIM DefPal(16, 3) AS INTEGER

DefPal(1, 1) = 42: DefPal(1, 2) = 42: DefPal(1, 3) = 42
Intense = 1
FOR Re = 2 TO 16
     DefPal(Re, 1) = Intense: DefPal(Re, 2) = Intense: DefPal(Re, 3) = Intense
     Intense = Intense + 4
     IF Re = 15 THEN Intense = 63
NEXT
FOR Re = 1 TO 16
     PalArray(Re) = (65536 * DefPal(Re, 1)) + (256 * DefPal(Re, 2)) + DefPal(Re, 3)
NEXT

FOR Re = 17 TO 128
     PalArray(Re) = -1
NEXT
PALETTE USING PalArray(1)

END SUB


FUNCTION RandomInt (Lb, Ub)
'This function just returns a random integer value from Lb to Ub.
     RandomInt = INT((Ub - Lb + 1) * RND + Lb)
END FUNCTION

Try experimenting with the other graphic commands. You can create some interesting textures using 16 shades of gray and the bit-mask parameter.




Back to QBasic FAQ Index
Back to QBasic Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close