' DragDropWheel.bas
' written in QB64 v1.4 by Kaze, 2021-Jan-20

_TITLE "DragDropWheel"
CONST RSHIFT& = 100303
CONST LSHIFT& = 100304

_SCREENMOVE 102, 3
XdimCOL = 160
YdimROW = 44 ' ensure old laptops with 768pixels vertical will hold the whole window
wide& = _DESKTOPWIDTH
high& = _DESKTOPHEIGHT
IF high& > 1000 THEN YdimROW = 60
handle& = _NEWIMAGE(XdimCOL, YdimROW, 0)
SCREEN handle&

' Either one must be uncommented:
_DISPLAY
'_AUTODISPLAY 'no need of refreshing

_ACCEPTFILEDROP 'enables drag/drop functionality

IF INSTR(LCASE$(COMMAND$), "/purple") THEN
    COLOR 9, 0
ELSE
    COLOR 3, 0
END IF

PRINT "Current working directory path: "; CHR$(34); _CWD$; CHR$(34)
PRINT "User's program calling path: "; CHR$(34); _STARTDIR$; CHR$(34)
PRINT "Command line parameters sent when a program is started: "; CHR$(34); COMMAND$; CHR$(34)
PRINT "_OS$="; _OS$
PRINT

'Y = CSRLIN 'save the row
'X = POS(0) 'save the column

filecount% = 0
REDIM FileArray$(1000000) 'create dynamic array: 3880000 alocates 532MB - bigger values need 570+MB and give "Out Of Memory"

FOR i = 1 TO YdimROW
    FileArray$(i) = ""
NEXT

PRINT "Drag files from a folder and drop them in this window..."
'REDIM FileArray$(filecount%)

_DISPLAY
'pressakey$ = INPUT$(1)

a$ = ""
DO
    IF _TOTALDROPPEDFILES THEN
        'FOR i = 1 TO _TOTALDROPPEDFILES
        'a$ = _DROPPEDFILE(i)
        a$ = _DROPPEDFILE(1)
        'NEXT'
        _FINISHDROP 'If _FINISHDROP isn't called here then _TOTALDROPPEDFILES never gets reset.
        'ELSE
        'a$ = "Scroller.$$$"
        'SHELL _HIDE "DIR /B *.* > Scroller.$$$"
    END IF

    IF _FILEEXISTS(a$) THEN
        OPEN a$ FOR INPUT AS #1
        DO UNTIL EOF(1)
            LINE INPUT #1, filename$ 'read entire text file line
            filecount% = filecount% + 1
            FileArray$(filecount%) = filename$
        LOOP
        CLOSE #1
    END IF
    _LIMIT 30
LOOP WHILE a$ = ""

'PRINT "Printing filenames in current directory... ";: PRINT LTRIM$(STR$(filecount%))

FOR i = 1 TO YdimROW 'filecount%
    IF LEN(FileArray$(i)) >= XdimCOL THEN
        FileArray$(i) = MID$(FileArray$(i), 1, XdimCOL)
    ELSE
        FileArray$(i) = FileArray$(i) + SPACE$(XdimCOL - LEN(FileArray$(i)))
    END IF
    LOCATE i, 1: PRINT FileArray$(i);
NEXT

LOCATE 1, 1
crx = POS(0)
cry = CSRLIN
crxOLD = crx
cryOLD = cry
LOCATE cry, crx, 1, 30, 31

IF INSTR(LCASE$(COMMAND$), "/purple") THEN
    COLOR 8, 0
ELSE
    COLOR 0, 3
END IF
PRINT FileArray$(cry);
_DISPLAY
DO
    IF _KEYDOWN(LSHIFT&) THEN PLAY "L8V2ff-"
    IF _KEYDOWN(RSHIFT&) THEN PLAY "L8V2a-c-"
    'LOCATE cry, crx, 1, 30, 31
    key$ = INKEY$
    'DO: a$ = INKEY$: LOOP UNTIL a$ <> "" ' prevent ASC empty string read error
    IF key$ <> "" THEN
        code% = ASC(key$):
        IF code% THEN ' ASC returns any value greater than 0
            SELECT CASE ASC(key$)
                CASE 65 TO 97: 'PRINT key$;
                CASE ASC("a") TO ASC("z"): 'PRINT key$;
                CASE 27: COLOR 7, 0: SYSTEM 'END
            END SELECT
        ELSE
            SELECT CASE ASC(key$, 2)
                CASE 72: IF cry > 1 THEN cry = cry - 1 'up
                CASE 80: IF cry < YdimROW THEN cry = cry + 1 'down
                CASE 75: IF crx > 1 THEN crx = crx - 1 'left
                CASE 77: IF crx < XdimCOL THEN crx = crx + 1 'right
            END SELECT
        END IF
    END IF
    IF cryOLD <> cry THEN
        'LOCATE cryOLD, crx, 1, 30, 31: COLOR 3, 0: PRINT FileArray$(cryOLD);
        LOCATE cryOLD, 1, 1, 30, 31
        IF INSTR(LCASE$(COMMAND$), "/purple") THEN
            COLOR 9, 0
        ELSE
            COLOR 3, 0
        END IF
        PRINT FileArray$(cryOLD);
        cryOLD = cry
    ELSE 'it 'cry' could be changed by Mouse Wheel too, check it
        AsIfItIsINKEY% = _MOUSEINPUT '      Check the mouse status
        IF _MOUSEWHEEL = 1 THEN ' as if Down
            IF cry < YdimROW THEN cry = cry + 1 'down
        END IF
        IF _MOUSEWHEEL = -1 THEN ' as if Up
            IF cry > 1 THEN cry = cry - 1 'up
        END IF
    END IF
    'LOCATE cry, crx, 1, 30, 31: COLOR 0, 3: PRINT FileArray$(cry);
    LOCATE cry, 1, 1, 30, 31
    IF INSTR(LCASE$(COMMAND$), "/purple") THEN
        COLOR 8, 0
    ELSE
        COLOR 0, 3
    END IF

    PRINT FileArray$(cry);
    _DISPLAY
    'DO WHILE INKEY$ <> "": LOOP ' have to clear the keyboard buffer
    '_LIMIT 30 'commented because the wheel up/down was not working?!
LOOP

END


'_TITLE "Mouse Feedback"
'DO
'    DO WHILE _MOUSEINPUT '      Check the mouse status
'        PRINT _MOUSEX, _MOUSEY, _MOUSEBUTTON(1); _MOUSEBUTTON(2); _MOUSEBUTTON(3), _MOUSEWHEEL
'    LOOP
'LOOP UNTIL INKEY$ <> ""

'Syntax:
'infoExists%% = _MOUSEINPUT

'Description:
'- Returns -1 if new mouse information is available, otherwise it returns 0.
'- Must be called before reading any of the other mouse functions. The function will not miss any
'  mouse input even during an INPUT entry.
'- Use in a loop to monitor the mouse buttons, scroll wheel and coordinate positions.
'-  To clear all previous mouse data, use _MOUSEINPUT in a loop until it returns 0.



' _FONT (function) creates a new alphablended font handle from a designated image handle
' _FONT (statement) sets the current _LOADFONT function font handle to be used by PRINT or
'  _PRINTSTRING.
' _FONTHEIGHT (function) returns the font height of a font handle created by _LOADFONT.
' _FONTWIDTH (function) returns the font width of a MONOSPACE font handle created by _LOADFONT.
' _FREEFONT (statement) frees a font handle value from memory
' _LOADFONT (function) loads a TrueType font (.TTF) file of a specific size and style and returns
'  a font handle value.

' _DISPLAY (statement) turns off automatic display while only displaying the screen changes when
'  called.

' SHELL (QB64 function) executes a DOS command or calls another program. Returns codes sent by END
'  or SYSTEM.
' _SHELLHIDE (function) hides a DOS command or call to another program. Returns codes sent by END
'  or SYSTEM.


' _CWD$ (function) returns the current working directory path as a STRING.
' _DONTWAIT (SHELL action) allows the program to continue without waiting for the other program to
'  close.
' _FILEEXISTS (function) returns -1 if the file name string parameter exists. Zero if it does not.
' _HIDE (SHELL action) hides the DOS screen output during a shell.

' _SHELLHIDE (function) executes a DOS command or calls another program. Returns codes sent by END
'  or SYSTEM.
' _STARTDIR$ (function) returns the user's program calling path as a STRING.



'The _MEMNEW function allocates new memory and returns a _MEM memory block referring to it.

'Syntax:
'     memoryBlock = _MEMNEW(byteSize)

'- The byteSize parameter is the desired byte size of the memory block based on the variable type
'  it will hold.

'Description:
'- The memoryBlock value created holds the elements .OFFSET, .SIZE, .TYPE and .ELEMENTSIZE.
'- _MEMNEW does not clear the data previously in the memory block it allocates, for speed purposes.
'- To clear previous data from a new memory block, use _MEMFILL with a byte value of 0.
'- When a new memory block is created the memory .TYPE value will be 0.
'- If the read only memory block .SIZE is 0, the memory block was not created.
'- All values created by memory functions must be freed using _MEMFREE with a valid _MEM variable.

'Code Examples:
'Example: Shows how SINGLE numerical values can be passed, but non-fixed STRING lengths cannot get
'the value.

'DIM m AS _MEM
'DIM f AS STRING * 5
'm = _MEMNEW(5) 'create new memory block of 5 bytes
'a = 12345.6
'_MEMPUT m, m.OFFSET, a 'put single value
'_MEMGET m, m.OFFSET, b 'get single value
'PRINT "b = "; b
'c$ = "Doggy"
'_MEMPUT m, m.OFFSET, c$ 'put 5 byte string value
'_MEMGET m, m.OFFSET, d$ 'get unfixed length string value
'_MEMGET m, m.OFFSET, f  'get 5 byte string value
'e$ = _MEMGET(m, m.OFFSET, STRING * 5) 'get 5 byte string value
'PRINT "d$ = "; d$; LEN(d$) 'prints empty string
'PRINT "e$ = "; e$; LEN(e$)
'PRINT "f = "; f; LEN(f)