Weekly Qbasic and Qb64 Lesson Topics
January 21, 2018, 12:53:26 pm
Welcome, Guest. Please login or register.
Did you miss your activation email?

Login with username, password and session length
News: Want to see a specific Tutorial? ASK!
 
  Home Help Search Arcade Links Staff List Login Register  

Converts a .BMP to DRAW ,that is a working qb64 .BAS


Pages: [1]
  Print  
Author Topic: Converts a .BMP to DRAW ,that is a working qb64 .BAS  (Read 1073 times)
GarrisonRicketson
Admin
Administrator
Hero Member
*****
Posts: 583



WWW
« on: June 15, 2011, 11:01:26 pm »


Converts a .BMP to DRAW ,that is a working qb64 .BAS
---------------------
Quark, and also everyone may find this interesting,...It was written by Dav,
http://www.qbasicnews.com/dav/
Code:
'============
'BMP2DRAW.BAS
'============
'Coded by Dav

'BMP2DRAW is a utility to convert a 320x200, 256 BMP image to
'a BAS program containing DRAW statements that, when run, will
'recreate the image on screen exactly as the BMP image. Pallette
'data is also converted and is saved in the BAS code.

'(This is just a BMP loader combined with the DRAWCAP routine)

'===========================================================
' NOTE: Only accepts 320x200, 256 color, uncompressed BMP's
'===========================================================

'I use this often to put images in my compiled programs without
'having to distribute the BMP file along with the compiled EXE.

'Some helpful info...

'The resulting BAS code is often very large - too large most times
'to put in your main code, so to overcome that you should load the
'BAS code as a module and easily call the SUB that draws the image.
'By using this method you could have many images inside your EXE.

'Oh yeah, this utility is used for SCREEN 13 only.


DEFINT A-Z
DECLARE SUB DRAWCAP (x1%, y1%, x2%, y2%, file$)

'=== Ask user for the BMP

LINE INPUT "Name of BMP to use -> ", BMP$
IF BMP$ = "" THEN END

'=== Ask user for name of BAS to create

LINE INPUT "BAS file to create -> ", BAS$
IF BAS$ = "" THEN END

'=== check if BMP file exists
OPEN BMP$ FOR BINARY AS #2

IF LOF(2) = 0 THEN
    PRINT UCASE$(BMP$); " not found."
    CLOSE 2: KILL BMP$: END
END IF

'=== check BMP format...

IF INPUT$(2, 2) <> "BM" OR LOF(2) <> 65078 THEN
    PRINT "Invalid BMP or format not accepted."
    CLOSE 2: END
END IF

'=== Now load Pallette data from BMP

SCREEN 13: SEEK 2, 55: OUT 968, 0
FOR c% = 1 TO 256: b$ = INPUT$(4, 2)
    OUT 969, ASC(MID$(b$, 3, 1)) \ 4
    OUT 969, ASC(MID$(b$, 2, 1)) \ 4
    OUT 969, ASC(MID$(b$, 1, 1)) \ 4
NEXT

'=== Now load image data to screen

FOR y% = 199 TO 0 STEP -1
    Row$ = INPUT$(320, 2)
    FOR x% = 0 TO 319
        PSET (x%, y%), ASC(MID$(Row$, x% + 1, 1))
    NEXT
NEXT
CLOSE 2

'=== Now, call the DRAWCAP sub to save image to a BAS file.
'=== We'll save entire screen image (0,0 - 310,199).

DRAWCAP 0, 0, 319, 199, BAS$

'=== Show the user something has happened

SCREEN 0: WIDTH 80, 25
PRINT UCASE$(BAS$); " saved."

'=== All good things must come to an end.
'=== (I wish bad ones did too.)

END

SUB DRAWCAP (x1%, y1%, x2%, y2%, file$)

'=== This is the new DRAWCAP routine posted earlier - Version 2
'=== It saves the given area of screen to a BAS code containing
'=== DRAW statements that recreates the same screen when it's run.

'=== Open output file

OPEN file$ FOR OUTPUT AS 1

PRINT #1, "SCREEN 13"

'=== Grab and save current pallette

PRINT #1, "A$="; CHR$(34); CHR$(34); ":";
PRINT #1, "A$="; CHR$(34);

OUT 967, 0: b% = 0
FOR c% = 1 TO 768
    Pal$ = CHR$(INP(969)): b% = b% + 1
    PRINT #1, RIGHT$("0" + HEX$(ASC(Pal$)), 2);
    IF b% = 30 THEN
        PRINT #1,: PRINT #1, "A$ = A$+"; CHR$(34);
        b% = 0
    END IF
NEXT: PRINT #1,

'=== Write routine that loads saved pallette

PRINT #1, "c% = 0"
PRINT #1, "FOR i%=1 TO LEN(A$) STEP 6"
PRINT #1, " OUT 968, c%:c% = c% +1"
PRINT #1, " OUT 969, VAL("; CHR$(34); "&H"; CHR$(34); "+MID$(A$,i%,2))"
PRINT #1, " OUT 969, VAL("; CHR$(34); "&H"; CHR$(34); "+MID$(A$,i%+2,2))"
PRINT #1, " OUT 969, VAL("; CHR$(34); "&H"; CHR$(34); "+MID$(A$,i%+4,2))"
PRINT #1, "NEXT:A$="; CHR$(34); CHR$(34)

'=== Capture the given area as DRAW statements.

FOR y% = y1% TO y2%
    SL% = 1
    PRINT #1, "PSET("; LTRIM$(RTRIM$(STR$(x1%))); ",";
    PRINT #1, LTRIM$(RTRIM$(STR$(y%))); "):";
    PRINT #1, "DRAW"; CHR$(34);
    FOR x% = x1% TO x2%
        Clr% = POINT(x%, y%)
        IF Clr% = POINT(x% + 1, y%) THEN
            c% = 2: x% = x% + 2
            DO WHILE POINT(x%, y%) = Clr%
                c% = c% + 1: x% = x% + 1
                IF x% = x2% THEN EXIT DO
                IF c% = y2% THEN EXIT DO
            LOOP
            PRINT #1, "C"; LTRIM$(RTRIM$(STR$(Clr%))); "R"; LTRIM$(RTRIM$(STR$(c%)));
            x% = x% - 1
        ELSE
            PRINT #1, "C"; LTRIM$(RTRIM$(STR$(Clr%))); "R1";
        END IF
        SL% = SL% + 1
        IF SL% = 15 AND x% < x2% THEN
            PRINT #1, CHR$(32)
            PRINT #1, "DRAW"; CHR$(34);
            SL% = 1
        END IF
    NEXT
    PRINT #1, CHR$(34)
    '=== erase what was saved (for show)
    LINE (x1%, y%)-(x2%, y%), 0
NEXT

CLOSE 1

END SUB
 
However the File is pretty BIG !.... I have attached it, all you need to do unzip,to your qb64 folder and  compile it in qb64.
 Enjoy, from Garry
Report Spam   Logged

Social Buttons

GarrisonRicketson
Admin
Administrator
Hero Member
*****
Posts: 583



WWW
« Reply #1 on: June 15, 2011, 11:14:13 pm »

This is how it looks on the screen:

From Garry
Report Spam   Logged


Pages: [1]
  Print  
 
Jump to:  

Powered by EzPortal
Bookmark this site! | Upgrade This Forum
SMF For Free - Create your own Forum

Buy traffic for your forum/website
traffic-masters
Powered by SMF | SMF © 2016, Simple Machines