home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April B / Pcwk4b98.iso / Borland / Dbase50w / SAMPLES1.PAK / CHANGDIR.PRG < prev    next >
Text File  |  1994-08-02  |  9KB  |  279 lines
  1. *******************************************************************************
  2. *  PROGRAM:      Changdir.prg
  3. *
  4. *  WRITTEN BY:   Borland Samples Group
  5. *
  6. *  DATE:         11/93
  7. *
  8. *  UPDATED:      6/94
  9. *
  10. *  VERSION:      dBASE FOR WINDOWS 5.0
  11. *
  12. *  DESCRIPTION:  This is a tool for changing directories.  It brings up a
  13. *                listbox of the current subdirectories, and lets you traverse
  14. *                your directory tree.  Double clicking in the listbox will
  15. *                select that directory.  Selecting the OK button makes your
  16. *                selected directory the current directory, and the CANCEL
  17. *                button cancels the program.
  18. *
  19. *  PARAMETERS:   None
  20. *
  21. *  CALLS:        Buttons.cc  (Custom controls file)
  22. *
  23. *  USAGE:        Do Changdir/Changdir()
  24. *
  25. *  NOTE:         dBASEWIN has a function, GetDirectory(), which accomplishes
  26. *                the same task as this program.
  27. *
  28. *******************************************************************************
  29.  
  30. #include <Messdlg.h>
  31. #include <Utils.h>
  32.  
  33. create session
  34.  
  35. set talk off
  36. set ldCheck off
  37. set procedure to program(1) additive
  38. set procedure to buttons.cc additive
  39.  
  40. public f
  41. f = new ChangDir()
  42. f.ReadModal()
  43.  
  44. *******************************************************************************
  45. *******************************************************************************
  46. class ChangDir of Form
  47. *******************************************************************************
  48.    this.top = 5.30
  49.    this.left = 6.76
  50.    this.height = 19.49
  51.    this.width = 54.06
  52.    this.mdi = .f.
  53.    this.sysmenu = .t.
  54.    this.text = "Change Directory"
  55.    this.sizeable = .t.
  56.    this.OnSelection = CLASS::OkOnClick
  57.  
  58.    define listbox directList of this;
  59.       property;
  60.          OnLeftDblClick CLASS::SetNewDir,;
  61.          top 3.18,;
  62.          left 1.35,;
  63.          height 15.91,;
  64.          width 36.49,;
  65.          colornormal "b/w",;
  66.          statusmessage "Click on a directory to display it,;
  67.                        Double click select it.";
  68.       custom;
  69.          dir set("directory")
  70.  
  71.    define entryfield curDirEntry of this;
  72.       property;
  73.          top 1.06,;
  74.          left 0.00,;
  75.          width 54.06,;
  76.          value space(78),;
  77.          colornormal "b/bg",;
  78.          colorhighlight "b/w",;
  79.          picture "@S78!",;
  80.          statusmessage "Currently selected directory.",;
  81.          OnGotFocus {;form.prevDir = this.Value},;
  82.          OnLostFocus CLASS::CheckDirExists
  83.  
  84.    define OkButton okToChange of this;
  85.       property;
  86.          OnClick CLASS::OkOnClick,;
  87.          top 3.18,;
  88.          left 39.19,;
  89.          statusmessage "Change directory to the one selected."
  90.  
  91.    define CancelButton cancelChange of this;
  92.       property;
  93.          OnClick CLASS::CancelOnClick,;
  94.          top 5.05,;
  95.          left 39.19,;
  96.          statusmessage "Forget it."
  97.  
  98.  
  99.  
  100.    ******************************************************************************
  101.    procedure OkOnClick
  102.    ******************************************************************************
  103.    private temp
  104.  
  105.    if CLASS::CheckDirExists()
  106.       temp = form.curDir
  107.       cd &temp
  108.       form.Close()
  109.    endif
  110.  
  111.    ******************************************************************************
  112.    procedure CancelOnClick
  113.    ******************************************************************************
  114.    private d     && macrosubstituted variables cannot be local.
  115.  
  116.    d = form.saveDir
  117.    cd &d
  118.    form.Close()
  119.  
  120.  
  121.    ******************************************************************************
  122.    procedure OnOpen
  123.    ******************************************************************************
  124.    private temp  && macrosubstituted variables cannot be local.
  125.  
  126.    form.saveDir  = set("directory") && save current dir in case Cancel selected
  127.    form.savePath = setto("path")    && save current path because it will change
  128.    form.setExact = set("exact")     && for restoring when leave
  129.  
  130.    form.curDir = setto("directory") && current directory
  131.    set path to &_dbwinhome.samples
  132.    set exact on
  133.    form.CreateDirArray()            && Create array of current subdirectories
  134.  
  135.    form.directList.dataSource = "array form.dirAr"
  136.    form.curDirEntry.dataLink = "form.curDir"
  137.    show object form.directList
  138.    show object form.curDirEntry
  139.  
  140.  
  141.    ******************************************************************************
  142.    procedure OnClose
  143.    ******************************************************************************
  144.    private p,e   && macrosubstituted variables cannot be local.
  145.  
  146.    p = form.savePath
  147.    e = form.setExact
  148.    set path to &p
  149.    set exact &e
  150.    cd
  151.  
  152.  
  153.    ******************************************************************************
  154.    procedure SetNewDir
  155.  
  156.    ******************************************************************************
  157.    private newDir,divideChar,showDir,lastSlashLoc,trimCurDir,temp
  158.  
  159.    newDir = ALLTRIM(form.directList.value)
  160.    trimCurDir = ALLTRIM(form.curDir)
  161.    lastSlashLoc = rat("\",trimCurDir)
  162.    if .not. empty(newDir) .and. newDir <> "."
  163.       divideChar = iif(right(trimCurDir,1) = "\","","\")
  164.                                     && if last char of
  165.                                     && form.curDir is '\', don't need
  166.                                     && to add it
  167.       if newDir = ".."               && Go back a directory
  168.          && ?more than one branch off the root
  169.          form.curDir = substr(trimCurDir,1,lastSlashLoc - ;
  170.             iif(lastSlashLoc > 3,1,0))
  171.       else
  172.          form.curDir = trimCurDir + iif(.not. empty(newDir),divideChar,"");
  173.             + newDir
  174.       endif
  175.       temp = form.curDir
  176.       cd &temp
  177.       form.dirAr = new Array(0)
  178.       form.CreateDirArray()
  179.       show object form.curDirEntry
  180.       show object form.directList
  181.       redefine listbox directList of form;
  182.          property;
  183.            top 3.18,;
  184.            left 1.35,;
  185.            height 15.91,;
  186.            width 36.49,;
  187.            dataSource "array form.dirAr",;
  188.            colornormal "b/w";
  189.          custom;
  190.            dir form.curDir
  191.    endif
  192.  
  193.    ******************************************************************************
  194.    procedure CreateDirArray
  195.  
  196.    * This needs to be a function to be called with () convention
  197.    ******************************************************************************
  198.    private i,j,tempAr,tempArSize
  199.  
  200.    tempAr = new Array(0)
  201.    tempArSize = tempAr.Dir("*.*","D")
  202.    j = 0
  203.    form.dirAr = new Array(0)
  204.    for i = 1 to tempArSize
  205.       if tempAr[i,5] = "....D"   && if directory, add it to form.dirAr
  206.          j = j + 1
  207.          form.dirAr.Grow(1)
  208.          form.dirAr[j] = tempAr[i,1]
  209.       endif
  210.    next i
  211.    form.dirAr.Sort()
  212.  
  213.  
  214.    ******************************************************************************
  215.    function CheckDirExists
  216.    ******************************************************************************
  217.    local ratSlash,tempDir,lenCurDir,exit
  218.    private dirExists,temp       && LOCALs cannot be macrosubstituted
  219.  
  220.    ratSlash = rat("\",form.curDir)
  221.    lenCurDir = len(rtrim(form.curDir))
  222.    dirExists = .t.
  223.    exit = .f.
  224.  
  225.    do case
  226.       case .not. DirExists(form.curDir)
  227.          if ConfirmationMessage(ALLTRIM(form.curDir) + chr(13) +;
  228.             "Doesn't exist. Continue?","Confirmation") = YES
  229.             form.curDir = form.prevDir
  230.             show object form.curDirEntry
  231.          else
  232.             exit = .t.
  233.          endif
  234.          dirExists = .f.
  235.       case rat(":",form.curDir) = lenCurDir  && only drive is entered
  236.          form.curDir = form.directList.dir
  237.          show object form.curDirEntry
  238.       case form.curDir <> form.directList.dir
  239.          * can't use RIGHT() because  string doesn't necessarily fill value
  240.          if ratSlash = lenCurDir .and. lenCurDir > 3  && get rid of last \
  241.             form.curDir = stuff(form.curDir, ratSlash, 1, "")
  242.          endif
  243.          temp = form.curDir
  244.          cd &temp
  245.          show object form.curDirEntry        && update entryfield display
  246.          form.CreateDirArray()
  247.          redefine listbox directList of form;
  248.             property;
  249.             top 3.18,;
  250.             left 1.35,;
  251.             height 15.91,;
  252.             width 36.49,;
  253.             dataSource "array form.dirAr",;
  254.             colornormal "b/w";
  255.          custom;
  256.             dir form.curDir
  257.    endcase
  258.    if exit
  259.       form.cancelChange.OnClick()
  260.    endif
  261.    return dirExists
  262.  
  263.  
  264. endclass
  265.  
  266. ******************************************************************************
  267. function DirExists( dir )
  268.  
  269. * Use adir() to create an array of subdirectories of the dir in question.
  270. * If any subdirectories exist (including ..\.), then dir exists.
  271. ******************************************************************************
  272. private d,checkAr,retVal,lastSlashLoc
  273.  
  274. d = rtrim(dir)
  275. declare checkAr[1]
  276. d = iif(right(d, 1) <> "\", rtrim(d) + "\", d) && make dir end with \
  277. return iif(adir(checkAr, d + "*.", "D") = 0, .f., .t.)
  278.  
  279.