Arrays is one way to go, but I got used to using a non-array method many moons ago. (_|_)

Locate 2

text$ = "Demo of mapping technique"

Print center$(text$)

text$ = "for mouse menu selection."

Print center$(text$)

_Delay 4

Print

text$ = "Watch as the program maps."

Print center$(text$)

text$ = "the menu at the bottom..."

Print center$(text$)

y = CsrLin: x = Pos(0)

a$ = "[F1] Help  [F5] Save  [Enter] Laugh at Steve  [Esc] Quit"

Locate _Height, _Width \ 2 - Len(a$) \ 2 + 1: Print a$;

Locate _Height - 2, 1

For i = 1 To _Width ' Convert to width.

    f$ = f$ + Chr$(Screen(_Height, i))

Next

_Delay 2: Color 8, 0

temp$ = " "

For i = 1 To Len(f$) ' Map mouse hot zones.

    x$ = Mid$(f$, i, 1)

    If hot Then

        If Left$(LTrim$(Mid$(f$, i) + "["), 1) = "[" Then

            hot = 1 - hot

            temp$ = " "

        End If

    End If

    If x$ <> Chr$(32) And hot = 0 Then

        hot = 1 - hot

        j = j + 1

        temp$ = Chr$(96 + j)

    End If

    map$ = map$ + temp$

    Print LTrim$(Str$(hot));: _Delay .1

Next

Locate _Height - 1, 1: Print map$;

Locate y, x

Color 7, 0

Print

text$ = "Now try the Mouse by clicking a"

Print center$(text$)

text$ = "selection from the bottom menu."

Print center$(text$)

Print

y = CsrLin

Do

    _Limit 30



    MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$



    If lb = 2 And my = _Height Then

        Select Case Asc(Mid$(map$, mx, 1)) - 96

            Case 1: b$ = "F1"

            Case 2: b$ = "F5"

            Case 3: b$ = "Enter"

            Case 4: b$ = "Esc"

        End Select

    End If

    If Len(b$) Then

        Select Case b$

            Case Chr$(0) + Chr$(59), "F1"

                text$ = "You selected: Help"

                Locate y: Print Space$(_Width - 1);

                Print center$(text$)

            Case Chr$(0) + Chr$(63), "F5"

                text$ = "You selected: Save"

                Locate y: Print Space$(_Width - 1);

                Print center$(text$)

            Case Chr$(13), "Enter"

                text$ = "You selected: Laugh at Steve. Great choice!"

                Locate y: Print Space$(_Width - 1);

                Print center$(text$)

            Case Chr$(27), "Esc"

                text$ = "You selected: Quit. See you later!"

                Locate y: Print Space$(_Width - 1);

                Print center$(text$)

                _Delay 4

                System

        End Select

    End If

Loop



Function center$ (text$)

    Locate , _Width \ 2 - Len(text$) \ 2 + 1

    center$ = text$

End Function



Sub MyMouse_and_Keyboard (lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$)

    Static oldmy, oldmx, z1, hover, mwy, oldmwy

    If Len(autokey$) Then

        b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)

        autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)

    Else

        b$ = InKey$

    End If

    If z1 Then If Abs(Timer - z1) > .3 Then z1 = 0: clkcnt = 0

    If lb > 0 Then

        If lb = 1 Then

            lb = -1

        Else

            lb = 0

        End If

    End If

    If rb > 0 Then If rb = 1 Then rb = -1 Else rb = 0

    If mb > 0 Then If mb = 1 Then mb = -1 Else mb = 0

    While _MouseInput

        mwy = mwy + _MouseWheel

    Wend

    my = _MouseY

    mx = _MouseX

    b_hover = 0

    For i = 1 To nob ' number of buttons.

        If my >= y_btl(i) And my <= y_bbr(i) And mx >= x_btl(i) And mx <= x_bbr(i) Then

            b_hover = i

            Exit For

        End If

    Next

    If lb = -1 Then

        If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then

            If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.

        End If

    End If

    If drag = 0 Then

        If mwy <> oldmw Then

            mw = Sgn(mwy - oldmwy): mwy = 0

        Else

            mw = 0

        End If

        oldmwy = mwy

        If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1 Else If shift% Then shift% = 0

    End If

    If lb = -1 And _MouseButton(1) = 0 Then

        lb = 2: drag = 0: hover = 0

    ElseIf rb = -1 And _MouseButton(2) = 0 Then

        rb = 2

    ElseIf mb = -1 And _MouseButton(3) = 0 Then

        mb = 2

    End If

    If _MouseButton(1) Then

        If lb = 0 Then

            lb = 1

            If z1 = 0 Then

                z1 = Timer ' Let first click go through.

            Else

                clkcnt = clkcnt + 1

            End If

        End If

    ElseIf _MouseButton(2) And rb = 0 Then

        rb = 1

    ElseIf _MouseButton(3) And mb = 0 Then

        mb = 1

    End If

    oldmy = my: oldmx = mx

End Sub

j = _InStrRev(Mid$(f$, 1, mx), "[") + 1

If j Then

    temp$ = RTrim$(Mid$(f$, j, InStr(Mid$(f$, j) + "[", "[") - 1))

    If mx < j + Len(temp$) Then

        If lb = 2 Then

            b$ = Mid$(temp$, 1, InStr(temp$, "]") - 1)

        End If

    End If

End If

1.
Is the new _IIF limited to only numerics ?  Or can I play with strings too ?

2. Can this statement be on one line:     p=_iff(p=instr(thing$,"\"): p <= 10, p, p=0)
  re: position of "\" must be less than 11 else make it zero

Question two in my mind very iffy.  If question #1 is true.
Don't need an code answer for question 2.  I could do that in my sleep.
Just thought sub-coding might be possible in a coded line.

This is a QB64 _INFLATE$ compatible compression library. Internally it uses Google's Zopfli. Zopfli is a highly optimized C-based compression library designed to produce efficient (though slow) Deflate or zlib-compressed data. The advantage is that the compressed data is fully compatible with QB64’s _INFLATE$ function, allowing seamless decompression.

The library contains a single function:

' @brief Compresses a STRING buffer using the Deflate algorithm with Zopfli. The output can be decompressed using QB64's _INFLATE$ function.

' @param inputBuffer The STRING buffer to compress.

' @param compressionLevel The compression level to use (0 - 65535). 65535 provides the highest compression, while 0 uses the library’s default. Levels above 255 may yield diminishing returns and are extremely slow.

' @return The compressed string.

FUNCTION DeflatePro$ (inputBuffer AS STRING, compressionLevel AS _UNSIGNED INTEGER)

Attached Files

  DeflatePro.zip (Size: 31.64 KB / Downloads: 12)

Hi,

I have found this error:

_ScreenMove _Middle

_Font 16

Palette 7, 63

MenuWidth = 0

bgc1 = 9: bgc2 = 1 ' Background appearance.

While -1

    Color 15, 1

    Cls

    Color 14, 1

    Locate 2, 1: Print String$(80, 196);

    Locate _Height - 1, 1: Print String$(80, 196);

    Color bgc1, bgc2

    For i = 3 To _Height - 2

        Locate i, 1: Print String$(80, 176);

    Next

    Color 14, 1

    Locate 1

    text$ = "Menu Options"

    Print center$(text$);

    Locate _Height

    text$ = "[F1] Help  [Esc] Quit"

    Print center$(text$);

    Restore menu_data: dcnt = 0

    Do

        Read dta$

        If dta$ = "eof" Then Exit Do

        If _Height \ 2 <= (dcnt * (spacing + 1) + 1) \ 2 + pop Then Exit Do ' Data exceeds window max menu height.

        dcnt = dcnt + 1

        ReDim _Preserve a$(dcnt)

        a$(dcnt) = dta$

        If Len(a$(dcnt)) > MenuWidth - 4 Then

            MenuWidth = Len(a$(dcnt)) + 4

            MenuLeft = _Width \ 2 - Len(a$(dcnt)) \ 2 - 2 + 1

        End If

    Loop

    MenuHeight = dcnt * (spacing + 1) - spacing + 2

    MenuTop = _Height \ 2 - MenuHeight \ 2 + 1

    Color 1, 7



    center_menu style, pop, a$(), dcnt, x, MenuWidth, MenuHeight, MenuTop, MenuLeft, spacing



    Do

        MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$



        If lb = 2 Then

            If my = _Height Then ' Special to footer menu.

                If FooterMap$ = "" Then

                    For i = 1 To _Width

                        FooterMap$ = FooterMap$ + Chr$(Screen(_Height, i))

                    Next

                End If

                j = _InStrRev(Mid$(FooterMap$, 1, mx), "[")

                If j Then

                    temp$ = Mid$(FooterMap$, j + 1)

                    b$ = Mid$(temp$, 1, InStr(temp$, "]") - 1)

                End If

            Else

                If my > MenuTop - pop And my < MenuTop - pop + MenuHeight - 1 And mx > MenuLeft - pop + 1 And mx < MenuLeft - pop + MenuWidth - 2 Then

                    j = (my - MenuTop + pop + spacing) / (spacing + 1)

                    If Int(j) = j Then

                        b$ = LTrim$(Str$(j))

                    End If

                End If

            End If

        End If

        Select Case b$

            Case "1": spacing = 0

            Case "2": spacing = 1

            Case "3": spacing = 2

            Case "4": style = 1 - style

            Case "5"

                Select Case bgc2

                    Case 0: bgc2 = 1

                    Case 1: bgc2 = 0

                End Select

            Case "6"

                pop = 1 - pop

            Case Chr$(0) + Chr$(59), "F1"

                Restore help_data

                Do

                    Read d$

                    If d$ = "eof" Then Exit Do

                    help$ = help$ + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + d$

                Loop

                _MessageBox " App Help", help$, ""

            Case Chr$(27), "Esc": Exit While

        End Select

        If Len(b$) Then Exit Do

    Loop

Wend

System



menu_data:

Data "1) Single-Space Display Menu"

Data "2) Double-Space Display Menu"

Data "3) Triple-Space Display Menu"

Data "4) Toggle Block/Center Style"

Data "5) Toggle Background Color"

Data "6) Toggle Flat/Popup Window"

Data eof



help_data:

Data This demo includes this

Data handy dandy help window

Data where we simply add data

Data statements to produce

Data then help text displayed

Data in this pop-up window.

Data eof



Function center$ (text$)

    Locate , _Width \ 2 - Len(text$) \ 2 + 1

    center$ = text$

End Function



Sub center_menu (style, pop, a$(), dcnt, x, MenuWidth, MenuHeight, MenuTop, MenuLeft, spacing)

    ' Centers height evenly for odd window heights and 1-space towards top for even.

    Locate MenuTop - pop, MenuLeft - pop

    For h = 1 To dcnt

        If h = 1 Then

            Color 1, 7: Print Chr$(218) + String$(MenuWidth - 2, 196) + Chr$(191)

            j = CsrLin

            For i = 1 To MenuHeight - 2

                If CsrLin < _Height Then Locate j, MenuLeft - pop Else Locate , MenuLeft - pop

                Color 1, 7: Print Chr$(179);

                Color 1, 7: Print Space$(MenuWidth - 2);

                Color 1, 7: Print Chr$(179);

                j = j + 1

            Next

            Locate j, MenuLeft - pop

            Color 1, 7: Print Chr$(192) + String$(MenuWidth - 2, 196) + Chr$(217);

            If pop Then ' Shadow effect.

                Color 8, 1 ' Shadow below.

                Locate CsrLin + 1, MenuLeft - pop + 2

                For i = 1 To MenuWidth

                    j = Screen(CsrLin, Pos(0))

                    Print Chr$(j);

                Next

                Locate MenuTop - pop + 1 ' Shadow to the right.

                For i = 1 To MenuHeight - 1

                    Locate , MenuLeft - pop + MenuWidth

                    j = Screen(CsrLin, Pos(0))

                    Print Chr$(j);

                    j = Screen(CsrLin, Pos(0))

                    Print Chr$(j)

                Next

            End If

        End If

        Color 0, 7

        Select Case style

            Case 0: x = _Width \ 2 - Len(a$(h)) \ 2 + 1 - pop

            Case 1: x = MenuLeft + 2 - pop

        End Select

        Locate MenuTop - pop + h + (h - 1) * spacing, x

        Print a$(h);

    Next h

End Sub



Sub MyMouse_and_Keyboard (lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$)

    Static oldmy, oldmx, z1, hover, mwy, oldmwy

    If Len(autokey$) Then

        b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)

        autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)

    Else

        b$ = InKey$

    End If

    If z1 Then If Abs(Timer - z1) > .3 Then z1 = 0: clkcnt = 0

    If lb > 0 Then

        If lb = 1 Then

            lb = -1

        Else

            lb = 0

        End If

    End If

    If rb > 0 Then If rb = 1 Then rb = -1 Else rb = 0

    If mb > 0 Then If mb = 1 Then mb = -1 Else mb = 0

    While _MouseInput

        mwy = mwy + _MouseWheel

    Wend

    my = _MouseY

    mx = _MouseX

    b_hover = 0

    For i = 1 To nob ' number of buttons.

        If my >= y_btl(i) And my <= y_bbr(i) And mx >= x_btl(i) And mx <= x_bbr(i) Then

            b_hover = i

            Exit For

        End If

    Next

    If lb = -1 Then

        If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then

            If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.

        End If

    End If

    If drag = 0 Then

        If mwy <> oldmw Then

            mw = Sgn(mwy - oldmwy): mwy = 0

        Else

            mw = 0

        End If

        oldmwy = mwy

        If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1 Else If shift% Then shift% = 0

    End If

    If lb = -1 And _MouseButton(1) = 0 Then

        lb = 2: drag = 0: hover = 0

    ElseIf rb = -1 And _MouseButton(2) = 0 Then

        rb = 2

    ElseIf mb = -1 And _MouseButton(3) = 0 Then

        mb = 2

    End If

    If _MouseButton(1) Then

        If lb = 0 Then

            lb = 1

            If z1 = 0 Then

                z1 = Timer ' Let first click go through.

            Else

                clkcnt = clkcnt + 1

            End If

        End If

    ElseIf _MouseButton(2) And rb = 0 Then

        rb = 1

    ElseIf _MouseButton(3) And mb = 0 Then

        mb = 1

    End If

    oldmy = my: oldmx = mx

End Sub

Here are 4 globes bouncing around on the screen with a giant "MERRY CHRISTMAS!" that doesn't use fonts. Instead I used POINT. 

Update: I just added a Christmas midi song to it and zipped it with the .bas file. The file is called: Ken's Christmas Globes 2.zip

Enjoy!

Attached Files

  Ken's Christmas Globes 2.zip (Size: 11.58 KB / Downloads: 12)

Here are 4 globes bouncing around the screen with a "MERRY CHRISTMAS!" in huge letters. I don't use fonts in this one, instead I used POINT. Check it out! This is probably my best Christmas one so far. I'll put it with the Christmas Code forum area as well.

Update: I just added a Christmas song to it and zipped it with the .bas file to download here. The file is called: Ken's Christmas Globes 2.zip

Update again: I thought the .exe was the .bas file, sorry about that! So I just replaced the .exe with the .bas and uploaded it again here. 

Enjoy!

Attached Files

  Ken's Christmas Globes 2.zip (Size: 11.58 KB / Downloads: 11)

Hi,
This I my first post…
I had never Heard of QB64 before until it was mentioned on amiga-news.de that there was a new version "Phoenix", so…
I compiled it on Mac Catalina and it works fine.
Now I was wondering can I install it on Raspberry OS (64 bit arm Bookworm?)…
If so how?
Do I Compile QB64-PE with ./setup_lnx.sh like any other Linux?
If so…  what exactly do I type in to Compile ./setup_lnx.sh?
Is it Run ?
Thank, I don't usually compile things.

This works as posted, but I intend to slowly add more to it.

Currently it will make a new file with a _nc addition. _nc for no comments.

Example: Pete.bas gets a new uncommented file made called: Pete_nc.bas

It also makes a _remarks file, with all the remarks listed.

So we get our 1 untouched original file and 2 new files in our example...

Pete.bas
Pete_nc
Pete_remarks.bas

It has an overwrite alert, so if by the smallest possibility you already have a file with same name and a _nc or _remarks, it will alert you. The same is true if you are running it multiple times selecting the same file again and again.

' Creates a new file with added _nc suffix void of all remark lines and a _remarks file with all the remarks.

_Title "Remark Remover"

Do

    Print "Open file dialog..."

    BasIn$ = _OpenFileDialog$("Remove Comments From File:", "", "*.bas|*.bi|*.bm", "QB64PE files", 0)

    Cls

    If BasIn$ <> "" Then

        period = _InStrRev(BasIn$, ".")

        BasOut$ = Left$(BasIn$, period - 1) + "_nc" + Mid$(BasIn$, period)

        dir$ = Mid$(BasOut$, 1, _InStrRev(BasOut$, "\"))

        file$ = Mid$(BasOut$, _InStrRev(BasOut$, "\") + 1)

        If _FileExists(BasOut$) Then

            j = _MessageBox(" Alert!", "File " + file$ + " already exists." + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "Overwrite?", "yesnocancel")

            Select Case j

                Case 2: Run

                Case 0: System

            End Select

        End If

        Open BasIn$ For Binary As #1

        a$ = Space$(LOF(1))

        Get #1, , a$

        Close #1

        Open BasOut$ For Output As #2

        Do

            i = i + 1

            x$ = Mid$(a$, i, 1)

            If Asc(x$) > 32 Then col = col + 1

            x2$ = LCase$(Mid$(a$, i, 4))

            If Mid$(x2$, 1, 1) = "'" Then

                If LTrim$(Mid$(a$, i + 2, 1)) = "$" Then x2$ = ""

            ElseIf x2$ = "rem " Then

                If Mid$(a$, i + 4, 1) <> "$" Then x2$ = "'" Else x2$ = ""

            End If

            If LCase$(Mid$(a$, i, 5)) = "data " Then dta = -1

            Select Case Mid$(x2$, 1, 1)

                Case "'"

                    If quote = 0 And dta = 0 Then

                        q = InStr(i, a$ + Chr$(13), Chr$(13))

                        If col = 1 Then lineout% = 2 Else lineout% = 0

                        temp$ = Mid$(a$, i, q + lineout% - i)

                        For k = 1 To Len(temp$)

                            If LCase$(Mid$(temp$, k, 1)) >= "a" And LCase$(Mid$(temp$, k, 1)) <= "z" Then flag = 1: Exit For

                        Next

                        If flag Then ' Only keep remarks with letters a-z.

                            cb$ = cb$ + Mid$(a$, i, q + lineout% - i) + Chr$(13) + Chr$(10): flag = 0

                        End If

                        i = q + lineout% - 1

                        new$ = RTrim$(new$)

                        If Right$(new$, 1) = ":" Then

                            temp$ = Mid$(new$, _InStrRev(Chr$(10) + new$, Chr$(10)))

                            If InStr(temp$, " ") Then ' Only remove if it is not a label. (solid characters ending in a colon).

                                new$ = Mid$(new$, 1, Len(new$) - 1) ' Remove trailing colon.

                            End If

                        End If

                        col = 0

                        _Continue

                    End If

                Case Chr$(34)

                    If dta = 0 Then quote = 1 - quote

                Case ":"

                    If dta Then dta = 0

                Case Chr$(13), Chr$(10)

                    quote = 0: col = 0: dta = 0

            End Select

            new$ = new$ + x$

        Loop Until i >= Len(a$)

        Print #2, new$

        Close #2

        If _FileExists(Left$(BasIn$, period - 1) + "_remarks" + Mid$(BasIn$, period)) Then

            If _MessageBox(" Alert!", "File " + Left$(BasIn$, period - 1) + "_remarks" + Mid$(BasIn$, period) + " already exists." + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "Overwrite to update contents?", "yesno") = 1 Then

                Open Left$(BasIn$, period - 1) + "_remarks" + Mid$(BasIn$, period) For Output As #1: Print #1, cb$: Close #1

            End If

        End If

        Open Left$(BasIn$, period - 1) + "_remarks" + Mid$(BasIn$, period) For Output As #1: Print #1, cb$: Close #1

        a$ = "File: " + BasOut$

        Locate 5, _Width \ 2 - Len(a$) \ 2: Print a$

        Locate 7

        Locate , _Width \ 2 - 4

        Print "Options:": Print

        j = _Width \ 2 - 16

        Locate , j: Print "Press 1 to Open in IDE"

        Locate , j: Print "Press 2 to Open in Notepad"

        Locate , j: Print "Press 3 to View Remarks Removed"

        Locate , j: Print "Press 4 to Show in File Explorer"

        Locate , j: Print "Press 5 to Rerun"

        Locate , j: Print "Press Esc to Quit"

        Do

            _Limit 30

            b$ = InKey$

            If Len(b$) Then

                Select Case b$

                    Case "1": Shell _DontWait _Hide "QB64pe.exe " + Chr$(34) + BasOut$ + Chr$(34)

                    Case "2": Shell _DontWait "notepad " + dir$ + file$

                    Case "3": Shell _DontWait "notepad tmp.tmp"

                    Case "4": nul$ = _OpenFileDialog$("Here's your Unremarkable file!", BasOut$)

                    Case "5": Cls: Run

                    Case Chr$(27): System

                End Select

            End If

        Loop

        Exit Do

    Else

        Exit Do

    End If

Loop

System

I have a ton (many thousands) of files that need to be organized and deduped. In the past I made due with Beyond Compare 4 and Agent Ransack (free fast desktop file search utility for Windows) but I'm going to need some fancy logic for this, and speed is important, and I'm thinking QB64PE might be a good platform. 

Has anyone used QB64PE to do any of these (preferably natively)? 

• recursively search subfolders
  
• compare filenames (matching strings with * ? wildcards)
  
• retrieve & compare two files' size in bytes
  
• retrieve & compare two files' modified dates
  
• binary compare file contents
  
• rename / move / copy / delete files
  
• create folders
  
• rename folders
  
• retrieve & compare folder names
  
• update a file's modified date to x