Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: Petr on July 02, 2018, 12:03:56 pm

Title: My wish
Post by: Petr on July 02, 2018, 12:03:56 pm
I want something for you all. Why not say this with program :-D






Code: QB64: [Select]
  1. REDIM P0(0, 0) AS INTEGER
  2. REDIM p1(0, 0) AS INTEGER
  3. REDIM p2(0, 0) AS INTEGER
  4. REDIM p3(0, 0) AS INTEGER
  5. REDIM p4(0, 0) AS INTEGER
  6. REDIM p5(0, 0) AS INTEGER
  7. REDIM p6(0, 0) AS INTEGER
  8. DIM SHARED image AS LONG, ext
  9.  
  10. a& = _NEWIMAGE(800, 600, 32): _FULLSCREEN
  12. CLS , _RGB32(6, 89, 244)
  13. image& = _NEWIMAGE(50, 50, 32)
  14.  
  15. _PUTIMAGE , CB&, image&
  16. _CLEARCOLOR _RGB32(0, 0, 0), image&
  18.  
  19. text$ = "Petr"
  20. TextToArray P0(), text$
  21. TextToArray p1(), "wish"
  22. TextToArray p2(), "you"
  23. TextToArray p3(), "a"
  24. TextToArray p4(), "lot"
  25. TextToArray p5(), "of"
  26. TextToArray p6(), "fun!"
  27.  
  28. m = (LEN(text$) * 8) / 2
  29. n = 16
  30. o = 12
  31. p = 4
  32. q = 12
  33. r = 8
  34. s = 16
  35.  
  37.     ToScreen P0(), m, 20
  38.     ToScreen p1(), n, 20
  39.     ToScreen p2(), o, 20
  40.     ToScreen p3(), p, 20
  41.     ToScreen p4(), q, 20
  42.     ToScreen p5(), r, 20
  43.     ToScreen p6(), s, 20
  46. _FREEIMAGE image&
  47. ERASE P0, p1, p2, p3, p4, p5, p6
  49.  
  50. SUB ToScreen (array() AS INTEGER, lenght AS _BYTE, speed AS _UNSIGNED _BYTE)
  51.     FOR sx = -15 TO 20 STEP .4
  52.         CLS , _RGB32(6, 89, 244)
  53.         DrawArray array(), _WIDTH / 2 - (sx * lenght), _HEIGHT / 2 - sx * 8, sx, sx
  54.         _LIMIT speed
  55.         _DISPLAY
  56.     NEXT sx
  57.     _DELAY .5
  59.  
  60. SUB DrawArray (p() AS INTEGER, posx, posy, roztecx, roztecy)
  61.     MaxX = UBOUND(p, 1): MaxY = UBOUND(p, 2)
  62.     MinX = LBOUND(p, 1): MinY = LBOUND(p, 2)
  63.     FOR y = MinY TO MaxY
  64.         FOR x = MinX TO MaxX
  65.             IF p(x, y) THEN _PUTIMAGE (posx + (x * roztecx), posy + (y * roztecy)), image&
  66.             IF _KEYHIT = 27 THEN pad p(), x, y, roztecx, roztecy, posx, posy
  67.     NEXT x, y
  69.  
  70. SUB pad (p() AS INTEGER, x AS INTEGER, y AS INTEGER, roztecx, roztecy, posx, posy)
  71.     MaxX = UBOUND(p, 1): MaxY = UBOUND(p, 2)
  72.     MinX = LBOUND(p, 1): MinY = LBOUND(p, 2)
  73.  
  74.     DO WHILE Down < 800
  75.         CLS , _RGB32(6, 89, 244)
  76.         FOR y = MinY TO MaxY
  77.             Down = Down + RND * 5
  78.             FOR x = MinX TO MaxX
  79.                 IF p(x, y) THEN _PUTIMAGE (posx + (x * roztecx), (posy + (y * roztecy)) + Down), image&
  80.             NEXT
  81.         NEXT
  82.         _LIMIT 15
  83.         _DISPLAY
  84.     LOOP
  85.     SCREEN 0
  86.     _FREEIMAGE image&
  87.     END
  89.  
  90. SUB TextToArray (array( x , y) AS INTEGER, text AS STRING)
  91.     v& = _NEWIMAGE(LEN(text$) * 8, 16, 256)
  92.     REDIM array(LEN(text$) * 8, 16)
  93.     _DEST v&
  94.     _PRINTSTRING (1, 1), text$, v&
  95.     _DEST 0
  96.     _SOURCE v&
  97.     FOR y = 0 TO 15
  98.         PRINT
  99.         FOR x = 0 TO 8 * LEN(text$) - 1
  100.             IF POINT(x, y) THEN array(x, y) = 1
  101.     NEXT x, y
  102.     _DEST 0: _SOURCE 0
  104.  
  106.     CB& = _NEWIMAGE(40, 40, 256)
  107.     FOR F = 31 TO 16 STEP -1
  108.         rd = rd + 1
  109.         FOR R = 0 TO _PI(2) STEP .01
  110.             _DEST CB&
  111.             CIRCLE (SIN(R) + 20, COS(R) + 20), rd, F
  112.     NEXT R, F
  114.  
Title: Re: My wish
Post by: johnno56 on July 02, 2018, 05:31:43 pm
Cool... Thank you!

J
Title: Re: My wish
Post by: bplus on July 02, 2018, 08: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...
Text Only | Text with Attachments