DIM SHARED seznam2
(1000) AS STRING * 255 ' maximum files in directory limited to 1000 DIM SHARED VFiles
(1000) AS STRING * 255 ' Dim for memory array contains VISIBLE file names (vith national characters others as US, displayed with _MAPUNICODE, BUT UNUSABLE TO OPERATION WITH FILES! DIM SHARED UFiles
(1000) AS STRING * 255 ' Dim for memory array contains UNVISIBLE, old filenames type 8.3. This is ussable to operation with files, but is not standardly displayed. One record lenght = 13. DIM SHARED MaskUFiles
(1000) AS STRING * 255 ' Dim for array contains empty blocks + blocks with record accetable filemask - U = usable for file access DIM SHARED MaskVFiles
(1000) AS STRING * 255 ' the same, but V = Visible - here are strings that can be correctly converted to screen with _MAPUNICODE, but are unussable to file access ' ------------------------------------------------- this all dims are erased if sub end. Final outputs are:
DIM SHARED FinalVFiles
(1000) AS STRING * 255 ' Contains all QB64 usable soundformat files from directory - names unusable for access DIM SHARED FinalUFiles
(1000) AS STRING * 12 ' 8 + "." + 3 the same as previous case, but usable for file access DIM SHARED RndFinalVFiles
(1000) AS STRING * 255 ' its still copy FinalVFiles - if random play is off, its random array generated in VFiles copyed back from this still copy DIM SHARED copyU
(1000) AS STRING * 200 ' bylo nastaveno max misto 1000 kdyby rndplay neslo... DIM SHARED Track
(1000) AS INTEGER ' contains track list in play order (every track listed by nacti.b has own rerord number)
path$ = path$ + "\fonts\cour.ttf"
f&
= _LOADFONT(path$
, 32, "monospace, bold") ' Load font. Font is used for correct display song nameVol = 1
polar = 10
_TITLE "QB64 Music Player. By Petr - Petr.Pr@email.cz" 'i dont know who is it :-D i&
= _NEWIMAGE(1024, 300, 32) ' My screen windownew&
= _LOADIMAGE("skinDb.png", 32) ' My all in one graphic fileLoopOneU&
= _NEWIMAGE(50, 50, 32) ' U as unpressed or NOT pressedLoopOneP&
= _NEWIMAGE(50, 50, 32) ' P as Pressed_PUTIMAGE (0, 0)-(26, 11), new&
, RandPlayOff&
, (560, 60)-(586, 71) _PUTIMAGE (0, 0)-(26, 11), new&
, RandPlayOn&
, (560, 74)-(586, 85) _PUTIMAGE (0, 0)-(49, 49), new&
, LoopAllP&
, (894, 592)-(960, 656) _PUTIMAGE (0, 0)-(49, 49), new&
, LoopOneP&
, (960, 590)-(1023, 650) _PUTIMAGE (0, 0)-(49, 49), new&
, LoopAllU&
, (896, 530)-(956, 590) _PUTIMAGE (0, 0)-(49, 49), new&
, LoopOneU&
, (950, 470)-(1010, 530) _PUTIMAGE (0, 0)-(49, 49), new&
, infoicon&
, (964, 538)-(1014, 588) _PUTIMAGE (0, 0)-(113, 29), new&
, resicon&
, (571, 8)-(684, 37) _PUTIMAGE (0, 0)-(49, 49), new&
, ImageOpenFiles&
, (899, 474)-(948, 523) _PUTIMAGE (0, 0)-(49, 49), new&
, VolumeMinus&
, (895, 412)-(945, 462) _PUTIMAGE (0, 0)-(49, 49), new&
, VolumePlus&
, (958, 412)-(1008, 462) _PUTIMAGE (0, 0), new&
, GreenButtonNext&
, (760, 540)-(860, 640) _PUTIMAGE (0, 0), new&
, GreenButtonPause&
, (650, 540)-(750, 640) _PUTIMAGE (0, 0), new&
, GreenButtonBack&
, (540, 540)-(640, 640) _PUTIMAGE (0, 0), new&
, GreenButtonPower&
, (770, 430)-(870, 530) _PUTIMAGE (0, 0), new&
, GreenButtonStop&
, (650, 430)-(750, 530) _PUTIMAGE (0, 0), new&
, GreenButtonPlay&
, (532, 431)-(632, 531) _PUTIMAGE (0, 0), new&
, j&
, (1, 100)-(1025, 401) 'j& = _LOADIMAGE("skin.png", 32) 'tohle
'd& = _LOADIMAGE("digits.png", 32) 'tohle
titlemusic$ = "Stoped" ' basic status
InsertX = -200 ' its X axis for song name moving on screen
'mrizka 170, 10
'path$ = ENVIRON$("SYSTEMROOT")
'path$ = path$ + "\fonts\cour.ttf"
'screen i&
white&
= _RGB32(255, 255, 255)whitetwo&
= _RGB32(150, 150, 150)'_SETALPHA 0, white& TO _RGB32(65, 65, 65), LoopOneP&
'_SETALPHA 0, white& TO _RGB32(65, 65, 65), LoopAllP&
LoopOne = 0 ' basic status for neverending playing one track
LoopAll = 0 ' basic status for neverending playing all tracks from selected directory
WindowsFileOpenSystem
IF PlEr
= 1 THEN PlEr
= 0:
BEEP: WindowsFileOpenSystem
' PlEr = Play Error. 0 = no error, 1 = is error. WindowsFileOpenSystem is function for opening folders from windows. nacti.b ' create list all playble files in selected folder to swap file, load it to memory, then delete swap file. Create unsorted list!
'RndPlay 1 OK!!!!
reload = 1 ' 'Reload = 1 started WindowsFileOpenSystem, Reload = 0 close it.
RAP "StartDemo" ' Start basic mode
' WindowsFileOpenSystem ' if skiped this, its start automaticaly plays files in the same directory who is
dalsi:
IF _SNDPLAYING(zvuk&
) = 0 THEN minuta
= 0: sekunda
= 0: oldsec
= sec
'dodana podminka Reset song time if song playing is on the end IF posuv
= 1 THEN posuv
= 0:
GOTO posunuto
' POSUV = song moving. 1 = is pressed next or back button IF LoopOne
= 1 THEN GOTO posunuto
' LoopOne = is pressed neverending playing for one song, also akt muss be the same. akt = akt + 1 ' akt = actual play track number. Here this say go playing next song in list.
posunuto:
IF LoopAll
= 1 AND akt
> max
THEN akt
= 1 ' This reset playing to begin, if is selected neverending playing for all songs in directory. IF LoopAll
= 0 AND akt
> max
THEN akt
= 0:
BEEP: stopp
= 1: status$
= "Playlist end!" ' If all songs id directory are played to end and neverending playing for all not selected, beep and now new with status. Stopp = 1 = draw stop button to pressed.
'IF akt > max THEN akt = 1 'return plays to begin
file$ = FinalUFiles$(akt)
IF inf
= 0 THEN _TITLE "QB64 Music Player. By Petr - Petr.Pr@email.cz" Rodent ' call mouse interaction sub
IF reload
= 1 THEN reload
= 0: akt
= 0:
GOTO dalsi
' this line is for RELOAD if you open next folder RAP FinalVFiles$(akt) ' draw visible song name to screen
' COLOR _RGB(255, 255, 255): PRINT FinalVFiles$(akt): SLEEP
IF inf
= 0 THEN _DISPLAY ' inf is for info if icon INFO on screen is pressed or not. If is, then my screen is in the background '_LIMIT 25
cj ' cj - sub named as Cesky Jazyk - english - Czech language. It make Czech characters correctly readable an othe screen.
'--------------------------------------------------------- KEYBOARD INPUTS ---------------------------------------------- Keyboard inputs -------------
IF inf
= 1 THEN info
' return to sub INFO. INFO is waiting for pressing Esc key to end him or up/dn to read text. IF inf
= 1 THEN GOTO rtr
' if INFO icon is pressed, is keyboard input for my program off, but not for INFO window. RAP "shutdown.internal.cmd" ' this shutdown this program, before is called other sub for ersing all images from memory.
IF vs
= 1 THEN vs
= 0 ELSE vs
= 1 ' switch song time backward / normal 'previous
RAP "getback.internal.cmd" ' say - play previous song
akt = akt - 1: posuv = 1
i$ = ""
IF akt
< 1 THEN pl
= max
' if is played first song in list, then skip and play last from list _SNDSTOP (zvuk&
) ' but first stop playing current song. 'next
RAP "getnext.internal.cmd" ' say - play next song
akt = akt + 1: posuv = 1
i$ = ""
IF akt
> linka
THEN pl
= 1 'found and repaired ERROR if is played last song from list, then skip and play first from list _SNDSTOP (zvuk&
) ' but first stop current song. ch#
= ch#
- .01:
IF ch#
< -1 THEN ch#
= -1 _SNDBAL zvuk&
, ch#
' if is pressed < or , or . or > then reselect balance settings. Using double values. ch#
= ch#
+ .01:
IF ch#
> 1 THEN ch#
= 1 Vol
= Vol
+ .01:
IF Vol
> 1 THEN Vol
= 1 ' if is pressed + or - then reselect volume level Vol
= Vol
- .01:
IF Vol
< 0 THEN Vol
= 0 rtr:
IF reload
= 1 THEN GOTO dalsi
'here is curent problem?
GOTO dalsi
' go back to DALSI, its begin this my loop and wait until song is played to end or keys are pressed. 'konec:
'_SNDSTOP (zvuk&)
'IF LoopAll = 1 THEN GOTO dalsi 'make neverending loop, plays all files from begin
SUB RndPlay
(status
AS INTEGER) 'sub is tested Create random order for playlist, status: 0 = not use random order, 1 = use random order SHARED max
, usingRND
, gen
, tracknumber
, stav
' max = maximal songs number in list, usingRND - info if song list is original or randomized copyU(StillCopy) = FinalUFiles(StillCopy)
copyV(StillCopy) = FinalVFiles(StillCopy)
gen = 0
CASE 0 'Random music play is OFF FOR rewrite
= 1 TO max
' here copying old playlist to this arrays, randomlist is ready in finalufiles and finalvfiles. Its ready for rndmusic off. FinalUFiles(rewrite) = copyU(rewrite)
FinalVFiles(rewrite) = copyV(rewrite)
usingRND = 0 ' select RndPlay as unused for next use
CASE 1 'Random music play is ON gene:
tracknumber
= INT(RND * (max
* 2)) gen = gen + 1
Track(gen) = tracknumber
' PRINT "Generovana cisla stop priradim pisnickam:"
FinalVFiles(cisla) = copyV(Track(cisla))
FinalUFiles(cisla) = copyU(Track(cisla))
' vypis
usingRND = 1 ' Rndmusic is used and is possible rewriting arrays back if is going off.
SHARED MouseX
, MouseY
, Lb
, zvuk&
, akt
, posuv
, Vol
, ch#
, vs
, stopp
, inf
, LoopAll
, LoopOne
, LoopAllU&
, LoopAllP&
, LoopOneU&
, LoopOneP&
, i&
, rndpl
' mouse interface IF inf
= 1 THEN EXIT SUB ' if INFO icon is pressed, is mouse to program window off White&
= _RGB32(255, 255, 255) 'mouse interaction
PlayPressed:
'_SNDPLAY (zvuk&)
IF stopp
= 1 THEN stopp
= 0 ' if is stop button draw as pressed, then draw it as unpressed (stop button cooperation) StopPressed:
IF stopp
= 1 THEN stopp
= 0 ELSE stopp
= 1:
_DELAY 0.5 ' Stop button cooperation PowerPressed: RAP "shutdown.internal.cmd" ' Power button cooperation
BackPressed: RAP
"getback.internal.cmd": akt
= akt
- 1: posuv
= 1:
_SNDSTOP zvuk&
' Back button cooperation PausePressed: ' Pause button cooperation
NextPressed: ' Next button cooperation
RAP "getnext.internal.cmd"
akt = akt + 1: posuv = 1
VolPlus: Vol
= Vol
+ .01:
IF Vol
> 1 THEN Vol
= 1 ' Volume plus button cooperation VolMinus: Vol
= Vol
- .01:
IF Vol
< 0 THEN Vol
= 0 ' Volume minus button cooperation FilesSelect:
' IF RTRIM$(LTRIM$(FinalUFiles(1))) = "" THEN
RndPlay 0
rndpl = 0
akt = 0
WindowsFileOpenSystem ' start first folder select window in program begin
BalanceLeft:
ch#
= ch#
- .01:
IF ch#
< -1 THEN ch#
= -1 ' balance (speakers) icon cooperation BalanceRight:
ch#
= ch#
+ .01:
IF ch#
> 1 THEN ch#
= 1 ViewTime:
IF vs
= 1 THEN vs
= 0:
_DELAY .1 ELSE IF vs
= 0 AND ab
= 0 THEN vs
= 1:
_DELAY .1 ' If is enter pressed, so vs = 0 = show song time from begin, vs = 1 = show song time from end ViewSongTime vs ' call sub for time view
info:
info ' call sub info, this view information in data block sub info
PressedLoopAll:
PressLoop 1 ' set loop after loop for all songs icon click
PressedLoopOne:
IF LoopOne
= 0 THEN LoopOne
= 1 ELSE LoopOne
= 0 ' set loop after click to icon for one song loop PressLoop 2
RandomPlay: ' cooperation with RND icon (random order music play)
SHARED LoopAll
, LoopOne
, LoopAllU&
, LoopAllP&
, LoopOneU&
, LoopOneP&
SUB info
'hodnota inf se priradi pri prvnim spusteni subu info a smaze po jeho opusteni (nastavi se na nulu) SHARED i&
, inf
, afterinfo&
, sdeleni&
, mov
, mox
, f&
IF inf
= 1 THEN GOTO block
ELSE inf
= 1 ' info subprogram started after info icon click 'text& = _NEWIMAGE(1024, 300, 32)
FOR viewtext
= 0 TO 27 '28 data linies text$(viewtext) = r$
mov = 0
block:
_TITLE "QB64 Petr's Player - INFO window" mov = mov - 1
mov = mov + 1
IF mov
> 11 THEN mov
= 11 ' 11 steps because one screen use 16 linies, data block is long 28 linies, 28 - 16 = 12 - 1 = 11
mox = mov + 16 ' 16 rows to one page
IF mox
> 28 THEN mox
= 28 ' total linies
'_PUTIMAGE (0, 0), i&, text& 'dokud nestisknes klavesu, tak se vraci rizeni pro i& mimo subu pro klavesnici a mys
' _DELAY 0.5
' _DEST 0
inf = 0 'po stisku klavesy v okne info se vrati rizeni i pro klvesnici a mys a ukonci se sub info
'_FREEIMAGE text& '
_TITLE "QB64 Music Player. By Petr - Petr.Pr@email.cz"
txt:
DATA "About QB Player: USE KEY UP / KEY DOWN / ESC" DATA "This open source player writed Petr Preclik. Its use QB64 commands, its based on the _SNDPLAY statement. This is my first ver- " DATA "sion in graphic mode. To program:" DATA "Is possible program using with mouse or keyboard. Use < or , and > or. for balance, + and - for volume and spacebar for pause" DATA "Esc to quit program, enter for song time selecting. N, n for next song in selected directory, P, p for previous song." DATA "With mouse is possible using LOOP one or LOOP all songs, play, stop, pause, next, previous, to time select click to song time" DATA "display. Two icons are for LOOP / LOOP all (songs in selected dir). " DATA "Files for this program: QBPlay.EXE, SKINDb.PNG, Demo.MP3. All used pictures are in the one PNG file, all pictures used in this" DATA "PNG file from www.eu.fotolia.com. Program read none ID3, is without equalizer and without vizualization. Is possible, next ver-" DATA "sion this already to have. For ID3TAG - See to http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14111.msg122204#msg122204,i wrote it" DATA "but in this version is unimplemented. In the end this program is comming monkey." DATA "SUB Rodent / mouse coordination with program. Is off if this info is view," DATA "SUB WindowsFileOpenSystem / two QB64 WIKI sources in one SUB, returning path to directory in 8.3 format," DATA "SUB The End - monkeys and memory cleaning sub if program get out," DATA "SUB timing - yes. It calculate time. If is runned as timing TIMER, calculate current time from TIMER," DATA "SUBS ViewVolume, ViewFrequency, ViewVolumeLevel... the same _PUTIMAGE subs. Many coordinates...." DATA "SUB rest - reset sound playng if error is comming, because _SNDPLAY generate none errors, is possible if uncompatible file is " DATA "SUB hraj - its heart. This sub plays music." DATA "SUB nacti.b - this sub is my FIRST, this load files with mask filtering to memory (old version was not here used named nacti.A" DATA "reads it direct from harddrive), this sub is writed 14 days before i have found windows library file system..." DATA "SUB cj - for Czech text correct readable by SUB znak and the to correct displayed" DATA "SUB RAP - call other SUBS, because this sub is as graphic central, it displayed song name in the program" DATA "SUB znak - First write to unvisible screen song name. Then with POINT is this scaning and every point is with LINE drawing to" DATA "other unvisible screen. View this is then used as song name in program. Happy coding! Petr" DATA " And now.... i need 2D game in the Commander Keen style to write..."
SUB WindowsFileOpenSystem
SHARED reload
, zvuk&
, Lb
, akt
, stopp
, rndpl
wfos:
'_TITLE "Super Window"
hwnd&&
= FindWindow
(0, "QB64 Music Player. By Petr - Petr.Pr@email.cz" + CHR$(0))
TYPE BROWSEINFO
'typedef struct _browseinfo 'Microsoft MSDN http://msdn.microsoft.com/en-us/library/bb773205%28v=vs.85%29.aspx END TYPE 'BROWSEINFO, *PBROWSEINFO, *LPBROWSEINFO;
FUNCTION SHBrowseForFolder%&
(x
AS BROWSEINFO
) 'Microsoft MSDN http://msdn.microsoft.com/en-us/library/bb762115%28v=vs.85%29.aspx
b.hwndOwner = hwnd
o = SHBrowseForFolder(b)
' PRINT LEFT$(s$, INSTR(s$, CHR$(0)) - 1)
SHGetPathFromIDList o
, _OFFSET(s2$
)
'this function make 8.3 worlwide full compatible format to correct acces to folder with no - english chars!:
'=== SHOW SHORT PATH NAME
FileOrPath$ = FolderLong$ '<< change to a relevant path or file name on computer
Result
= GetShortPathNameA
(FileOrPath$
+ CHR$(0), ShortPathName$
, LEN(ShortPathName$
)) Folder$ = ShortPathName$
'end of 8.3 function
' IF Folder$ = "" THEN EXIT SUB
mousex = 0: mousey = 0: Lb = 0
' IF stopp = 1 THEN stopp = 0
SHARED zvuk&
, i&
, new&
, obraz&
, f&
, GreenButtonPlay&
, GreenButtonStop&
, j&
, d&
, GreenButtonPower&
, GreenButtonBack&
, GreenButtonPause&
, GreenButtonNext&
, VolumePlus&
, VolumeMinus&
, ImageOpenFiles&
, resicon&
, infoicon&
, LoopOne&
, loopall&
, afterinfo&
hovno
= hovno
+ .2:
IF hovno
>= 255 THEN hovno
= 255 visible = 255 - hovno
'blok _FREE
' _FREEIMAGE LoopOneU&
' _FREEIMAGE LoopAllU&
' _FREEIMAGE LoopOneP&
' _FREEIMAGE LoopAllP&
opic1:
_PUTIMAGE (0, 0), new&
, obraz&
, (6, 410)-(260, 650) opic2:
_PUTIMAGE (0, 0), new&
, obraz&
, (273, 405)-(500, 650)
SUB timing
(hodnota
AS DOUBLE) ' calculate time. Writed for Timer, _SndLen. Input format as TIMER or _SNDLEN WITH "." SHARED hodin
, minut
, sekund
, sets
IF hodnota
< 60 THEN hodin
= 0: minut
= 0: sekund
= hodnota:
GOTO a1
IF hodnota
> 60 AND hodnota
< 3600 THEN hodin
= 0: minut
= hodnota
/ 60:
GOTO a2
hodin = hodnota / 3600
tecka
= INSTR(0, hodin$
, ".") minut
= (VAL("0." + RIGHT$(hodin$
, LEN(hodin$
) - tecka
)) * 0.6) * 100 a2:
sekund
= (VAL("0." + RIGHT$(minut$
, LEN(minut$
) - tecka
)) * 0.6) * 100 a1:
tecka
= INSTR(0, sekund$
, ".") sets
= (VAL("0." + RIGHT$(sekund$
, LEN(sekund$
) - tecka
)) * 1) * 100
SHARED zvuk&
, oldsec!
, d&
, i&
, MouseX
, MouseY
, Lb
, sec
, sekunda
, minuta
, mi
, se
, se2
, hodin
, minut
, sekund
, sets
IF sekunda
= 60 THEN sekunda
= 0
stp = 470: sty = -175
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (432 + stp
, 230 + sty
), d&
, i&
, (260, 0)-(286, 47)
stp = 440: sty = -175
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (432 + stp
, 230 + sty
), d&
, i&
, (260, 0)-(286, 47)
stp = 370: sty = -175
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (432 + stp
, 230 + sty
), d&
, i&
, (260, 0)-(286, 47)
stp = 400: sty = -175
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (432 + stp
, 230 + sty
), d&
, i&
, (260, 0)-(286, 47)
' minuta = 20
IF minuta
< 10 THEN minuta1
= minuta
'VAL(RIGHT$(STR$(minuta), 1)) ' IF sec < 60 AND minuta < 1 THEN minuta = 0
stp = 300: sty = -175
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (432 + stp
, 230 + sty
), d&
, i&
, (260, 0)-(286, 47)
stp = 330: sty = -175
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230 + sty
), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230 + sty
), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230 + sty
), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (432 + stp
, 230 + sty
), d&
, i&
, (260, 0)-(286, 47)
' s = 25864
'use 5 chracters to view frequency
' COLOR _RGB32(255, 255, 255): PRINT Ach, Bch, Cch, Dch, Ech 'ALL pass
stp = 165
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (427 + stp
, 230), d&
, i&
, (260, 0)-(286, 47)
stp = 190
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (427 + stp
, 230), d&
, i&
, (260, 0)-(286, 47)
stp = 215
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (427 + stp
, 230), d&
, i&
, (260, 0)-(286, 47)
stp = 240
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (427 + stp
, 230), d&
, i&
, (260, 0)-(286, 47)
stp = 265
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (427 + stp
, 230), d&
, i&
, (260, 0)-(286, 47)
' Left Speaker --------#-------- Right Speaker - usable with mouse to left or right speaker or keyboard "<" and "," or ">" and "." Full funcionality only
' -100 to 0 to 100 with WAV files.
_PUTIMAGE (400, 150), d&
, i&
, (321, 0)-(392, 65) _PUTIMAGE (590, 150), d&
, i&
, (321, 0)-(392, 65)
LINE (525 - (channel#
* 50), 175)-(535 - (channel#
* 50), 195), _RGB32(20, 40, 20), BF
' COLOR _RGB32(255, 255, 255): PRINT 'ok, funguje s double
bila2&
= _RGB32(215, 215, 215)
' Volume = 256
' firstV$ = "1"
' _DEST i&
' COLOR bila&
' CLS
' PRINT sv, 'STR$(Volume)
' SLEEP
'fv = 0
SELECT CASE fv
'first character Volume. Its 0 or 1 -------------------------- vloz to do noveho pole& a tam trochu zpruhledni ty bily segmenty a teprve pak to vloz do i&
'load null to view
_PUTIMAGE (392, 230), d&
, i&
, (285, 0)-(320, 45)
'load one to view
_PUTIMAGE (400, 230), d&
, i&
, (1, 0)-(23, 47)
'COLOR _RGB32(255, 255, 255): PRINT Tv ', LEN(STR$(Volume)) ' overeno, ze sv ukazuje spravne cislo, overeno a spraveno FV!, overena spravna hodnota Tv - here i tested it
'multipl = (23 * sv) + 10
_PUTIMAGE (426, 230), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430, 230), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430, 230), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430, 230), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430, 230), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430, 230), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424, 230), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424, 230), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426, 230), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (422, 230), d&
, i&
, (252, 0)-(286, 47)
stp = 30
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (285, 0)-(320, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (1, 0)-(33, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (30, 0)-(57, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (64, 0)-(95, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (95, 0)-(120, 47)
_PUTIMAGE (430 + stp
, 230), d&
, i&
, (130, 0)-(154, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (156, 0)-(185, 47)
_PUTIMAGE (424 + stp
, 230), d&
, i&
, (190, 0)-(217, 47)
_PUTIMAGE (426 + stp
, 230), d&
, i&
, (225, 0)-(250, 47)
_PUTIMAGE (427 + stp
, 230), d&
, i&
, (260, 0)-(286, 47)
' BEEP
' WindowsFileOpenSystem
IF PlEr
= 1 THEN PlEr
= 0:
BEEP: WindowsFileOpenSystem
pokus = pokus + 1
akt = 0 + pokus - 1
nacti.b
reload = 1
RAP "StartDemo"
SHARED zvuk&
, hraju
, ch#
, Vol
, reload
, PlEr
zvuk&
= _SNDOPEN(plaj$
, "VOL, PAUSE, SETPOS, SYNC, LEN"):
' oldzvuk& = _SNDCOPY(zvuk&) hraju = 1
' _SNDBAL zvuk&, ch# * 1000 'i have here not enought place for 5.1 / 7.1 speakers. :-D
_SNDVOL zvuk&
, Vol
' _SNDBAL funcionality is correct only with garanteed file types.
seznam2$ = "": NewRecNr = 0: linka = 0: max = 0: reload = 0
'nacte a vyfiltruje soubory do poli Rfiles a Vfiles (Read and open files a Viewed as files)
comm$ = "dir *.* /x > filelist.qb64" ' vylistuje vsechny soubory ve slozce 8.3 a LONG / DIR make file filelist.qb64 with old type and new type file names
zacatek:
LINE INPUT #1, nothing$
' This read rows from DIR outputfile and load its to memory. Its better for harddrive, for SSD extra! linies = linies + 1
'PRINT linies
seznam2$(linies) = nothing$
konec:
'PRINT "Transformuji Seznam na pole U a V (usable a visible)"
' IF linies = 0 THEN _DEST 0: PRINT "No files for play.(line 1276)": BEEP: EXIT SUB
FOR test
= 0 TO linies
' This For...Next read array seznam and make two new arrays: Vfiles and Ufiles. Ussable for us is record from row 7 to row ' PRINT seznam$(test); " = record nr. "; test ' linies - 3
text = text + 1
' IF text > 6 AND text < linies - 3 THEN vyrazeno verzi 0.21C - necetl vsechny mozne soubory.
VFiles$
(test
) = RIGHT$(seznam2$
(test
), LEN(seznam2$
(test
)) - 49) IF VFiles$
(test
) <> "" AND LTRIM$(UFiles$
(test
)) = "" THEN UFiles$
(test
) = VFiles$
(test
) 'LTRIM$ remove spaces. This IF muss to be used, because if filename is <8 characters or is used compatible ' COLOR , 2: PRINT "UFILE RECORD"; UFiles$(test) 'VTK OK! filename with American ASCII, then filename is writed only as Vfile (visible and unvisible name is the same)
' COLOR , 6: PRINT "VFILE RECORD"; VFiles$(test) ' VTK OK!
'END IF
FOR mask
= 1 TO 11 ' Have 11 filetypes in DATA - am end this sub READ FileMask$
' in arrays we have all files in the directory. I need only types in DATA command. This filemask is filter. FOR FileFilter
= 0 TO linies
IF a$
= FileMask$
THEN MaskUFiles$
(FileFilter
) = RTRIM$(UFiles$
(FileFilter
)): MaskVFiles$
(FileFilter
) = RTRIM$(VFiles$
(FileFilter
)) ' PRINT FileMask$, RIGHT$(LTRIM$(UCASE$(LEFT$(UFiles$(FileFilter), (INSTR(0, UFiles$(FileFilter), ".") + 3)))), 3), mask, FileFilter,
' PRINT a$, FileMask$: SLEEP
'sleep
'REDIM MaskUFiles
'REDIM MaskVFiles
FOR vypis
= 0 TO linies
'here is already created filelist using filemask in DATA. But in array are empty records, this muss be removed.
IF MaskUFiles$
(vypis
) = STRING$(255, "") THEN GOTO nowrite
ELSE NewRecNr
= NewRecNr
+ 1: FinalUFiles$
(NewRecNr
) = LTRIM$(MaskUFiles$
(vypis
)) IF MaskVFiles$
(vypis
) = STRING$(255, "") THEN GOTO nowrite
ELSE NewRecNr2
= NewRecNr2
+ 1: FinalVFiles$
(NewRecNr2
) = LTRIM$(MaskVFiles$
(vypis
))
nowrite:
'IF RTRIM$(FinalUFiles$(1)) = "" THEN reload = 0: BEEP: EXIT SUB
' PRINT NewRecNr: SLEEP chyba.
'BEEP
'COLOR _RGB32(255, 255, 255)
'FOR ControlLoop = 0 TO NewRecNr
'PRINT FinalUFiles$(ControlLoop); ControlLoop; NewRecNr
'PRINT FinalVFiles$(ControlLoop); ControlLoop; NewRecNr2
'PRINT "MaskUFiles record NR:"; vypis; MaskUFiles$(vypis); "LEN:"; LEN(MaskUFiles$(vypis))
'PRINT "MaskVFiles record NR:"; vypis; MaskVfiles$(vypis); "LEN:"; LEN(MaskVfiles$(vypis))
'SLEEP
'NEXT ControlLoop
'here are sub outputs:
'NewRecNr - number new records - files accepts filemask
'FinalUFiles$(record_number) - list files accepts filemasks, usable to file access
'FinalVFiles$(record_number) - list files accepts filemasks, unusable to file acces if filename contains non US characters, but usable to correct view filenames with non US characters with _MAPUNICODE
'If filename contains US compatible characters, are both records the same.
'ERASE seznam2$, UFiles$, VFiles$, MaskUFiles$, MaskVFiles$
'RESTORE FileMask
FileMask:
DATA WAV
,OGG
,AIFF
,RIFF
,VOC
,MP3
,MIDI
,MOD,AIF
,RIF
,MID
linka = NewRecNr: max = NewRecNr
SUB cj
' Sub make Czech characters readable correctly on the screen. If you needed use this ' for other language, is possible, you needed others DATA block. Data blocks are
RESTORE Microsoft_pc_cpMIK
' for more languages in QB64 help (Shift + F1 / Alphabetical index / _MAPUNICODE statement / ' Code Pages)
FOR ASCIIcode
= 128 TO 255 ' But if your problem is in acces to files with no english names, see to sub nacti.b used in ' this program. This is first, based on DIR /X, uses 8.3 filenames, is full compatible for ALL
READ unicode
' languages. It have 2 outputs. One as long filenames uses national characters, two in 8.3 to ' file access. 8.3 is full compatible with all languages.
_MAPUNICODE unicode
TO ASCIIcode
' And i. I need adress in memory to read sound wave. For drawing sound waves to screen :-D
Microsoft_pc_cpMIK:
DATA 199,252,233,226,228,367,263,231,322,235,336,337,238,377,196,262 DATA 201,313,314,244,246,317,318,346,347,214,220,356,357,321,215,269 DATA 225,237,243,250,260,261,381,382,280,281,172,378,268,351,171,187 DATA 9617,9618,9619,9474,9508,193,194,282,350,9571,9553,9559,9565,379,380,9488 DATA 9492,9524,9516,9500,9472,9532,258,259,9562,9556,9577,9574,9568,9552,9580,164 DATA 273,272,270,203,271,327,205,206,283,9496,9484,9608,9604,354,366,9600 DATA 211,223,212,323,324,328,352,353,340,218,341,368,253,221,355,180 DATA 173,733,731,711,728,167,247,184,176,168,729,369,344,345,9632,160
SHARED t&
, i&
, InsertX
, ch#
, f&
, zvuk&
, GreenButtonPlay&
, GreenButtonStop&
, GreenButtonPower&
, viewto
, GreenButtonBack&
, viewto2
, GreenButtonNext&
, GreenButtonPause&
, MouseX
, MouseY
, vs
SHARED resicon&
, res
, i&
, polar
, bmx
, stopp
, LoopAll
, RandPlayOn&
, RandPlayOff&
, rndpl
IF text$
= "StartDemo" THEN text$
= "Waiting":
GOTO startdemo
startdemo:
znak text$
sk:
sht:
ViewVolumeLevel
ViewBalanceLevel ch#
ViewFrequency
PressLoop 1: PressLoop 2
LINE (435, 33)-(710, 128), _RGB32(0, 0, 0), B
'cernej obdelnik kolem TITLE
IF text$
= "getback.internal.cmd" THEN viewto
= TIMER + 4: text$
= "" ' this make green visible to 4 sec IF text$
= "getnext.internal.cmd" THEN viewto2
= TIMER + 4: text$
= ""
_PUTIMAGE (450, 30)-(700, 144), t&
, i&
, (InsertX
, -8)-(InsertX
+ 500, 150) InsertX = InsertX + 10
'COLOR _RGB32(255, 255, 255): LOCATE 1, 1: PRINT _SNDLEN(zvuk&)
viewicon:
res = res + polar / 2
IF res
>= 250 OR res
<= 0 THEN polar
= -polar
IF res
< 0 THEN res
= 0: polar
= -polar
IF res
> 255 THEN res
= 255: polar
= -polar
'COLOR _RGB(255, 255, 255): PRINT res
'udela kompletni obraz do t&, txt$ prichazi spravne
SHARED t&
, f&
, linka
, akt
, printed$
cj
' IF linka > akt THEN linka = 1
toend
= 140 - LEN(printed$
) PRINT printed$; txt$
' + STRING$(toend, CHR$(32)) ' SCREEN text&: SLEEP
scan&
= POINT(rozlozX
, rozlozY
) IF scan&
<> black&
THEN _DEST t&:
LINE ((tx
+ (rozlozX
* 4)) - 2, (ty
+ (rozlozY
* 4)) - 2)-((tx
+ (rozlozX
* 4)) + 2, (ty
+ (rozlozY
* 4)) + 2), _RGB32(33, 33, 38), B
' SCREEN t&: SLEEP
