Author Topic: My wish  (Read 131 times)

My wish
« on: July 02, 2018, 01:03:56 PM »
I want something for you all. Why not say this with program :-D






Code: [Select]
REDIM P0(0, 0) AS INTEGER
REDIM p1(0, 0) AS INTEGER
REDIM p2(0, 0) AS INTEGER
REDIM p3(0, 0) AS INTEGER
REDIM p4(0, 0) AS INTEGER
REDIM p5(0, 0) AS INTEGER
REDIM p6(0, 0) AS INTEGER
DIM SHARED image AS LONG, ext

a& = _NEWIMAGE(800, 600, 32): _FULLSCREEN
SCREEN a&
CLS , _RGB32(6, 89, 244)
image& = _NEWIMAGE(50, 50, 32)

_PUTIMAGE , CB&, image&
_CLEARCOLOR _RGB32(0, 0, 0), image&
_FREEIMAGE CB&

text$ = "Petr"
TextToArray P0(), text$
TextToArray p1(), "wish"
TextToArray p2(), "you"
TextToArray p3(), "a"
TextToArray p4(), "lot"
TextToArray p5(), "of"
TextToArray p6(), "fun!"

m = (LEN(text$) * 8) / 2
n = 16
o = 12
p = 4
q = 12
r = 8
s = 16

DO
    ToScreen P0(), m, 20
    ToScreen p1(), n, 20
    ToScreen p2(), o, 20
    ToScreen p3(), p, 20
    ToScreen p4(), q, 20
    ToScreen p5(), r, 20
    ToScreen p6(), s, 20
LOOP UNTIL _KEYHIT = 27
SCREEN 0
_FREEIMAGE image&
ERASE P0, p1, p2, p3, p4, p5, p6
END

SUB ToScreen (array() AS INTEGER, lenght AS _BYTE, speed AS _UNSIGNED _BYTE)
    FOR sx = -15 TO 20 STEP .4
        CLS , _RGB32(6, 89, 244)
        DrawArray array(), _WIDTH / 2 - (sx * lenght), _HEIGHT / 2 - sx * 8, sx, sx
        _LIMIT speed
        _DISPLAY
    NEXT sx
    _DELAY .5
END SUB

SUB DrawArray (p() AS INTEGER, posx, posy, roztecx, roztecy)
    MaxX = UBOUND(p, 1): MaxY = UBOUND(p, 2)
    MinX = LBOUND(p, 1): MinY = LBOUND(p, 2)
    FOR y = MinY TO MaxY
        FOR x = MinX TO MaxX
            IF p(x, y) THEN _PUTIMAGE (posx + (x * roztecx), posy + (y * roztecy)), image&
            IF _KEYHIT = 27 THEN pad p(), x, y, roztecx, roztecy, posx, posy
    NEXT x, y
END SUB

SUB pad (p() AS INTEGER, x AS INTEGER, y AS INTEGER, roztecx, roztecy, posx, posy)
    MaxX = UBOUND(p, 1): MaxY = UBOUND(p, 2)
    MinX = LBOUND(p, 1): MinY = LBOUND(p, 2)

    DO WHILE Down < 800
        CLS , _RGB32(6, 89, 244)
        FOR y = MinY TO MaxY
            Down = Down + RND * 5
            FOR x = MinX TO MaxX
                IF p(x, y) THEN _PUTIMAGE (posx + (x * roztecx), (posy + (y * roztecy)) + Down), image&
            NEXT
        NEXT
        _LIMIT 15
        _DISPLAY
    LOOP
    SCREEN 0
    _FREEIMAGE image&
    END
END SUB

SUB TextToArray (array( x , y) AS INTEGER, text AS STRING)
    v& = _NEWIMAGE(LEN(text$) * 8, 16, 256)
    REDIM array(LEN(text$) * 8, 16)
    _DEST v&
    _PRINTSTRING (1, 1), text$, v&
    _DEST 0
    _SOURCE v&
    FOR y = 0 TO 15
        PRINT
        FOR x = 0 TO 8 * LEN(text$) - 1
            IF POINT(x, y) THEN array(x, y) = 1
    NEXT x, y
    _DEST 0: _SOURCE 0
END SUB

FUNCTION CB&
    CB& = _NEWIMAGE(40, 40, 256)
    FOR F = 31 TO 16 STEP -1
        rd = rd + 1
        FOR R = 0 TO _PI(2) STEP .01
            _DEST CB&
            CIRCLE (SIN(R) + 20, COS(R) + 20), rd, F
    NEXT R, F
END FUNCTION
Coding is relax (At least sometimes)

Offline johnno56

  • Live long and prosper.
Re: My wish
« Reply #1 on: July 02, 2018, 06:31:43 PM »
Cool... Thank you!

J
Logic is the beginning of wisdom.

Re: My wish
« Reply #2 on: July 02, 2018, 09:27:42 PM »
Hi Petr (and all!),

I have coded a reply! After extracting zip file, load and run .bas file, press p for play...
« Last Edit: July 02, 2018, 09:31:08 PM by bplus »
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82