home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / WNDTOOL5.ZIP / POPDIR.SUB < prev    next >
Text File  |  1989-04-26  |  4KB  |  82 lines
  1. '
  2. '$PAGE
  3. '
  4. '******************************************************************************
  5. '                    Function :                                               *
  6. '                                                                             *
  7. ' Purpose:                                                                    *
  8. '                                                                             *
  9. '                                                                             *
  10. ' Results:                                                                    *
  11. '                                                                             *
  12. ' Usage  :                                                                    *
  13. '                                                                             *
  14. '                                                                             *
  15. ' Date Written : 01/01/89 - Date Tested: 01/01/89 - Author: James P Morgan    *
  16. ' Date Modified:          -            :          -       :                   *
  17. '-----------------------------------------------------------------------------*
  18. ' NOTE:                                                                       *
  19. '******************************************************************************
  20. '                                                                             *
  21. '     SUB PROGRAM NAME          (PARAMETERS)                 STATIC/RECURSIVE *
  22. '-----------------------------------------------------------------------------*
  23. '                                                                             *
  24. '============================================================================
  25. '
  26. SUB    POPDIR(SEARCH$,SHOWITEMS%,FORE%,BACK%,HFORE%,HBACK%,QUADRANT$,SHADOW%,NUMFILES%,SELECTFILE$) STATIC
  27.  
  28.        DEFINT A-Z                             'make all short interger by default
  29.  
  30.        REM $DYNAMIC                           'allocate array off far heap
  31.        DIM FILES$(1)                          'allocate an array of only 1 element
  32.        REM $STATIC                            'default arrays back to Basic data segment
  33.  
  34. POPDIR.START:
  35.        ATTR=0
  36.  
  37.        COUNT=&HFF00 OR ATTR                   'Get number of filenames that match SEARCH$
  38.  
  39.        I=INT(VARPTR(FILES$(0)))               'get pointer to start of array to hold filenames found
  40.  
  41.        CALL DIR(SEARCH$,I,COUNT)              'see how many files match our filename spec.
  42.  
  43.        IF (COUNT=-1) OR (COUNT = 0) THEN      'were any matching filenames found?
  44.            NUMFILES%=0                        'NO
  45.            SELECTFILE$="No Files Found"
  46.          GOTO POPDIR.DONE
  47.        END IF
  48.  
  49.        IF COUNT <> 0 THEN                     'allocate the filename array big
  50.            REDIM FILES$(COUNT)                'enough to hold all the filenames
  51.        END IF
  52.  
  53.        HEADER$=SEARCH$                        'this was the filename spec used for serach
  54.  
  55.        FOR I=0 TO COUNT                       'make each entry big enough to hold a filename
  56.            FILES$(I)=SPACE$(12)
  57.        NEXT
  58.  
  59.        COUNT=ATTR
  60.        I=INT(VARPTR(FILES$(0)))
  61.  
  62.        CALL DIR(SEARCH$,I,COUNT)
  63.  
  64.        MAXITEMS=COUNT                         'this many file names cab be displayed
  65.        SHOWFILES=SHOWITEMS%                   'but only display this many at a time
  66.  
  67.        CALL POPLIST(HEADER$,SHOWFILES,MAXITEMS,FILES$(),FORE%,BACK%,HFORE%,HBACK%,QUADRANT$,SHADOW%,SELECT.%)
  68.  
  69.        SELECT.%=SELECT.%-1                     'adjust
  70.  
  71.        IF SELECT.%<0 THEN                      'was a filename selected
  72.           SELECT.%=0                           'NO
  73.           SELECTFILE$=" "
  74.        ELSE
  75.           SELECTFILE$=FILES$(SELECT.%)         'return the filename selected
  76.        ENDIF
  77.  
  78. POPDIR.DONE:
  79.        ERASE FILES$                            'free memory allocated to array
  80.        EXIT SUB                                'return to caller
  81. END SUB
  82.