Very Simple GUI

[bplus]

Oh I have to comment on last GUI appl. I am amazed how long it took me to get going on a GUI app! Man, I can usually whip up some graphics code in what seems like minutes could be an hour or 2 but this:

Code: (Select All)

'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!")

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

Code: (Select All)

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

Code: (Select All)

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

What I wrote from the app, plus this:

Code: (Select All)

' 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
'===========================================================================================================

Code: (Select All)

' 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 ;
'}

Stuff already written but added to app. Plus I did change a couple minor things so I need to build next GUI from this version. 

I will do as @RNBW suggested and start separating library code into BI and BM while I also work on adding a new control for images and drawing, a Picture Box. Control Type #5.

I better start work on documenting too because there are details that need to be remembered when creating an app.
Like now you need ~ for delimiter to separate items in a string to split to pass arrays into LstBox controls #3 Type.