home *** CD-ROM | disk | FTP | other *** search
/ TopWare Tools / TOOLS.iso / tools / top1655 / gepackt.exe / SAMPLE / APTFILER.SRC < prev    next >
Encoding:
Text File  |  1994-01-16  |  7.4 KB  |  232 lines
  1.  /*
  2.    Source File: APTFILER.PRG
  3.         System: ApT Library
  4.         Author: JAO
  5.       Comments: Pick list of files dialog box
  6.  
  7.    Function list
  8.    =============
  9.    function aptFiler()     : File selection dialog
  10.    function aptDirectory() : Load file into array and sort the result
  11.    static selectFile()     : Record the currently highlighted file
  12.    static getWcard()       : Change wildcard specification
  13.    static trimPath()       : Trim a path to fit in the box
  14.  
  15.    Copyright (c) 1991 - 1993, APTware Ltd
  16.  */
  17.  
  18.  #include "aptfiler.ch"
  19.  #include "inkey.ch"
  20.  #include "directry.ch"
  21.  #include "setcurs.ch"
  22.  
  23.  static aDir     ,;  // Directory array
  24.         cFileName,;  // File selected
  25.         cPath    ,;  // Path of file selected
  26.         nLen         // Number of files
  27.  
  28.  /*
  29.               FUNCTION aptFiler
  30.     Purpose : Display files pick-list and allow selection
  31.     In      : cWcard - DOS Wildcard                    Default: "*.*"
  32.     Returns : Fully qualified filename (pathname + filename)
  33.     Example : cFile := aptFiler("*.prn")
  34.     Notes   : aptFiler() is a general purpose dialog box that offers a pick
  35.             : list of the files that match the wildcard in the current
  36.             : directory, and lets the user change directory at will.
  37.  */
  38.  
  39.  function aptFiler(cWcard)
  40.  
  41.    local oDCol    ,; // tbcolumn object
  42.         oDIR      ,; // tbrowse object
  43.         nP, nR, nC,; // Screen coordinates
  44.         i         ,; // Index into files array (details for a single file)
  45.         nAsk      ,; // Button selected in dialog box
  46.         cDir := substr(getargv(0), 1, rat("\", getargv(0)))
  47.  
  48.    default cWcard to "*.*"
  49.  
  50.    pushscr(0,0,maxrow(),maxcol())
  51.    setblink(.f.)
  52.    setcursor(SC_NONE)
  53.    cPath := normPath(cDir)
  54.  
  55.    nP := aptBox(37,13,,,,trimPath(cPath,35),,.t.,.f.)
  56.    nR := abs2r(nP)
  57.    nC := abs2c(nP)
  58.    do while .t.
  59.      i := 1
  60.      if len(aDir := aptDirectory(cWcard,"D")) == 0
  61.       if aptAsk("No matching files!;Set specification set to all?", YESNO) == 2
  62.         cFileName := "."
  63.         exit
  64.       endif
  65.       cWcard := "*.*"
  66.       loop
  67.      endif
  68.      oDIR := tbrowsenew(nR + 1, nC + 4, nR + 9, nC + 19)
  69.      oDIR:skipBlock         := {|x,k,o| o := i, k := i + x,;
  70.                                         i := if(k > nLen, nLen,;
  71.                                              if(k < 1, 1, i + x)), i - o}
  72.      oDIR:goTopBlock        := {|| i := 1}
  73.      oDIR:goBottomBlock     := {|| i := nLen}
  74.      oDIR:colorSpec         := PICKC
  75.      oDIR:cargo             := array(TB_CARGO_DIM)
  76.      oDIR:cargo[TB_LEDIT]   := .f.
  77.      oDIR:cargo[TB_REDRAW]  := .t.
  78.      oDIR:cargo[TB_REOPEN]  := .f.
  79.      oDIR:cargo[TB_SHADOW]  := .f.
  80.      oDIR:cargo[TB_STABIL]  := {|o| aptStabilize(o)}
  81.      oDIR:cargo[TB_BOX]     := BROWB
  82.      oDIR:cargo[TB_METHODS] := ;
  83.        {{K_ESC       , {|o| tbQuit(o)}}                 ,;
  84.         {K_UP        , {|o| o:up(),o}}                  ,;
  85.         {K_DOWN      , {|o| o:down(),o}}                ,;
  86.         {K_PGDN      , {|o| o:pageDown(),o}}            ,;
  87.         {K_PGUP      , {|o| o:pageUp(),o}}              ,;
  88.         {K_HOME      , {|o| o:home(),o}}                ,;
  89.         {K_END       , {|o| o:end(),o}}                 ,;
  90.         {K_CTRL_PGUP , {|o| o:goTop(),o}}               ,;
  91.         {K_CTRL_PGDN , {|o| o:goBottom(),o}}            ,;
  92.         {K_ENTER     , {|o| selectFile(o,cWcard)}}      ,;
  93.         {K_TAB       , {|o| tbQuit(o)}}}
  94.  
  95.      if isMouse()
  96.        oDIR:cargo[TB_INIT] := {|| pushHot(nR, nC + 21, nR + 8, nC + 33, ;
  97.                               {|| aptputkey(K_TAB)})}
  98.      endif
  99.  
  100.      oDCol := tbcolumnnew("", {|| aDir[i, F_NAME]})
  101.      oDCol:width := 15
  102.      oDIR:addColumn(oDCol)
  103.      aptButtons(BUT_SAY, {"WCARD", BUT_OK, BUT_CANCEL},;
  104.        nR + 1, nC + 23, 0, ASKC, BUT_VERTICAL)
  105.      oDIR := tbKeyHandler(oDIR, .f.)
  106.      if lastkey() == K_TAB .or. lastkey() == K_ESC
  107.        if lastkey() == K_ESC .or. (nAsk := aptButtons(BUT_GET)) == 3
  108.          chdir(substr(cDir, 1, len(cDir) - 1))
  109.          cFilename := "."
  110.          exit
  111.        elseif nAsk == 1
  112.          cWcard := getWcard(cWcard)
  113.        else
  114.          exit
  115.        endif
  116.      elseif lastkey() == K_ENTER
  117.        exit
  118.      endif
  119.    enddo
  120.    aptBox()
  121.    popScr()
  122.    setcursor(SC_NORMAL)
  123.  
  124.  return if(cFileName == ".", "", cPath + cFileName)
  125.  
  126.  /*
  127.               FUNCTION aptDirectory
  128.     Purpose : Load file names into an array
  129.     In      : cWcard - DOS Wildcard                       Default: "*.*"
  130.     Returns : Array of files (same structure as Clipper DIRECTORY() func)
  131.     Example : aFiles := aptDirectory("*.prn")
  132.     Notes   : List of files that match the wildcard in the current directory.
  133.             :
  134.             : "." is replaced with "\".
  135.             : Directories above the current directory are prefixed with
  136.             : "", those below with "".  File names are not prefixed.
  137.  */
  138.  
  139.  function aptDirectory(cWcard)
  140.  
  141.    local nStartAt := 1, aDir
  142.  
  143.    default cWcard to "*.*"
  144.  
  145.    aDir := directory(cWcard, "D")
  146.    if (nLen := len(aDir)) > 0
  147.      if aDir[1, F_NAME] == "."
  148.        aDir[1] := {"\",0,"","","D"}
  149.      endif
  150.      aeval(aDir, {|x,i| aDir[i, F_NAME] := padr(lower(aDir[i, F_NAME]), 12) + ;
  151.        if(aDir[i,F_ATTR] == "D", if(trim(aDir[i,F_NAME]) $ "\..", "","")," ")})
  152.    endif
  153.  
  154.  return aDir
  155.  
  156.  /*
  157.               FUNCTION selectFile
  158.     Purpose : Pick a file from aptFiler() dialog
  159.     In      : oD     - Tbrowse object
  160.             : cWcard - DOS Wildcard
  161.     Returns : oDIR   - Modified tbrowse object
  162.     Notes   : Select file method.  Copies the currently highlighted file
  163.             : name to a file-wide static and tells the tbrowse to quit.
  164.  */
  165.  
  166.  static function selectFile(oD, cWcard)
  167.  
  168.    local nScan := 0
  169.  
  170.    cFileName := substr(eval(oD:getColumn(oD:colPos):block), 1, 12)
  171.    nScan := ascan(aDir, {|x| cFileName == substr(x[F_NAME],1,12) .and.;
  172.      "D" $ x[F_ATTR]})
  173.    cFileName := rtrim(cFileName)
  174.    if nScan <> 0
  175.      if chdir(cFileName) == 0
  176.        if cFileName == ".."
  177.          cPath := substr(cPath, 1, rat("\", substr(cPath, 1, len(cPath) - 1)))
  178.        elseif cFileName == "\"
  179.          cPath := substr(cPath, 1, at("\", cPath))
  180.        else
  181.          cPath += upper(cFileName) + "\"
  182.        endif
  183.        @ oD:nTop-2, oD:nLeft-3 say padc(trimPath(cPath,35),35) color GROUPC
  184.        aDir := aptDirectory(cWcard)
  185.        oD:refreshAll()
  186.        oD:goTop()
  187.      endif
  188.    else
  189.      oD:cargo[TB_QUIT] := .t.
  190.    endif
  191.  
  192.  return oD
  193.  
  194.  /*
  195.               FUNCTION getWcard
  196.     Purpose : Change wildcard specification
  197.     In      : cSpec - Current wildcard
  198.     Returns : cGet  - New specification
  199.  */
  200.  
  201.  static function getWcard(cSpec)
  202.  
  203.    local nP := aptBox(30,1,,INPUTB,PICKC,,,.t.,.f.),;
  204.          getlist := {}
  205.  
  206.    cSpec := padr(cSpec, 12)
  207.    @ abs2r(nP), abs2c(nP) say "Enter wildcard" get cSpec picture "@!"
  208.    setcursor(SC_NORMAL)
  209.    readmodal(getlist)
  210.    setcursor(SC_NONE)
  211.    aptBox()
  212.  
  213.  return rtrim(cSpec)
  214.  
  215.  /*
  216.               FUNCTION trimPath
  217.     Purpose : Trims a DOS path, prepending "..." on overflow
  218.     In      : cPath - DOS path to trim
  219.             : nLen  - Length to trim it to
  220.     Returns : Trimmed path
  221.  */
  222.  
  223.  static function trimPath(cPath, nLen)
  224.  
  225.    nLen -= 3                // Make room for "..."
  226.    if len(cPath) > nLen
  227.      cPath := right(cPath, nLen)
  228.      cPath := "...\" + substr(cPath, at("\", cPath) + 1)
  229.    endif
  230.  
  231.  return cPath
  232.