Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 493
» Latest member: peadenaw@gmail.com
» Forum threads: 2,838
» Forum posts: 26,599

Full Statistics

Latest Threads
Fun with Ray Casting
Forum: a740g
Last Post: Bhsdfa
1 hour ago
» Replies: 1
» Views: 23
Aloha from Maui guys.
Forum: General Discussion
Last Post: Kernelpanic
4 hours ago
» Replies: 12
» Views: 254
Box_Bash game
Forum: Works in Progress
Last Post: Pete
4 hours ago
» Replies: 2
» Views: 53
another variation of "10 ...
Forum: Programs
Last Post: bplus
5 hours ago
» Replies: 20
» Views: 289
Next small EQ step - EQ D...
Forum: Petr
Last Post: Petr
7 hours ago
» Replies: 10
» Views: 558
1990's 3D Doom-Like Walls...
Forum: Programs
Last Post: a740g
01-11-2025, 09:31 PM
» Replies: 5
» Views: 188
Sound Effects Generator (...
Forum: Petr
Last Post: a740g
01-11-2025, 09:05 PM
» Replies: 1
» Views: 68
_SndRaw and _MemFree
Forum: General Discussion
Last Post: a740g
01-11-2025, 09:04 PM
» Replies: 1
» Views: 56
Problems with QBJS
Forum: Help Me!
Last Post: bplus
01-11-2025, 06:30 PM
» Replies: 4
» Views: 105
which day of the week
Forum: Programs
Last Post: bplus
01-11-2025, 06:19 PM
» Replies: 31
» Views: 743

 
  Sample of _LOADIMAGE change
Posted by: SMcNeill - 02-20-2023, 05:46 PM - Forum: Programs - Replies (1)

Code: (Select All)
$Unstable:Http

Screen _NewImage(800, 600, 32)

logo$ = "https://qb64phoenix.com/qb64wiki/resources/assets/peWikiLogo.png"
image$ = Download$(logo$, foo&)

imagehandle = _LoadImage(image$, 32, "memory")

_PutImage , imagehandle



' Content of the HTTP response is returned. The statusCode is also assigned.
Function Download$ (url As String, statusCode As Long)
    h& = _OpenClient("HTTP:" + url)
    statusCode = _StatusCode(h&)
    While Not EOF(h&)
        _Limit 60
        Get #h&, , s$
        content$ = content$ + s$
    Wend
    Close #h&
    Download$ = content$
End Function


Note:  This requires version 3.6 or above to run!

Print this item

  Stupid graphics experiment
Posted by: mnrvovrfc - 02-20-2023, 07:38 AM - Forum: Programs - Replies (1)

I failed to come up with a quick example for the new third parameter of _LOADIMAGE(), didn't pay attention that the string is supposed to be just like one that could be loaded from JPEG, PNG, PCX etc. graphics file format. Enjoy this, it's my first successful experiment ever with _MEMCOPY. A good improvement is to change the palette, either as greyscale or along a cool gradient.

Code: (Select All)
'by mnrvovrfc 20-Feb-2023
DIM a$, b AS STRING * 256000
DIM AS INTEGER v, i, j
DIM AS LONG ascr, ctop, cbot
DIM amem AS _MEM, bmem AS _MEM

SCREEN _NEWIMAGE(640, 400, 256)
PRINT "Building screen, please wait..."

ctop = 1
cbot = 640 * 399 + 1
a$ = SPACE$(640)
b = SPACE$(256000)
FOR j = 1 TO 200
    FOR i = 1 TO 640
        IF i MOD 2 = 0 THEN
            MID$(a$, i, 1) = CHR$(150 + v + (i MOD 56))
        ELSE
            MID$(a$, i, 1) = CHR$(v + (i MOD 16))
        END IF
    NEXT
    MID$(b, ctop, 640) = a$
    MID$(b, cbot, 640) = a$
    ctop = ctop + 640
    cbot = cbot - 640
    v = v + 1
    IF v >= 50 THEN v = 0
NEXT

bmem = _MEM(b)
ascr = _COPYIMAGE(0)
amem = _MEMIMAGE(ascr)
_MEMCOPY bmem, bmem.OFFSET, bmem.SIZE TO amem, amem.OFFSET
_MEMFREE bmem
SCREEN ascr
SLEEP
SCREEN 0
_MEMFREE amem
SYSTEM

Print this item

  QB64 Phoenix Edition v3.6.0 Released!
Posted by: DSMan195276 - 02-20-2023, 03:23 AM - Forum: Announcements - Replies (40)

QB64 Phoenix Edition v3.6.0!

https://github.com/QB64-Phoenix-Edition/...tag/v3.6.0

Enhancements

  • #286 - Added support for opening image from memory using _LOADIMAGE() - @a740g, @mkilgore
    • _LOADIMAGE() has a new optional requirements$ argument, similar to the string argument to _SNDOPEN():
      • _LOADIMAGE(fileName$[, [mode&][, requirements$]])
    • Providing "memory" in the requirements will cause _LOADIMAGE() to treat the contents of the fileName$ argument as an image file itself, rather than attempting to open a file.
Bug Fixes
  • #287, #296 - Fixed building QB64-PE on MacOS High Sierra - @mkilgore
  • #288 - Add missing keywords to syntax highlighter - @SteveMcNeill
  • #273, #295 - Timers will no longer take twice as long at program start - @mkilgore
  • #293, #295 - A stopped timer will now correctly run when turned on if it expired while stopped - @mkilgore
  • #294, #295 - On Windows, timers will now correctly trigger during SLEEP in $Console programs - @mkilgore
  • #298, #300, #302, #308 - Several improvements to the IDE Wiki - @RhoSigma-QB64
    • Improved handling of HTML Entity and UTF-8 characters used in the Wiki.
    • Fully implemented local links. The help page navigation in the IDE is now practically the same as in the real Wiki.
  • #301, #307 - Fix using DECLARE LIBRARY with a stripped .so file - @mkilgore
  • #297, #306 - The -o flag will no longer strip the extension from the executable name - @mkilgore
    • The extension .exe will still be removed when compiling on non-Windows platforms.

Full Changelog: v3.5.0...v3.6.0

Print this item

  Game cheating clone in QB64pe
Posted by: TempodiBasic - 02-19-2023, 11:46 PM - Forum: General Discussion - Replies (6)

Hi
what do you think about a program that read the values of a game , that is running, and can edit them?
Is it in the range of power of QB64pe?

I wait for a theoretical evaluation about how it works.

Here a link to a kind of program that does it in Windows 32/64.
Game Cheat
and here a link to a kind of program working in MacOs
Bit-Slicer


thank you for your feedbacks

Print this item

  MUSIC: scratching
Posted by: Petr - 02-19-2023, 10:50 AM - Forum: Petr - Replies (4)

Note, this source code runs in QB64 2.02 and older. Phoenix version comming soon.

What is scratching? It's an effect where the DJ slows down or speeds up the turntable while the sound is playing.

This program tries to simulate this at random times during playback.

Before run it, please write correct music file name in source code to line 13.

Code: (Select All)
_Title "Petr's scratching"

'What is scratching? It's an effect where the DJ slows down or speeds up the turntable while the sound is playing.
'This program tries to simulate this at random times during playback.

misto = 44100 * 5 '5 seconds after music start playing start effect
mistoE = misto + 88200 'effect ends 2 seconds after effect start
rychlost = 88200

Dim As _MEM L, R, L2, R2
Dim As Integer LS, RS

file$ = "al.mp3"
Print "Opening sound file "; file$
f = _SndOpen(file$)
L = _MemSound(f, 1)
R = _MemSound(f, 2)

Type SND
    L As Integer
    R As Integer
End Type
Dim snd(_SndRate * _SndLen(f)) As SND

Print "Creating standard array"
Do Until Done& = L.SIZE
    snd(i).L = _MemGet(L, L.OFFSET + Done&, Integer)
    snd(i).R = _MemGet(R, R.OFFSET + Done&, Integer)
    i = i + 1
    Done& = Done& + 2
Loop

i = i - 2

Dim snd2(3 * UBound(snd)) As SND 'this time i do not calculate array size - because this demo use random output lenght
zacatek = misto
konec = mistoE
psi2 = _Pi(1) / (zacatek - konec)
Dim As Long misto, mistoE

copy = 0
Print "Creating pseudo mix"
Randomize Timer
Do Until copy >= UBound(snd) - 2
    If original > misto And original < mistoE Then
        k2 = k2 + psi2
        newi = Sin(k2) * 44100
        copy = ocopy + newi
        original = original + Abs(Sin(k2))
    Else
        ocopy = copy
        copy = copy + 1
        original = Int(original + 1)
    End If

    If original > mistoE + 44100 Then 'pause between two mix hits (44100 = 1 sec)
        misto = original + 44100 * Rnd 'effect start in samples (44100 x time)
        mistoE = misto + 44100 * 2 * Rnd + 500 'effect end in samples
        zacatek = misto
        konec = mistoE
        psi2 = _Pi(1 + Rnd) / (zacatek - konec)
        If psi2 = 0 Then psi2 = .01
        If misto > UBound(snd2) Or misto2 > UBound(snd2) Then misto = 0: mistoE = 0
    End If



    If original > UBound(snd2) Then Print "Snd2 overlow": Exit Do
    If copy > UBound(snd) Then Print "Snd overlow"; copy; krok: Exit Do

    snd2(original).L = snd(copy).L
    snd2(original).R = snd(copy).R
Loop

Print "Saving mix as scratch.wav"

'For test = 0 To original
'_SndRaw snd2(test).L / 32768, snd2(test).R / 32768
'Next

Dim SNDSAVE As _MEM
SNDSAVE = _Mem(snd2())
SAVESOUND16S SNDSAVE, "scratch.wav"
Print "Playing..."
_SndPlayFile "scratch.wav"
_Delay 1
_MemFree SNDSAVE
Kill "scratch.wav"
End

Sub SAVESOUND16S (arr As _MEM, file As String)

    Type head16
        chunk As String * 4 '       4 bytes  (RIFF)
        size As Long '              4 bytes  (file size)
        fomat As String * 4 '       4 bytes  (WAVE)
        sub1 As String * 4 '        4 bytes  (fmt )
        subchunksize As Long '      4 bytes  (lo / hi), $00000010 for PCM audio
        format As Integer '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
        channels As Integer '       2 bytes  (1 = mono, 2 = stereo)
        rate As Long '              4 bytes  (sample rate, standard is 44100)
        ByteRate As Long '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
        Block As Integer '          2 bytes  (block align = number of channels * bits per sample /8)
        Bits As Integer '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
        subchunk2 As String * 4 '   4 bytes  ("data")  contains begin audio samples
        lenght As Long '            4 bytes  Data block size
    End Type '                     44 bytes  total
    Dim H16 As head16
    ch = FreeFile

    H16.chunk = "RIFF"
    H16.size = 44 + ConvertOffset&&(arr.SIZE) / _SndRate / 4 'two channels, it create 16 bit, stereo wav file, one sample use 2 bytes to one channel
    H16.fomat = "WAVE"
    H16.sub1 = "fmt "
    H16.subchunksize = 16
    H16.format = 1
    H16.channels = 2
    H16.rate = 44100
    H16.ByteRate = 44100 * 2 * 16 / 8
    H16.Block = 4
    H16.Bits = 16
    H16.subchunk2 = "data"
    H16.lenght = ConvertOffset&&(arr.SIZE)

    If _FileExists(file$) Then Kill file$
    Audio$ = Space$(ConvertOffset&&(arr.SIZE))
    _MemGet arr, arr.OFFSET, Audio$
    Open file$ For Binary As #ch
    Put #ch, , H16
    Put #ch, , Audio$
    Audio$ = ""
    Close ch
End Sub



Function ConvertOffset&& (value As _Offset)
    $Checking:Off
    Dim m As _MEM 'Define a memblock
    m = _Mem(value) 'Point it to use value
    $If 64BIT Then
        'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
        _MEMGET m, m.OFFSET, ConvertOffset&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
    $Else
        'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
        _MemGet m, m.OFFSET, temp& 'Like this
        ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
    $End If
    _MemFree m 'Free the memblock
    $Checking:On
End Function

Print this item

  MUSIC: Echo Player
Posted by: Petr - 02-19-2023, 09:58 AM - Forum: Petr - Replies (2)

NOTE! This program is created to QB64 2.02 (and older, Phoenix version comming soon!)


Compile this program in its own folder (maybe call it echo test, it doesn't matter) and then copy some music files into that folder. The program is built on an older version of QB64, so it only supports MP3, OGG and WAV formats (you can add the other formats there on line 36 in the source code, but it is not tested with it. The program will play music files in the folder with an echo effect after running. The attached direntry.h file is needed for the function.

Code: (Select All)
'Program create new WAV soundtrack + add echo

_Title "Petr's echo player"


EchoLenght = 0.12 '0.12 seconds is echo duration
OverSampling = 10 'number of echoes sample passes

Echo& = _SndRate * EchoLenght
'to create an echo effect you need to repeat a couple of sound samples - it's the same as playing the same song twice in quick succession,
'the sound samples are also mixed. This is the principle of the function of this program.
'the number of samples to be repeated indicates the length of the echo. For 25 milliseconds, that's 25 * 441 samples.

Do Until Echo& Mod 2 = 0
    Echo& = Echo& + 1
Loop
Dim Left As _MEM, Right As _MEM, NewSound As _MEM, Audio As Integer, Audio2 As Integer, Audio3 As Integer, Audio4 As Integer
ReDim PlayableFiles(0) As String 'for music files list


'INPUT "Insert audio file name:"; a1$

Declare CustomType Library ".\direntry" 'need file direntry.h, available in SMcNeill's libraries
    Function load_dir& (s As String)
    Function has_next_entry& ()
    Sub close_dir ()
    Sub get_next_entry (s As String, flags As Long, file_size As Long)
End Declare

ReDim Dir(0) As String, File(0) As String
GetFileList _CWD$, Dir(), File() 'load files in current directory


For s = LBound(file) To UBound(file)
    Select Case UCase$(Right$(File(s), 3))
        Case "MP3", "OGG", "WAV" 'available music formats under QB64 2.02
            PlayableFiles(i) = File(s)
            i = i + 1
            ReDim _Preserve PlayableFiles(i) As String
    End Select
Next

Print "Files to play: "; i


For playit = 0 To i - 1 'play all music files (MP3, OGG, WAV) in current directory (this file list is created using direntry.h)
    a1$ = PlayableFiles(playit)
    Print "Opening file "; playit + 1; "/"; i; " - "; PlayableFiles(playit)
    If a Then _SndClose a
    a = _SndOpen(a1$)
    If a Then Print "Audio file opened" Else Print "Audio file "; a1$; " opening error.": End
    LENa = _Ceil(_SndLen(a) + EchoLenght)
    Print "Audio file lenght:"; LENa; "[sec]"
    NewTrackTime = LENa

    Left = _MemSound(a, 1)
    Right = _MemSound(a, 2)

    NewSoundSize& = _SndRate * NewTrackTime * 2 * 2 'use stereo  + use INTEGER
    NewSound = _MemNew(NewSoundSize&)

    Print "SndRate:"; _SndRate
    Print "Track memory len:"; Left.SIZE
    Print "Creating audio..."

    VolDown = 1 / OverSampling
    Create& = 0
    NewAudio& = 0
    Do Until Create& >= Left.SIZE - 2
        _MemGet Left, Left.OFFSET + Create&, Audio
        _MemGet Right, Right.OFFSET + Create&, Audio2

        If Create& > Echo& Then

            E& = Create&
            Vol = 1
            Do Until E& <= Create& - OverSampling
                Vol = Vol - VolDown
                _MemGet Left, Left.OFFSET + Create& - Echo&, Audio3
                _MemGet Left, Left.OFFSET + Create& - 2, Audio4
                Audio = (Audio + Audio3 * (Vol + .01) + Audio4 * Vol) \ 3
                E& = E& - 2
            Loop

            E& = Create&
            Vol = 1
            Do Until E& <= Create& - OverSampling
                Vol = Vol - VolDown
                _MemGet Right, Right.OFFSET + Create& - Echo&, Audio3
                _MemGet Right, Right.OFFSET + Create& - 2, Audio4
                Audio2 = (Audio2 + Audio3 * (Vol + .01) + Audio4 * Vol) \ 3
                E& = E& - 2
            Loop
        End If

        _MemPut NewSound, NewSound.OFFSET + NewAudio&, Audio 'left channel
        _MemPut NewSound, NewSound.OFFSET + NewAudio& + 2, Audio2 'right channel
        NewAudio& = NewAudio& + 4
        Create& = Create& + 2
    Loop

    Print "New sound created. Saving as Tracks-mix4.wav..."
    SAVESOUND16S NewSound, "Tracks-mix4.wav"
    Print "Sound saved, erasing RAM..."
    _MemFree Left
    _MemFree Right
    _MemFree NewSound

    Print "Playing mixed sound"
    snd = _SndOpen("tracks-mix4.wav")
    _SndPlay snd
    Do Until _SndPlaying(snd) = 0
        Locate 12
        Print "Time: "; Int(_SndGetPos(snd)); "[sec]     "
    Loop
    Cls
    _SndClose snd
    Kill "tracks-mix4.wav"
Next
End


Function ConvertOffset&& (value As _Offset)
    $Checking:Off
    Dim m As _MEM 'Define a memblock
    m = _Mem(value) 'Point it to use value
    $If 64BIT Then
        'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
        _MEMGET m, m.OFFSET, ConvertOffset&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
    $Else
        'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
        _MemGet m, m.OFFSET, temp& 'Like this
        ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
    $End If
    _MemFree m 'Free the memblock
    $Checking:On
End Function



Sub SAVESOUND16S (arr As _MEM, file As String)

    Type head16
        chunk As String * 4 '       4 bytes  (RIFF)
        size As Long '              4 bytes  (file size)
        fomat As String * 4 '       4 bytes  (WAVE)
        sub1 As String * 4 '        4 bytes  (fmt )
        subchunksize As Long '      4 bytes  (lo / hi), $00000010 for PCM audio
        format As Integer '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
        channels As Integer '       2 bytes  (1 = mono, 2 = stereo)
        rate As Long '              4 bytes  (sample rate, standard is 44100)
        ByteRate As Long '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
        Block As Integer '          2 bytes  (block align = number of channels * bits per sample /8)
        Bits As Integer '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
        subchunk2 As String * 4 '   4 bytes  ("data")  contains begin audio samples
        lenght As Long '            4 bytes  Data block size
    End Type '                     44 bytes  total
    Dim H16 As head16
    ch = FreeFile

    H16.chunk = "RIFF"
    H16.size = 44 + ConvertOffset(arr.SIZE)

    H16.fomat = "WAVE"
    H16.sub1 = "fmt "
    H16.subchunksize = 16
    H16.format = 1
    H16.channels = 2
    H16.rate = 44100
    H16.ByteRate = 44100 * 2 * 16 / 8
    H16.Block = 4
    H16.Bits = 16
    H16.subchunk2 = "data"
    H16.lenght = ConvertOffset(arr.SIZE)
    If _FileExists(file$) Then Kill file$

    Audio$ = Space$(ConvertOffset(arr.SIZE))
    _MemGet arr, arr.OFFSET, Audio$

    Open file$ For Binary As #ch
    Put #ch, , H16
    Put #ch, , Audio$
    Audio$ = ""

    Close ch
End Sub

Sub GetFileList (SearchDirectory As String, DirList() As String, FileList() As String)
    Const IS_DIR = 1
    Const IS_FILE = 2
    Dim flags As Long, file_size As Long

    ReDim _Preserve DirList(100), FileList(100)
    DirCount = 0: FileCount = 0

    If load_dir(SearchDirectory) Then
        Do
            length = has_next_entry
            If length > -1 Then
                nam$ = Space$(length)
                get_next_entry nam$, flags, file_size
                If (flags And IS_DIR) Or _DirExists(SearchDirectory + nam$) Then
                    DirCount = DirCount + 1
                    If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
                    DirList(DirCount) = nam$
                ElseIf (flags And IS_FILE) Or _FileExists(SearchDirectory + nam$) Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(filelist) Then ReDim _Preserve FileList(UBound(filelist) + 100)
                    FileList(FileCount) = nam$
                End If
            End If
        Loop Until length = -1
        close_dir
    Else
    End If
    ReDim _Preserve DirList(DirCount)
    ReDim _Preserve FileList(FileCount)
End Sub



Attached Files
.h   direntry.h (Size: 1.15 KB / Downloads: 53)
Print this item

  Audio storage, stereo switching
Posted by: Petr - 02-18-2023, 09:21 PM - Forum: Programs - Replies (2)

Hello. I went through the forum and found some questions about saving sound and also questions about whether it is possible to create and save sound in QB64. The answer to both is yes. The attached program is from January 5, 2021, when I was actively involved. Then the forum was destroyed and I vowed not to spend time on something that would just disappear overnight. I'm here today after a long time (I'm using QB64 2.02) and I see that there might be interest in this, so I'm posting it here. My SaveSound16S will be useful, it saves your sound in stereo WAV file format and I used it for testing because SNDRAW had problems with stereo (I don't know how it is with this command now).

This program open your music file, then create WAV file from it named as TestEff3.wav (contains stereo switching) and then play it using SNDPLAYFILE statement.

Code: (Select All)
DIM left AS _MEM
DIM Right AS _MEM
DIM AudioL AS INTEGER
DIM AudioR AS INTEGER
DIM L AS INTEGER
DIM R AS INTEGER
DIM NewSound AS _MEM


INPUT "Insert music STEREO file name"; snd$
IF _FILEEXISTS(snd$) THEN
    snd = _SNDOPEN(snd$)
    IF snd > 0 THEN
        left = _MEMSOUND(snd, 1)
        Right = _MEMSOUND(snd, 2)
        IF Right.SIZE > 0 THEN
            NewSound = _MEMNEW(left.SIZE * 2)
            DO UNTIL s& = left.SIZE
                _MEMGET left, left.OFFSET + s&, AudioL
                _MEMGET Right, Right.OFFSET + s&, AudioR
                L = AudioL * ABS(SIN(sinus)) '     SINUS is LEFT/RIGHT CHANNEL SWITCH :)
                R = AudioR * ABS(COS(sinus))
                _MEMPUT NewSound, NewSound.OFFSET + t&, L
                _MEMPUT NewSound, NewSound.OFFSET + t& + 2, R
                sinus = sinus + .00001
                s& = s& + 2
                t& = t& + 4
            LOOP
        ELSE
            PRINT "This sound file is not stereo!"
            END
        END IF
    ELSE
        PRINT "File exists, bud this music format is not supported."
        END
    END IF
ELSE
    PRINT "File "; snd$; " not found."
    END
END IF

SAVESOUND16S NewSound, "TestEff3.wav"
_SNDPLAYFILE "TestEff3.wav"
END

SUB SAVESOUND16S (arr AS _MEM, file AS STRING)

    TYPE head16
        chunk AS STRING * 4 '       4 bytes  (RIFF)
        size AS LONG '              4 bytes  (file size)
        fomat AS STRING * 4 '       4 bytes  (WAVE)
        sub1 AS STRING * 4 '        4 bytes  (fmt )
        subchunksize AS LONG '      4 bytes  (lo / hi), $00000010 for PCM audio
        format AS INTEGER '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
        channels AS INTEGER '       2 bytes  (1 = mono, 2 = stereo)
        rate AS LONG '              4 bytes  (sample rate, standard is 44100)
        ByteRate AS LONG '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
        Block AS INTEGER '          2 bytes  (block align = number of channels * bits per sample /8)
        Bits AS INTEGER '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
        subchunk2 AS STRING * 4 '   4 bytes  ("data")  contains begin audio samples
        lenght AS LONG '            4 bytes  Data block size
    END TYPE '                     44 bytes  total
    DIM H16 AS head16
    ch = FREEFILE

    H16.chunk = "RIFF"
    H16.size = 44 + ConvertOffset&&(arr.SIZE) / _SNDRATE / 4 'two channels, it create 16 bit, stereo wav file, one sample use 2 bytes to one channel
    H16.fomat = "WAVE"
    H16.sub1 = "fmt "
    H16.subchunksize = 16
    H16.format = 1
    H16.channels = 2
    H16.rate = 44100
    H16.ByteRate = 44100 * 2 * 16 / 8
    H16.Block = 4
    H16.Bits = 16
    H16.subchunk2 = "data"
    H16.lenght = ConvertOffset&&(arr.SIZE)
    ' $END IF
    IF _FILEEXISTS(file$) THEN KILL file$
    Audio$ = SPACE$(ConvertOffset&&(arr.SIZE))
    _MEMGET arr, arr.OFFSET, Audio$
    OPEN file$ FOR BINARY AS #ch
    PUT #ch, , H16
    PUT #ch, , Audio$
    Audio$ = ""
    CLOSE ch
END SUB



FUNCTION ConvertOffset&& (value AS _OFFSET)
    $CHECKING:OFF
    DIM m AS _MEM 'Define a memblock
    m = _MEM(value) 'Point it to use value
    $IF 64BIT THEN
        'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
        _MEMGET m, m.OFFSET, ConvertOffset&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
    $ELSE
        'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
        _MEMGET m, m.OFFSET, temp& 'Like this
        ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
    $END IF
    _MEMFREE m 'Free the memblock
    $CHECKING:ON
END FUNCTION

and to querstion 2 - is possible creating and saving sound using QB64? YES:

Code: (Select All)
'this program is from SNDRAW help, create sound using QB64, modifie so, it also save this sound.

t = 0
tmp$ = "Sample = ##.#####   Time = ##.#####"
Locate 1, 60: Print "Rate:"; _SndRate

'------ modification -------
Dim SNDREC(44100 * 3.1) As Integer 'sound duration is 3 seconds, use 44100 samples/sec
'------ modification -------

Do
    'queue some sound
    Do While _SndRawLen < 0.1 'you may wish to adjust this
        sample = Sin(t * 440 * Atn(1) * 8) '440Hz sine wave (t * 440 * 2Ď€)
        sample = sample * Exp(-t * 3) 'fade out eliminates clicks after sound
        _SndRaw sample

        '------ modification -------
        SNDREC(rec) = 32768 * sample
        rec = rec + 1
        '------ modification -------

        t = t + 1 / _SndRate 'sound card sample frequency determines time
    Loop

    'do other stuff, but it may interrupt sound
    Locate 1, 1: Print Using tmp$; sample; t
Loop While t < 3.0 'play for 3 seconds

Do While _SndRawLen > 0 'Finish any left over queued sound!
Loop

Print rec

'------ modification -------
Dim L As _MEM
Dim LR As _MEM
Dim REC As Integer
L = _Mem(SNDREC())
'because created sound is MONO but we recording it as stereo, create here pseudo stereo memory array:
LR = _MemNew(L.SIZE * 2)
done = 0
Do Until done = L.SIZE
    _MemGet L, L.OFFSET + done, REC
    _MemPut LR, LR.OFFSET + RECINDEX, REC 'left
    _MemPut LR, LR.OFFSET + RECINDEX + 2, REC 'right
    done = done + 2 'switch by 2 bytes in L MEM array
    RECINDEX = RECINDEX + 4 'switch by 4 bytes in LR MEM array
Loop
_MemFree L
Print "Saving sound as ding.wav..."
SAVESOUND16S LR, "ding.wav"
_MemFree LR
Print "Playing created file ding.wav..."
_SndPlayFile "ding.wav"



End



Sub SAVESOUND16S (arr As _MEM, file As String)

    Type head16
        chunk As String * 4 '       4 bytes  (RIFF)
        size As Long '              4 bytes  (file size)
        fomat As String * 4 '       4 bytes  (WAVE)
        sub1 As String * 4 '        4 bytes  (fmt )
        subchunksize As Long '      4 bytes  (lo / hi), $00000010 for PCM audio
        format As Integer '         2 bytes  (0001 = standard PCM, 0101 = IBM mu-law, 0102 = IBM a-law, 0103 = IBM AVC ADPCM)
        channels As Integer '       2 bytes  (1 = mono, 2 = stereo)
        rate As Long '              4 bytes  (sample rate, standard is 44100)
        ByteRate As Long '          4 bytes  (= sample rate * number of channels * (bits per channel /8))
        Block As Integer '          2 bytes  (block align = number of channels * bits per sample /8)
        Bits As Integer '           2 bytes  (bits per sample. 8 = 8, 16 = 16)
        subchunk2 As String * 4 '   4 bytes  ("data")  contains begin audio samples
        lenght As Long '            4 bytes  Data block size
    End Type '                     44 bytes  total
    Dim H16 As head16
    ch = FreeFile

    H16.chunk = "RIFF"
    H16.size = 44 + ConvertOffset&&(arr.SIZE) / _SndRate / 4 'two channels, it create 16 bit, stereo wav file, one sample use 2 bytes to one channel
    H16.fomat = "WAVE"
    H16.sub1 = "fmt "
    H16.subchunksize = 16
    H16.format = 1
    H16.channels = 2
    H16.rate = 44100
    H16.ByteRate = 44100 * 2 * 16 / 8
    H16.Block = 4
    H16.Bits = 16
    H16.subchunk2 = "data"
    H16.lenght = ConvertOffset&&(arr.SIZE)
    ' $END IF
    If _FileExists(file$) Then Kill file$
    Audio$ = Space$(ConvertOffset&&(arr.SIZE))
    _MemGet arr, arr.OFFSET, Audio$
    Open file$ For Binary As #ch
    Put #ch, , H16
    Put #ch, , Audio$
    Audio$ = ""
    Close ch
End Sub



Function ConvertOffset&& (value As _Offset)
    $Checking:Off
    Dim m As _MEM 'Define a memblock
    m = _Mem(value) 'Point it to use value
    $If 64BIT Then
        'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
        _MEMGET m, m.OFFSET, ConvertOffset&& 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
    $Else
        'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
        _MemGet m, m.OFFSET, temp& 'Like this
        ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
    $End If
    _MemFree m 'Free the memblock
    $Checking:On
End Function

Program create sound (used for this is program from QB64 SNDRAW help) and then easily modified for saving this sound in WAV format.

Print this item

  Checkered Checkers
Posted by: bplus - 02-18-2023, 01:20 AM - Forum: Programs - Replies (6)

For some time now I've been trying do something like this recursively:

Code: (Select All)
_Title "Checkered Checkers, press any for another screen..." ' b+ 2023-02-17
Screen _NewImage(641, 641, 12)
_ScreenMove 300, 60
d = 8: sq = 640 / d: sq8 = sq / d: dm1 = d - 1
Dim arr(d, d)
While _KeyDown(27) = 0
    For j = 0 To dm1
        For i = 0 To dm1
            If Rnd < .5 Then arr(i, j) = 1 Else arr(i, j) = 0
        Next
    Next
    For y = 0 To dm1
        For x = 0 To dm1
            If arr(x, y) Then
                For yy = 0 To dm1
                    For xx = 0 To dm1
                        If arr(xx, yy) Then
                            Line (x * sq + xx * sq8, y * sq + yy * sq8)-(x * sq + xx * sq8 + sq8 - 1, y * sq + yy * sq8 + sq8 - 1), , BF
                        Else
                            Line (x * sq + xx * sq8, y * sq + yy * sq8)-(x * sq + xx * sq8 + sq8 - 1, y * sq + yy * sq8 + sq8 - 1), , B
                        End If
                    Next
                Next
            End If
            Line (x * sq, y * sq - 1)-(x * sq + sq, y * sq + sq - 1), , B
        Next
    Next
    Sleep
    Cls
Wend

So it wouldn't take more code lines to do deeper levels. With recursion you could just keep going deeper as long as the side length of a checker was >=1 pixel.

Print this item

  Embed Text
Posted by: SMcNeill - 02-17-2023, 02:43 AM - Forum: SMcNeill - Replies (2)

An old routine which I found on my drive, which showcases how to embed text into an image and hide it from most folks prying eyes.


.7z   EmbedText.7z (Size: 1.1 MB / Downloads: 80) <-- Grab the archive here, extract, and run with "OUTPUT EXE TO SOURCE FOLDER" enabled in the run menu.  Smile

What this does, breaks down to these steps:

1) It loads an image for us.
2) It then embeds text into the image, without disturbing the image in any way noticeable to you.  It'll display it on the screen for you to stare at in awe at the sheer lack of text upon it.
3) It then decrypts that text back off from that image and puts it onto a blank canvas, to display for you to stare at in awe, just so you can see that the process here actually works.

Hidden text in images!

I use this all the time for photos and such, to embed names, dates, places, occasions, and whatnot into the image itself, so I can just draw that info out anytime I ever want in the future -- and it still won't be visible for the general public to ever notice.  Smile

Print this item

  Can images be read from a file into an array?
Posted by: PhilOfPerth - 02-17-2023, 12:34 AM - Forum: Help Me! - Replies (11)

I have a folder containing several images (.jpg) that I want to place in an array, then pick any (or all) from that array to display. I don't see any appropriate commands that allow this; are there any? (simplicity is important to me!)  Wink

Print this item