Very Simple GUI - Printable Version

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 ;

'}