Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Very Simple GUI
#28
Thanks to all for support and feedback. 

For my next installment something practical, a filename selector that allows you to run a file in Shell (DontWait) or Kill it! (Might as well cleanout some old files while I am testing code.) For Kills, I do make you confirm your choice by typing y for yes in an InputBox$ (which added allot of code for a silly y. I tried Fellippe's very simple MessageBox and was getting crazy or no results. I had to make screen pretty wide to fit Pathed Filenames across the breadth of the screen.

So here is code, you need direntry.h in your QB64.exe folder, a copy is provided commented out at the bottom of this code, remove comments and paste in txt file editor and save as direntry.h in QB64.exe folder. Oh I had to change my delimiter for Join$ of arrays because I had files with comma's in the title which the splitter busted up! So now using ~ to delimit strings.
Code: (Select All)
Option _Explicit
_Title "Get Filename test GUI-6-16" 'b+ 2022-06-16 test an appl with GUI as of 6-15
' from "GUI - add Misc 2022-06-15"
' 2022-06-14 & 15 add ListBoxes and Labels
' 2022-06-15 & 16, change labels to a control and change Sub NewControl to a Function that returns
' the index number to control variable name. (Take out ID as property in Control Type)
' This should make it easier to modify screens using variable names for your controls.
' change i, active in drwBtn and drwTB
' 2022-06-16 To test something serious I have Get Filename and once gotten you can Run it,
' Kill it or Cancel/Quit. I had to add GetLists which needs Direntry.h in QB64.exe Folder.
' A copy is provided at the end of this code. Dang need new file delimiter, some files have
' comma's in their name! Dang need wider screen!

'       GUI Notes:
' Very simple buttons and textboxes for starters"
' Use white border for active control, black for inactive ones.
' Use Tab and Shift+Tab for shifting active control else Mouse Click, to cursor position in TextBox
' or item in list box.

' Main loop will decide active control ID is basically the Index order for controls same as you
' post them with NewControl conType, X, Y, W, H, Text

' btn conType is 1, press enter to cause click event if tab to btn
' Active control moves down to next when clicked or enter press.

' textBox  conType = 2
' height needs to be at least 32 pixels high  for cursor below letters in box
' N1 is cursor position
' N2 to track toggle for blinking cursor
' Enter keypress on textBox will shift Active conrol down the index by 1
' Hint: When change text, change cursor N1 to len(con(i).text) + 1

' ListBox  conType = 3
' for LstBx need to Join$ (Function below) an array into a ~ delimited string for Text in NewControl
' N1 = page number we are on
' N2 = current location of the highlight bar on the page
' N3 = page width in chars
' N4 = page height + 2 lines (32 pixels) are left blank at top and bottom for mouse click navigation.
' N5 = Ubound of the list() base 1 ie last item number
' text = a splitable into array so need split N5 is (re)discovered in split when drawn
' Enter Keypress selects the highlited item in List bx and moves active control to next control in ID ie index
' Left click Blank Top Left side > Home
' Left Click Blank Top Right side > PgUp
' Left Click Blank Bottom Left side > End
' Left Click Blank Bottom Right side > PgDn
' Right Click Box to select highlited, active control moves to next in index
'    note this wont activate or change highlite, only selects highlited item.
' Helper Sub Split and function Join$ added to manipulate arrays into strings (Join) or strings into arrays (Split).
' The Split sub is used in DrwLst to separate ~ delimited string into an array for List Box to display.
' Also split text when need to find selected item.
' You can scroll lists with Mouse wheel!

' label box conType = 4  labels are sizable with Height and fit between (centered) x and x + w
'
' This is added for this appl ===============================================================================
' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< see end of Subs abd Functions for copy
Declare CustomType Library ".\direntry"
    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
'===========================================================================================================

'reset your colors here   FC = ForeColor  BC = Back Color  All the RGB32() are right here in constans section!
Dim Shared As _Unsigned Long screenBC, BtnFC, BtnBC, TbFC, TbBC, LstFC, LstBC, LblFC
screenBC = _RGB32(160, 180, 160)
BtnFC = _RGB32(0, 0, 0)
BtnBC = _RGB32(250, 250, 250)
TbFC = _RGB32(180, 180, 255)
TbBC = _RGB32(0, 0, 128)
LstFC = _RGB32(255, 180, 180)
LstBC = _RGB32(190, 0, 0)
LblFC = _RGB32(0, 0, 68)

Type Control ' all are boxes with colors, 1 is active
    As Long ConType, X, Y, W, H, N1, N2, N3, N4, N5 ' N1, N2 sometimes controls need extra numbers for special functions
    ' ID is actually index number same order as you enter NewControls
    As String Text, Text2 ' dims are pixels  Text2 is for future selected text from list box
    ' default wnd = 0, btn = 1, txtBx = 2, LstBx = 3
End Type
Dim Shared As Long Xmax, Ymax, NControls, ActiveControl, WindowClose ' new as long and WindowClose
ReDim Shared con(0) As Control

Dim As Long kh, mx, my, mb1, mb2, i, shift1, shift2, lc


'set your controls   and labels  ========================================================================  appl plug-in

Xmax = 1280: Ymax = 640 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  Window size shared throughout program
OpenWindow Xmax, Ymax, "Test Very Simple GUI-2022-06-15" ' <<<<<<<< set your window screen size and title
Dim Shared curPath$ ' track where we are in navigation see GetListStrings
Dim Shared As Long LblPath, LblCurPath, LblDirs, LblFils, LstD, LstF, LblFile, LblSelFile, BtnOK, BtnKill, BtnCancel
Dim fils$, dirs$
GetListStrings dirs$, fils$
LblPath = NewControl(4, 0, 10, _Width, 20, "Current Folder:")
LblCurPath = NewControl(4, 0, 35, _Width, 16, curPath$)
LblDirs = NewControl(4, 150, 60, 300, 20, "Sub Directorys:")
LblFils = NewControl(4, 530, 60, 600, 20, "Files:")
LstD = NewControl(3, 150, 85, 300, 432, dirs$)
LstF = NewControl(3, 530, 85, 600, 432, fils$)
LblFile = NewControl(4, 0, 520, _Width, 20, "Selected File:")
LblSelFile = NewControl(4, 0, 550, _Width, 16, "Selected File goes here")
BtnOK = NewControl(1, 20, 580, 400, 50, "OK Run it.")
BtnCancel = NewControl(1, 440, 580, 400, 50, "Quit")
BtnKill = NewControl(1, 860, 580, 400, 50, "Kill it!")

' ========================================================================================================================

Do
    ' mouse clicks and tabs will decide the active control
    While _MouseInput
        If con(ActiveControl).ConType = 3 Then
            If _MouseWheel > 0 Then
                LstKeyEvent ActiveControl, 20480
            ElseIf _MouseWheel < 0 Then
                LstKeyEvent ActiveControl, 18432
            End If
        End If
    Wend
    mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1): mb2 = _MouseButton(2)
    If mb1 Then ' find which control
        For i = 1 To NControls
            If mx >= con(i).X And mx <= con(i).X + con(i).W Then
                If my >= con(i).Y And my <= con(i).Y + con(i).H Then
                    If i <> ActiveControl And con(i).ConType <> 4 Then
                        activateControl ActiveControl, 0
                        ActiveControl = i
                        activateControl ActiveControl, -1
                    End If
                    Exit For
                End If
            End If
        Next
        If con(ActiveControl).ConType = 1 Then
            BtnClickEvent ActiveControl
            shiftActiveControl 1
        ElseIf con(ActiveControl).ConType = 2 Then ' move cursor to click point
            If mx >= con(ActiveControl).X And mx <= con(ActiveControl).X + con(ActiveControl).W Then
                If my >= con(ActiveControl).Y And my <= con(ActiveControl).Y + con(ActiveControl).H Then
                    con(ActiveControl).N1 = Int((mx - con(ActiveControl).X - 4) / 8) + 1
                    drwTB ActiveControl, -1
                End If
            End If
        ElseIf con(ActiveControl).ConType = 3 Then
            If my >= con(ActiveControl).Y And my <= con(ActiveControl).Y + 16 Then ' top empty
                If mx < con(ActiveControl).X + .5 * con(ActiveControl).W Then 'home else pgUp
                    LstKeyEvent ActiveControl, 18176 ' home
                ElseIf mx > con(ActiveControl).X + .5 * con(ActiveControl).W Then
                    LstKeyEvent ActiveControl, 18688 ' pgup
                End If
            ElseIf my >= con(ActiveControl).Y + con(ActiveControl).H - 16 And my <= con(ActiveControl).Y + con(ActiveControl).H Then ' bottom empty pgdn
                If mx < con(ActiveControl).X + .5 * con(ActiveControl).W Then 'end else pgDn
                    LstKeyEvent ActiveControl, 20224 ' end
                ElseIf mx > con(ActiveControl).X + .5 * con(ActiveControl).W Then
                    LstKeyEvent ActiveControl, 20736 ' pgdn
                End If
            ElseIf my >= con(ActiveControl).Y + 16 And my < con(ActiveControl).Y + con(ActiveControl).H - 16 Then
                con(ActiveControl).N2 = Int((my - con(ActiveControl).Y - 16) / 16) + 1
                drwLst ActiveControl, -1
            End If
        End If
        _Delay .2 ' user release key wait
    End If
    If mb2 Then ' use right clicking to select
        If con(ActiveControl).ConType = 3 Then ' this does not make the lst active but if is can select the highlited
            ReDim lst(1 To 1) As String
            Split con(ActiveControl).Text, "~", lst()
            con(ActiveControl).Text2 = lst((con(ActiveControl).N1 - 1) * con(ActiveControl).N4 + con(ActiveControl).N2)
            LstSelectEvent ActiveControl
            shiftActiveControl 1
            _Delay .2
        End If
    End If
    kh = _KeyHit
    shift1 = _KeyDown(100304)
    shift2 = _KeyDown(100303)
    If kh = 9 Then 'tab
        If shift1 Or shift2 Then
            shiftActiveControl -1
        Else
            shiftActiveControl 1
        End If
    ElseIf kh = 13 And con(ActiveControl).ConType = 1 Then ' enter on a btn
        BtnClickEvent ActiveControl
        shiftActiveControl 1
    ElseIf kh = 13 And con(ActiveControl).ConType = 2 Then
        shiftActiveControl 1
    ElseIf kh = 13 And con(ActiveControl).ConType = 3 Then
        ReDim lst(1 To 1) As String
        Split con(ActiveControl).Text, "~", lst()
        con(ActiveControl).Text2 = lst((con(ActiveControl).N1 - 1) * con(ActiveControl).N4 + con(ActiveControl).N2)
        LstSelectEvent ActiveControl
        shiftActiveControl 1
    End If
    If con(ActiveControl).ConType = 2 Then
        TBKeyEvent ActiveControl, kh ' this handles keypress in active textbox
        If lc Mod 10 = 9 Then con(ActiveControl).N2 = 1 - con(ActiveControl).N2 ' this is for blinking cursor
        If con(ActiveControl).N2 Then
            Line (con(ActiveControl).X + 4 + 8 * (con(ActiveControl).N1 - 1), con(ActiveControl).Y + (con(ActiveControl).H - 16) / 2 + 17)-Step(8, 3), &HFFFFFFFF, BF
        Else
            Line (con(ActiveControl).X + 4 + 8 * (con(ActiveControl).N1 - 1), con(ActiveControl).Y + (con(ActiveControl).H - 16) / 2 + 17)-Step(8, 3), TbBC, BF
        End If
    ElseIf con(ActiveControl).ConType = 3 Then
        LstKeyEvent ActiveControl, kh
    End If
    _Display
    lc = lc + 1
    _Limit 60
Loop Until WindowClose
System

Sub shiftActiveControl (change As Long) ' change = 1 or -1
    activateControl ActiveControl, 0 ' turn off last
    Do
        ActiveControl = ActiveControl + change
        If ActiveControl > NControls Then ActiveControl = 1
        If ActiveControl < 1 Then ActiveControl = NControls
    Loop Until con(ActiveControl).ConType <> 4
    activateControl ActiveControl, -1 ' turn on next
End Sub

Sub activateControl (i, activate)
    Select Case con(i).ConType
        Case 1: drwBtn i, activate
        Case 2: drwTB i, activate
        Case 3: drwLst i, activate
    End Select
End Sub

Sub OpenWindow (WinWidth As Long, WinHeight As Long, title$)
    Screen _NewImage(WinWidth, WinHeight, 32)
    _ScreenMove 70, 20
    _PrintMode _KeepBackground
    _Title title$
    Color &HFFFFFFFF, screenBC
    Cls
End Sub

Function NewControl& (ConType As Long, X As Long, Y As Long, W As Long, H As Long, s$) ' dims are pixels
    Dim As Long a
    NControls = NControls + 1
    ReDim _Preserve con(0 To NControls) As Control
    con(NControls).ConType = ConType
    con(NControls).X = X
    con(NControls).Y = Y
    con(NControls).W = W
    con(NControls).H = H
    con(NControls).Text = s$
    ActiveControl = 1
    If NControls = 1 Then a = 1 Else a = 0
    Select Case ConType
        Case 1: drwBtn NControls, a
        Case 2: drwTB NControls, a: con(NControls).N1 = Len(s$) + 1: con(NControls).N2 = 0
            ' N1 is what letter position we are on or cursor for line, N2 is the toggle for cursor blinking
        Case 3: con(NControls).N3 = Int((W - 16) / 8) ' page width - .5 charcter margin on each side 1 char scroll click bar
            con(NControls).N4 = Int((H - 32) / 16) ' page height 2 empty lines for page up, page down clicking
            con(NControls).N1 = 1 ' page number
            con(NControls).N2 = 1 ' select highlite bar
            con(NControls).Text2 = "" ' zero everything out for UDT's
            drwLst NControls, a
        Case 4: drwLbl NControls
    End Select
    NewControl& = NControls ' same as ID
End Function

Sub drwBtn (i As Long, active As Long) ' gray back, black text
    Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), BtnBC, BF
    If active Then Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B Else _
    Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
    Color BtnFC
    _PrintString (con(i).X + (con(i).W - 8 * Len(con(i).Text)) / 2, (con(i).Y + (con(i).H - 16) / 2)), con(i).Text
End Sub

Sub drwTB (i As Long, active As Long) ' blue back, white text
    Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), TbBC, BF
    If active Then
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B
    Else
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
    End If
    Color TbFC
    _PrintString (con(i).X + 4, con(i).Y + (con(i).H - 16) / 2), con(i).Text
End Sub

Sub drwLst (i As Long, active As Long)
    ' new control will get numbers for constructing a screen
    ' N1 = page number we are on
    ' N2 = current location of the highlight bar on the page
    ' N3 = page width in chars
    ' N4 = page height + 2 lines are left blank at top and bottom
    ' N5 = Ubound of the list() base 1 ie last item number
    Dim s$
    Dim As Long j
    Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), LstBC, BF
    If active Then
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B
    Else
        Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
    End If
    ReDim lst(1 To 1) As String
    Split con(i).Text, "~", lst()
    con(i).N5 = UBound(lst)
    For j = 1 To con(i).N4
        s$ = Space$(con(i).N3)
        If (con(i).N1 - 1) * con(i).N4 + j <= con(i).N5 Then
            Mid$(s$, 1, con(i).N3) = lst((con(i).N1 - 1) * con(i).N4 + j)
        End If
        If j <> con(i).N2 Then
            Color LstFC
        Else
            Line (con(i).X + 1, con(i).Y + 16 + (j - 1) * 16)-Step(con(i).W - 2, 16), LstFC, BF
            Color LstBC
        End If
        _PrintString (con(i).X + 4, con(i).Y + 16 + (j - 1) * 16), s$
    Next
End Sub

Sub drwLbl (i As Long)
    Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), screenBC, BF
    Static beenHere, fontHandle&(6 To 64)
    Dim As Long j
    If beenHere = 0 Then
        For j = 6 To 64
            fontHandle&(j) = _LoadFont("ARLRDBD.ttf", j)
        Next
        beenHere = -1
    End If
    Dim As _Unsigned Long curFont
    curFont = _Font
    _Font fontHandle&(con(i).H)
    Color LblFC, _RGB32(0, 0, 0, 0)
    _PrintString (con(i).X + (con(i).W - _PrintWidth(con(i).Text)) / 2, con(i).Y), con(i).Text
    _Font curFont
End Sub

Sub BtnClickEvent (i As Long) ' attach you button click code in here
    Dim answer$, dirs$, fils$ ' <<<<<<<<<<<<<<<<<< dim for click code
    Select Case i

        ' according to your appl needs ================================================ for your appl
        Case BtnOK: Shell _DontWait con(LblSelFile).Text ' hey run it!
        Case BtnKill
            answer$ = inputBox$(con(LblSelFile).Text, "Confirm Kill, enter y or n", _Width \ 8 - 7)
            If answer$ = "y" Then
                Kill con(LblSelFile).Text
                GetListStrings dirs$, fils$
                con(LstD).Text = dirs$
                con(LstF).Text = fils$
                con(LblSelFile).Text = ""
                drwLbl LblSelFile
                drwLst LstD, 0
                drwLst LstF, 0
            End If
        Case BtnCancel: WindowClose = -1 ' goodbye
            ' ========================================================================= end plug-in

    End Select
End Sub

' this is standard for all Text Boxes
Sub TBKeyEvent (i As Long, ky As Long) ' for all text boxes
    If ky = 19200 Then 'left arrow
        If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: drwTB i, -1
    ElseIf ky = 19712 Then ' right arrow
        If con(i).N1 < Int((con(i).W - 16) / 8) Then con(i).N1 = con(i).N1 + 1: drwTB i, -1
    ElseIf ky = 18176 Then 'home
        con(i).N1 = 1: drwTB i, -1
    ElseIf ky = 20224 Then ' end
        If Len(con(i).Text) + 1 <= Int((con(i).W - 16) / 8) Then con(i).N1 = Len(con(i).Text) + 1: drwTB i, -1
    ElseIf ky >= 32 And ky <= 128 Then
        If Len(con(i).Text) + 1 <= Int((con(i).W - 16) / 8) Then
            con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 1) + Chr$(ky) + Mid$(con(i).Text, con(i).N1)
            con(i).N1 = con(i).N1 + 1: drwTB i, -1
        End If
    ElseIf ky = 8 Then 'backspace
        If con(i).N1 > 1 Then
            con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 2) + Mid$(con(i).Text, con(i).N1)
            con(i).N1 = con(i).N1 - 1: drwTB i, -1
        End If
    ElseIf ky = 21248 Then 'delete
        con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 1) + Mid$(con(i).Text, con(i).N1 + 1): drwTB i, -1
    End If
End Sub

' this is standard for all List Boxes
Sub LstKeyEvent (i As Long, ky As Long) ' for all text boxes
    If ky = 18432 Then 'up arrow
        If con(i).N2 > 1 Then
            con(i).N2 = con(i).N2 - 1: drwLst i, -1
        Else
            If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: con(i).N2 = con(i).N4: drwLst i, -1
        End If
    ElseIf ky = 20480 Then ' down arrow
        If con(i).N2 < con(i).N4 And (con(i).N1 - 1) * con(i).N4 + con(i).N2 < con(i).N5 Then
            con(i).N2 = con(i).N2 + 1: drwLst i, -1
        Else
            If con(i).N2 = con(i).N4 Then ' can we start another page
                If con(i).N1 < con(i).N5 / con(i).N4 Then
                    con(i).N1 = con(i).N1 + 1: con(i).N2 = 1: drwLst i, -1
                End If
            End If
        End If
    ElseIf ky = 18176 Then 'home
        con(i).N1 = 1: con(i).N2 = 1: drwLst i, -1
    ElseIf ky = 20224 Then ' end
        If con(i).N5 Mod con(i).N4 = 0 Then
            con(i).N1 = Int(con(i).N5 / con(i).N4)
            con(i).N2 = con(i).N4
        Else
            con(i).N1 = Int(con(i).N5 / con(i).N4) + 1
            con(i).N2 = con(i).N5 Mod con(i).N4
        End If
        drwLst i, -1
    ElseIf ky = 18688 Then 'pgUp
        If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: drwLst i, -1
    ElseIf ky = 20736 Then 'pgDn
        If con(i).N1 * con(i).N4 < con(i).N5 Then
            con(i).N1 = con(i).N1 + 1
            If con(i).N1 > Int(con(i).N5 / con(i).N4) Then ' > last whole page check high bar
                If con(i).N2 > con(i).N5 Mod con(i).N4 Then con(i).N2 = con(i).N5 Mod con(i).N4
            End If
            drwLst i, -1
        End If
    End If
End Sub

Sub LstSelectEvent (control As Long)
    Dim fils$, dirs$
    Select Case control
        ' =================================================================================== for your appl
        Case LstD
            ChDir con(LstD).Text2
            curPath$ = _CWD$
            con(LblCurPath).Text = curPath$
            drwLbl LblCurPath
            GetListStrings dirs$, fils$
            con(LstD).Text = dirs$
            con(LstF).Text = fils$
            con(LblSelFile).Text = ""
            drwLbl LblSelFile
            drwLst LstD, 0
            drwLst LstF, -1 'should be active
        Case LstF
            con(LblSelFile).Text = curPath$ + "/" + con(LstF).Text2
            drwLbl LblSelFile
            ' ================================================================================= end plug-in
    End Select
End Sub

' This is used and available for maniupating strings to arrays ie change delimiters to commas
Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
    Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
    curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
    dpos = InStr(curpos, SplitMeString, delim)
    Do Until dpos = 0
        loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
        arrpos = arrpos + 1
        If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
        curpos = dpos + LD
        dpos = InStr(curpos, SplitMeString, delim)
    Loop
    loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
    ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
End Sub

' Available if need to create a string from an array
Function Join$ (arr() As String, delimiter$) ' modified to avoid blank lines
    Dim i As Long, b$
    For i = LBound(arr) To UBound(arr)
        If arr(i) <> "" Then
            If b$ = "" Then b$ = arr(i) Else b$ = b$ + delimiter$ + arr(i)
        End If
    Next
    Join$ = b$
End Function

' added to GUI - 2022-06-15 version =============================  Routines for this appl

' You can grab this box by title and drag it around screen for full viewing while answering prompt.
' Only one line allowed for prompt$
' boxWidth is 4 more than the allowed length of input, it needs to be longer than title$ and prompt$ also
' Utilities > Input Box > Input Box 1 tester v 2019-07-31
Function inputBox$ (prompt$, title$, boxWidth As Long) ' boxWidthin default 8x16 chars!!!
    Dim ForeColor As _Unsigned Long, BackColor As _Unsigned Long
    Dim sw As Long, sh As Long, curScrn As Long, backScrn As Long, ibx As Long 'some handles

    'colors
    ForeColor = &HFF000055 '<  change as desired  prompt text color, back color or type in area
    BackColor = &HFF6080CC '<  change as desired  used fore color in type in area

    'items to restore at exit
    ScnState 0

    'screen snapshot
    sw = _Width: sh = _Height: curScrn = _Dest
    backScrn = _NewImage(sw, sh, 32)
    _PutImage , curScrn, backScrn

    'moving box around on screen
    Dim bxW As Long, bxH As Long
    Dim mb As Long, mx As Long, my As Long, mi As Long, grabx As Long, graby As Long
    Dim tlx As Long, tly As Long 'top left corner of message box
    Dim lastx As Long, lasty As Long
    Dim inp$, kh&

    'draw message box
    bxW = boxWidth * 8: bxH = 7 * 16
    ibx = _NewImage(bxW, bxH, 32)
    _Dest ibx
    Color &HFF880000, &HFFFFFFFF
    Locate 1, 1: Print Left$(Space$(Int((boxWidth - Len(title$) - 3)) / 2) + title$ + Space$(boxWidth), boxWidth)
    Color &HFFFFFFFF, &HFFBB0000
    Locate 1, boxWidth - 2: Print " X "
    Color ForeColor, BackColor
    Locate 2, 1: Print Space$(boxWidth);
    Locate 3, 1: Print Left$(Space$((boxWidth - Len(prompt$)) / 2) + prompt$ + Space$(boxWidth), boxWidth);
    Locate 4, 1: Print Space$(boxWidth);
    Locate 5, 1: Print Space$(boxWidth);
    Locate 6, 1: Print Space$(boxWidth);
    inp$ = ""
    GoSub finishBox

    'convert to pixels the top left corner of box at moment
    bxW = boxWidth * 8: bxH = 5 * 16
    tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
    lastx = tlx: lasty = tly
    _KeyClear
    'now allow user to move it around or just read it
    While 1
        Cls
        _PutImage , backScrn
        _PutImage (tlx, tly), ibx, curScrn
        _Display
        While _MouseInput: Wend
        mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
        If mb Then
            If mx >= tlx And mx <= tlx + bxW And my >= tly And my <= tly + 16 Then 'mouse down on title bar
                If mx >= tlx + bxW - 24 Then Exit While
                grabx = mx - tlx: graby = my - tly
                Do While mb 'wait for release
                    mi = _MouseInput: mb = _MouseButton(1)
                    mx = _MouseX: my = _MouseY
                    If mx - grabx >= 0 And mx - grabx <= sw - bxW And my - graby >= 0 And my - graby <= sh - bxH Then
                        'attempt to speed up with less updates
                        If ((lastx - (mx - grabx)) ^ 2 + (lasty - (my - graby)) ^ 2) ^ .5 > 10 Then
                            tlx = mx - grabx: tly = my - graby
                            Cls
                            _PutImage , backScrn
                            _PutImage (tlx, tly), ibx, curScrn
                            lastx = tlx: lasty = tly
                            _Display
                        End If
                    End If
                    _Limit 400
                Loop
            End If
        End If
        kh& = _KeyHit
        Select Case kh& 'whew not much for the main event!
            Case 13: Exit While
            Case 27: inp$ = "": Exit While
            Case 32 To 128: If Len(inp$) < boxWidth - 4 Then inp$ = inp$ + Chr$(kh&): GoSub finishBox Else Beep
            Case 8: If Len(inp$) Then inp$ = Left$(inp$, Len(inp$) - 1): GoSub finishBox Else Beep
        End Select

        _Limit 60
    Wend

    'put things back
    ScnState 1 'need fg and bg colors set to cls
    Cls '? is this needed YES!!
    _PutImage , backScrn
    _Display
    _FreeImage backScrn
    _FreeImage ibx
    ScnState 1 'because we have to call _display, we have to call this again
    inputBox$ = inp$
    Exit Function

    finishBox:
    _Dest ibx
    Color BackColor, ForeColor
    Locate 5, 2: Print Left$(" " + inp$ + Space$(boxWidth - 2), boxWidth - 2)
    _Dest curScrn
    Return
End Function

' for saving and restoring screen settins
Sub ScnState (restoreTF As Long) 'Thanks Steve McNeill
    Static defaultColor~&, backGroundColor~&
    Static font&, dest&, source&, row&, col&, autodisplay&, mb&
    If restoreTF Then
        _Font font&
        Color defaultColor~&, backGroundColor~&
        _Dest dest&
        _Source source&
        Locate row&, col&
        If autodisplay& Then _AutoDisplay Else _Display
        _KeyClear
        While _MouseInput: Wend 'clear mouse clicks
        mb& = _MouseButton(1)
        If mb& Then
            Do
                While _MouseInput: Wend
                mb& = _MouseButton(1)
                _Limit 100
            Loop Until mb& = 0
        End If
    Else
        font& = _Font: defaultColor~& = _DefaultColor: backGroundColor~& = _BackgroundColor
        dest& = _Dest: source& = _Source
        row& = CsrLin: col& = Pos(0): autodisplay& = _AutoDisplay
        _KeyClear
    End If
End Sub

Sub GetListStrings (dirOut$, fileOut$)
    ReDim Folders$(1 To 1), Files$(1 To 1) ' setup to call GetLists
    If curPath$ = "" Then curPath$ = _CWD$
    GetLists curPath$, Folders$(), Files$()
    dirOut$ = Join$(Folders$(), "~")
    fileOut$ = Join$(Files$(), "~")
End Sub

Sub GetLists (SearchDirectory As String, DirList() As String, FileList() As String)
    ' Thanks SNcNeill ! for a cross platform method to get file and directory lists
    'put this block in main code section of your program close to top
    '' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    'DECLARE CUSTOMTYPE LIBRARY ".\direntry"
    '    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

    Const IS_DIR = 1
    Const IS_FILE = 2
    Dim flags As Long, file_size As Long, DirCount As Integer, FileCount As Integer, length As Long
    Dim nam$
    ReDim _Preserve DirList(100), FileList(100)
    DirCount = 0: FileCount = 0

    If load_dir(SearchDirectory + Chr$(0)) 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) Then
                    DirCount = DirCount + 1
                    If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
                    DirList(DirCount) = nam$
                ElseIf (flags And IS_FILE) 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 'move to after end if  might correct the multi calls problem
    Else
    End If
    close_dir 'this  might correct the multi calls problem

    ReDim _Preserve DirList(DirCount)
    ReDim _Preserve FileList(FileCount)
End Sub


' Remove comments below and copy paste into text editor, save as direntry.h
' Save in your QB64.exe folder if you don't have it already
'=============================================================  direntry.h copy but commented

'#include <dirent.h>
'#include <sys/stat.h>
'#include <unistd.h>

'const int IS_DIR_FLAG = 1, IS_FILE_FLAG = 2;

'DIR *pdir;
'struct dirent *next_entry;
'struct stat statbuf1;

'char current_dir[FILENAME_MAX];
'#ifdef QB64_WINDOWS
'  #define GetCurrentDir _getcwd
'#else
'  #define GetCurrentDir getcwd
'#endif

'int load_dir (char * path) {
'  struct dirent *pent;
'  struct stat statbuf1;
'//Open current directory
'pdir = opendir(path);
'if (!pdir) {
'return 0; //Didn't open
'}
'return -1;
'}

'int has_next_entry () {
'  next_entry = readdir(pdir);
'  if (next_entry == NULL) return -1;

'  stat(next_entry->d_name, &statbuf1);
'  return strlen(next_entry->d_name);
'}

'void get_next_entry (char * nam, int * flags, int * file_size) {
'  strcpy(nam, next_entry->d_name);
'  if (S_ISDIR(statbuf1.st_mode)) {
'    *flags = IS_DIR_FLAG;
'  } else {
'    *flags = IS_FILE_FLAG;
'  }
'  *file_size = statbuf1.st_size;
'  return ;
'}

'void close_dir () {
'  closedir(pdir);
'  pdir = NULL;
'  return ;
'}

'int current_dir_length () {
'  GetCurrentDir(current_dir, sizeof(current_dir));
'  return strlen(current_dir);
'}

'void get_current_dir(char *dir) {
'  memcpy(dir, current_dir, strlen(current_dir));
'  return ;
'}

Here is a screenshot of GUI Get Filename running some code with a bug in it ;-))

   

Linux might not have a problem with this, I used the other slanted slash to Join the path to the filename, see selected file label.
Wait does Linux do Shell?
b = b + ...
Reply


Messages In This Thread
Very Simple GUI - by bplus - 06-14-2022, 04:15 AM
RE: Very Simple GUI - by vince - 06-14-2022, 04:17 AM
RE: Very Simple GUI - by James D Jarvis - 06-14-2022, 04:26 AM
RE: Very Simple GUI - by bplus - 06-14-2022, 04:35 AM
RE: Very Simple GUI - by johnno56 - 06-14-2022, 05:42 AM
RE: Very Simple GUI - by Coolman - 06-14-2022, 08:21 AM
RE: Very Simple GUI - by RNBW - 06-14-2022, 09:50 AM
RE: Very Simple GUI - by Pete - 06-14-2022, 10:32 AM
RE: Very Simple GUI - by bplus - 06-14-2022, 02:32 PM
RE: Very Simple GUI - by Pete - 06-14-2022, 04:33 PM
RE: Very Simple GUI - by bplus - 06-15-2022, 01:45 PM
RE: Very Simple GUI - by bplus - 06-15-2022, 04:39 PM
RE: Very Simple GUI - by Coolman - 06-15-2022, 05:01 PM
RE: Very Simple GUI - by bplus - 06-15-2022, 05:04 PM
RE: Very Simple GUI - by Coolman - 06-15-2022, 06:38 PM
RE: Very Simple GUI - by Kernelpanic - 06-15-2022, 08:51 PM
RE: Very Simple GUI - by bplus - 06-15-2022, 09:00 PM
RE: Very Simple GUI - by Kernelpanic - 06-15-2022, 10:44 PM
RE: Very Simple GUI - by Kernelpanic - 06-15-2022, 10:54 PM
RE: Very Simple GUI - by bplus - 06-16-2022, 01:10 AM
RE: Very Simple GUI - by bplus - 06-16-2022, 05:28 AM
RE: Very Simple GUI - by RNBW - 06-16-2022, 11:31 AM
RE: Very Simple GUI - by RNBW - 06-16-2022, 11:36 AM
RE: Very Simple GUI - by bplus - 06-16-2022, 04:02 PM
RE: Very Simple GUI - by RNBW - 06-16-2022, 06:27 PM
RE: Very Simple GUI - by RNBW - 06-16-2022, 06:54 PM
RE: Very Simple GUI - by Coolman - 06-16-2022, 10:09 PM
RE: Very Simple GUI - by RNBW - 06-17-2022, 10:55 AM
RE: Very Simple GUI - by bplus - 06-17-2022, 01:54 AM
RE: Very Simple GUI - by Coolman - 06-17-2022, 09:03 AM
RE: Very Simple GUI - by bplus - 06-17-2022, 12:35 PM
RE: Very Simple GUI - by Coolman - 06-17-2022, 01:59 PM
RE: Very Simple GUI - by RNBW - 06-17-2022, 11:17 AM
RE: Very Simple GUI - by Kernelpanic - 06-17-2022, 12:35 PM
RE: Very Simple GUI - by bplus - 06-17-2022, 12:55 PM
RE: Very Simple GUI - by RNBW - 06-17-2022, 02:36 PM
RE: Very Simple GUI - by bplus - 06-17-2022, 02:47 PM
RE: Very Simple GUI - by Kernelpanic - 06-17-2022, 02:53 PM
RE: Very Simple GUI - by Kernelpanic - 06-17-2022, 12:42 PM
RE: Very Simple GUI - by bplus - 06-17-2022, 12:42 PM
RE: Very Simple GUI - by bplus - 06-17-2022, 01:38 PM
RE: Very Simple GUI - by bplus - 06-17-2022, 02:22 PM
RE: Very Simple GUI - by Kernelpanic - 06-17-2022, 02:46 PM
RE: Very Simple GUI - by Coolman - 06-17-2022, 02:56 PM
RE: Very Simple GUI - by bplus - 06-17-2022, 03:04 PM
RE: Very Simple GUI - by Kernelpanic - 06-17-2022, 03:15 PM
RE: Very Simple GUI - by bplus - 06-17-2022, 03:17 PM
RE: Very Simple GUI - by Kernelpanic - 06-17-2022, 06:31 PM
RE: Very Simple GUI - by bplus - 06-17-2022, 07:53 PM
RE: Very Simple GUI - by bplus - 06-17-2022, 08:08 PM
RE: Very Simple GUI - by Dav - 06-19-2022, 01:36 AM
RE: Very Simple GUI - by bplus - 06-19-2022, 02:02 AM
RE: Very Simple GUI - by Kernelpanic - 06-19-2022, 10:51 PM
RE: Very Simple GUI - by bplus - 06-19-2022, 07:55 PM
RE: Very Simple GUI - by bplus - 06-20-2022, 05:17 AM
RE: Very Simple GUI - by Coolman - 06-20-2022, 10:58 AM
RE: Very Simple GUI - by bplus - 06-20-2022, 04:36 PM
RE: Very Simple GUI - by bplus - 06-20-2022, 06:24 PM
RE: Very Simple GUI - by bplus - 06-20-2022, 06:50 PM
RE: Very Simple GUI - by bplus - 06-20-2022, 08:33 PM
RE: Very Simple GUI - by vince - 06-20-2022, 11:39 PM
RE: Very Simple GUI - by bplus - 06-21-2022, 04:36 PM
RE: Very Simple GUI - by bplus - 06-22-2022, 01:01 PM
RE: Very Simple GUI - by bplus - 06-22-2022, 10:27 PM
RE: Very Simple GUI - by bplus - 06-23-2022, 11:05 AM
RE: Very Simple GUI - by bplus - 06-26-2022, 01:44 AM
RE: Very Simple GUI - by bplus - 06-26-2022, 10:53 PM
RE: Very Simple GUI - by aurel - 06-27-2022, 06:17 AM
RE: Very Simple GUI - by bplus - 06-27-2022, 10:39 AM
RE: Very Simple GUI - by RNBW - 06-27-2022, 11:10 AM
RE: Very Simple GUI - by bplus - 06-28-2022, 02:27 AM
RE: Very Simple GUI - by bplus - 06-29-2022, 03:56 PM
RE: Very Simple GUI - by Coolman - 06-29-2022, 05:03 PM
RE: Very Simple GUI - by bplus - 06-29-2022, 05:22 PM
RE: Very Simple GUI - by bplus - 06-30-2022, 01:46 PM
RE: Very Simple GUI - by bplus - 06-30-2022, 01:52 PM
RE: Very Simple GUI - by bplus - 06-30-2022, 06:35 PM
RE: Very Simple GUI - by bplus - 06-30-2022, 06:51 PM
RE: Very Simple GUI - by Kernelpanic - 06-30-2022, 09:41 PM
RE: Very Simple GUI - by bplus - 07-01-2022, 10:20 PM
RE: Very Simple GUI - by vince - 07-01-2022, 10:24 PM
RE: Very Simple GUI - by bplus - 07-02-2022, 04:26 PM
RE: Very Simple GUI - by Kernelpanic - 07-02-2022, 05:24 PM
RE: Very Simple GUI - by bplus - 07-02-2022, 06:05 PM
RE: Very Simple GUI - by Kernelpanic - 07-02-2022, 06:19 PM
RE: Very Simple GUI - by bplus - 07-02-2022, 06:23 PM
RE: Very Simple GUI - by Kernelpanic - 07-02-2022, 06:33 PM
RE: Very Simple GUI - by bplus - 07-06-2022, 09:08 PM
RE: Very Simple GUI - by Kernelpanic - 07-07-2022, 03:20 PM
RE: Very Simple GUI - by bplus - 07-12-2022, 02:39 AM
RE: Very Simple GUI - by jjharley - 07-19-2022, 03:38 PM
RE: Very Simple GUI - by bplus - 07-19-2022, 04:08 PM
RE: Very Simple GUI - by vince - 04-25-2023, 03:10 AM
RE: Very Simple GUI - by bplus - 04-25-2023, 03:39 AM
RE: Very Simple GUI - by bplus - 04-25-2023, 04:00 PM
RE: Very Simple GUI - by vince - 04-25-2023, 09:02 PM
RE: Very Simple GUI - by bplus - 04-25-2023, 10:30 PM



Users browsing this thread: 20 Guest(s)