home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE5 / CUA_SAMP.ZIP / BUSINESS.PRG < prev    next >
Encoding:
Text File  |  1994-06-24  |  23.0 KB  |  826 lines
  1. ******************************************************************************
  2. ******************************************************************************
  3. * PROGRAM NAME: BUSINESS.PRG
  4. *
  5. *               SAMPLE CUA BUSINESS APPLICATION SYSTEM
  6. * LAST CHANGED: 06/20/94 08:00AM
  7. * WRITTEN BY:   Borland International Inc.
  8. *
  9. ******************************************************************************
  10. PROCEDURE Business
  11.     _cmdWindow.visible = .F.  && Get rid of command window
  12.     SET TALK OFF
  13.  
  14.     CLEAR ALL                   && Close open files and clear memvars
  15.  
  16.     SET STATUS OFF
  17.  
  18.     DEFINE FORM dB5___XXX PROPERTY VISIBLE .F.   && create an object
  19.     lVoid = dB5___XXX.Open()                     && reference variable
  20.     _CmdWindow.oDesk = dB5___XXX.Parent          && to point to _Desktop
  21.     lVoid = dB5___XXX.Close()                    && and store it in
  22.     lVoid = dB5___XXX.Release()                  && _CmdWindow
  23.     RELEASE dB5___XXX
  24.  
  25.     *
  26.     * Define the Menu Object as the Top most object and Open
  27.     *
  28.     DEFINE MENUBAR Main
  29.  
  30.     DEFINE MENU F1 OF Main ;
  31.         PROPERTY ;
  32.             Text "&File"
  33.  
  34.     *
  35.     * Define Menu Items under the FILE Option
  36.     *
  37.     DEFINE MENUITEM Open OF Main.F1 ;
  38.         PROPERTY ;
  39.             Text "&Open",;
  40.             StatusMessage "Browse a database file",;
  41.             OnClick OpenFile
  42.  
  43.     DEFINE MENUITEM CloseAll OF Main.F1 ;
  44.         PROPERTY ;
  45.             Text "&Close ALL" ,;
  46.             StatusMessage "Close all open database files",;
  47.             OnClick CloseAll
  48.  
  49.     DEFINE MENUITEM Sep1 OF Main.F1 ;
  50.         PROPERTY ;
  51.             Separator .T.
  52.  
  53.  
  54.     DEFINE MENUITEM Bac OF Main.F1 ;
  55.         PROPERTY ;
  56.             Text "&Back Up/Restore",;
  57.             OnClick "Back_Res" ,;
  58.             ProcFile "Back_res.prg"
  59.  
  60.     DEFINE MENUITEM Sep2 OF Main.F1 ;
  61.         PROPERTY ;
  62.             Separator .T.
  63.  
  64.     DEFINE MENUITEM Edbase OF Main.F1 ;
  65.         PROPERTY ;
  66.             Text "Exit to &dBASE",;
  67.             SHORTCUT "ALT-F4",;
  68.             StatusMessage "Exit to dBASE Command Window",;
  69.             OnClick cl_bus
  70.  
  71.     DEFINE MENUITEM Exit OF Main.F1 ;
  72.         PROPERTY ;
  73.             Text "E&xit to DOS",;
  74.             StatusMessage "Exit Business and return to the DOS Prompt",;
  75.             OnClick Leave
  76.  
  77.     *
  78.     * Define the second CUA Option EDIT
  79.     *
  80.     DEFINE MENU E OF Main ;
  81.         PROPERTY ;
  82.             Text "&Edit"
  83.  
  84.     *
  85.     * Define Menu Items under the EDIT Option
  86.     *
  87.     DEFINE MENUITEM Undo OF Main.E ;
  88.         PROPERTY ;
  89.             TEXT "&Undo",;
  90.             Enabled .F.,;
  91.             SHORTCUT "ALT-BACKSPACE",;
  92.             StatusMessage "Undo last change to the record",;
  93.             OnClick UndoIt
  94.  
  95.     DEFINE MENUITEM Save OF Main.E ;
  96.         PROPERTY ;
  97.             TEXT "&Save",;
  98.             Enabled .F.,;
  99.             StatusMessage "Save all changes to the current record",;
  100.             OnClick SubmitIt
  101.  
  102.     DEFINE MENUITEM Sep1 OF Main.E ;
  103.         PROPERTY ;
  104.             Separator .T.
  105.  
  106.     DEFINE MENUITEM Copy Of Main.E ;
  107.         PROPERTY ;
  108.             Text "&Copy",;
  109.             SHORTCUT "CTRL-INS",;
  110.             StatusMessage "This Option Not Implemented",;
  111.             OnClick NotReady
  112.  
  113.     DEFINE MENUITEM Paste OF Main.E ;
  114.         PROPERTY ;
  115.             Text "&Paste",;
  116.             SHORTCUT "SHIFT-INS",;
  117.             StatusMessage "This Option Not Implemented",;
  118.             OnClick NotReady
  119.  
  120.     *
  121.     * Define Menu VIEW of Main
  122.     *
  123.     DEFINE MENU V OF Main ;
  124.         PROPERTY ;
  125.             Text    "&View",;
  126.             ONCLICK  ChkObj
  127.  
  128.     DEFINE MENUITEM brws OF Main.V ;
  129.         PROPERTY ;
  130.             Text "&Browse",;
  131.             StatusMessage "Browse the currently open table",;
  132.             OnClick "AddBrowse"
  133.  
  134.     DEFINE MENUITEM Frm OF Main.V ;
  135.         PROPERTY ;
  136.             Text "&Form",;
  137.             StatusMessage "Display the Form for the currently open table",;
  138.             OnClick "AddForm"
  139.  
  140.     *
  141.     * Define the fourth CUA item Table
  142.     *
  143.     DEFINE MENU S OF Main ;
  144.         PROPERTY ;
  145.             Text "&Table",;
  146.             OnClick "CheckOpen"
  147.  
  148.     DEFINE MENUITEM Srch OF Main.S;
  149.         PROPERTY ;
  150.             Text "&Search",;
  151.             Enabled .F. ,;
  152.             StatusMessage "Search for records (based on currently open form)",;
  153.             OnClick "Srchr"
  154.  
  155.     DEFINE MENUITEM Sep1 OF Main.S ;
  156.         PROPERTY ;
  157.             Separator .T.
  158.  
  159.     DEFINE MENUITEM tp OF Main.S ;
  160.         PROPERTY ;
  161.             Text "&Top",;
  162.             Enabled .F. ,;
  163.             StatusMessage "Go to the top of the table",;
  164.             OnClick "GoTop"
  165.  
  166.     DEFINE MENUITEM btm OF Main.S ;
  167.         PROPERTY ;
  168.             Text "&Bottom",;
  169.             Enabled .F. ,;
  170.             StatusMessage "Go to the bottom of the table",;
  171.             OnClick "GoBott"
  172.  
  173.     DEFINE MENUITEM Sep2 OF Main.S ;
  174.         PROPERTY ;
  175.             Separator .T.
  176.  
  177.     DEFINE MENUITEM pck OF Main.S ;
  178.         PROPERTY ;
  179.             Text "&Pack",;
  180.             StatusMessage "Remove all records marked for deletion in all tables",;
  181.             OnClick "PackTabl"
  182.  
  183.     DEFINE MENUITEM Indx OF Main.S ;
  184.         PROPERTY ;
  185.             TEXT "&ReIndex",;
  186.             StatusMessage "Reindex all tables",;
  187.             OnClick "inddbf"
  188.  
  189.     *
  190.     * Define the fifth CUA item Application
  191.     *
  192.     DEFINE MENU App OF Main PROPERTY Text "&Application"
  193.  
  194.     DEFINE MENUITEM cust OF Main.App ;
  195.         PROPERTY ;
  196.             Text "&Customers",;
  197.             OnClick Cust,;
  198.             ProcFile "Cust.prg"
  199.  
  200.     DEFINE MENUITEM Ord OF Main.App ;
  201.         PROPERTY ;
  202.             Text "&Orders",;
  203.             OnClick Orders,;
  204.             ProcFile "Orders.prg"
  205.  
  206.     DEFINE MENUITEM Sep1 OF Main.App ;
  207.         PROPERTY ;
  208.             Separator .T.
  209.  
  210.     DEFINE MENUITEM Vend OF Main.App ;
  211.         PROPERTY ;
  212.             Text "&Vendors",;
  213.             OnClick Vendors,;
  214.             ProcFile "Vendors.prg"
  215.  
  216.     DEFINE MENUITEM Gds OF Main.App ;
  217.         PROPERTY ;
  218.             Text "&Goods",;
  219.             OnClick Goods,;
  220.             ProcFile "Goods.prg"
  221.  
  222.     DEFINE MENUITEM Sep2 OF Main.App ;
  223.         PROPERTY ;
  224.             Separator .T.
  225.  
  226.     DEFINE MENUITEM Acc OF Main.App ;
  227.         PROPERTY ;
  228.             Text "&Acct Recv",;
  229.             OnClick "Acct_rec" ,;
  230.             Procfile "Acct_rec.prg"
  231.  
  232.     DEFINE MENUITEM Inv OF Main.App ;
  233.         PROPERTY ;
  234.             Text "&Print Invoices",;
  235.             Onclick "Invoices",;
  236.             ProcFile "Invoices.prg"
  237.  
  238.     DEFINE MENUITEM Sep3 OF Main.App ;
  239.         PROPERTY ;
  240.             Separator .T.
  241.  
  242.     DEFINE MENUITEM emp OF Main.App ;
  243.         PROPERTY ;
  244.             Text "&Employee",;
  245.             OnClick Employee,;
  246.             ProcFile "Employee.prg"
  247.  
  248.     DEFINE MENUITEM Are OF Main.App;
  249.         PROPERTY ;
  250.             Text "A&rea Codes",;
  251.             OnClick "AreaCode",;
  252.             ProcFile "AreaCode.prg"
  253.     *
  254.     * Define the sixth CUA item HELP
  255.     *
  256.     DEFINE MENU H OF Main ;
  257.         PROPERTY ;
  258.             Text "&Help"
  259.     DEFINE MENUITEM keyb OF Main.H ;
  260.         PROPERTY ;
  261.             Text "&Keyboard",;
  262.             OnClick NotReady
  263.     DEFINE MENUITEM Indx OF Main.H ;
  264.         PROPERTY ;
  265.             Text "&Index",;
  266.             OnClick NotReady
  267.     DEFINE MENUITEM Abt OF Main.H ;
  268.         PROPERTY ;
  269.             Text "&About",;
  270.             OnClick "About"
  271.  
  272.     * Define the FORM for HELP|ABOUT
  273.     DEFINE FORM Abt_box FROM 1,3 TO 18,73 ;
  274.         PROPERTY ;
  275.             Text "About the Business Application",;
  276.             Sizeable .F.
  277.  
  278.     * Define the text to go in the form for HELP|ABOUT
  279.     DEFINE TEXT T1_abt OF Abt_box AT 1,2 ;
  280.         PROPERTY ;
  281.             TEXT "This version of BUSINESS was written specifically for dBASE for"
  282.     DEFINE TEXT T2_abt OF Abt_box AT 2,2 ;
  283.         PROPERTY ;
  284.             TEXT "DOS version 5.0.  It was originally known as the A-T FURNITURE"
  285.     DEFINE TEXT T3_abt OF Abt_box AT 3,2 ;
  286.         PROPERTY ;
  287.             TEXT "Application.  This version was rewritten to demonstrate the new"
  288.     DEFINE TEXT T4_abt OF Abt_box AT 4,2 ;
  289.         PROPERTY ;
  290.             TEXT "Event Handling Model and Object Model of dBASE for DOS v5.0."
  291.     DEFINE TEXT T5_abt OF Abt_box AT 6,2 ;
  292.         PROPERTY ;
  293.             TEXT "The Main Module is BUSINESS.PRG which calls subroutines named"
  294.     DEFINE TEXT T6_abt OF Abt_box AT 7,2 ;
  295.         PROPERTY ;
  296.             TEXT "after the tables (ie, EMPLOYEE, VENDORS, etc.)  Each Subroutine"
  297.     DEFINE TEXT T7_abt OF Abt_box AT 8,2 ;
  298.         PROPERTY ;
  299.             TEXT "also has a .DFM (FORM Source Code File) associated with it."
  300.     DEFINE TEXT T8_abt OF Abt_box AT 10,2 ;
  301.         PROPERTY ;
  302.             TEXT "Studying the source code (found in <d>:\<dbasedir>\CUA_SAMP will,"
  303.     DEFINE TEXT T9_abt OF Abt_box AT 11,2 ;
  304.         PROPERTY ;
  305.             TEXT "along with the product documentation, aid your understanding of"
  306.     DEFINE TEXT T10_abt OF Abt_box AT 12,2 ;
  307.         PROPERTY ;
  308.             TEXT "these new and very powerful dBASE language tools.",;
  309.             LABEL .F.
  310.  
  311.     * Define the PushButton for closing the form Abt_box
  312.     DEFINE PUSH okab OF Abt_box AT 14,30 ;
  313.         PROPERTY ;
  314.             TEXT "OK",;
  315.             WIDTH 10,;
  316.             DEFAULT .T.,;
  317.             OnClick CloseAbt
  318.  
  319.     CLEAR
  320.  
  321.     *
  322.     * Open the Menu Object as the top most object
  323.     *
  324.     lVoid = Main.open()
  325.     DO About
  326. RETURN
  327. ****************************
  328. PROCEDURE Inddbf                              && Indexing tables
  329.     IF LEN(DBF()) > 0                          && There is a table open
  330.         DO ErrorMsg WITH "You must exit all Forms to run this procedure .."
  331.     ELSE
  332.         DO Gauge
  333.         Status.Gauge.WIDTH = 5
  334.         Status.T3.Text = "Employee ..."
  335.         USE Employee EXCL
  336.         REINDEX
  337.         Status.Gauge.WIDTH = 10
  338.         Status.T3.Text = "Vendors ... "
  339.         USE Vendors EXCL
  340.         REINDEX
  341.         Status.Gauge.WIDTH = 15
  342.         Status.T3.Text = "Goods ...   "
  343.         USE GOODS EXCL
  344.         REINDEX
  345.         Status.Gauge.WIDTH = 20
  346.         Status.T3.Text = "Customer ..."
  347.         USE CUST EXCL
  348.         REINDEX
  349.         Status.Gauge.WIDTH = 25
  350.         Status.T3.Text = "Orders ...  "
  351.         USE ORDERS EXCL
  352.         REINDEX
  353.         Status.Gauge.WIDTH = 30
  354.         Status.T3.Text = "Acct Rec ..."
  355.         USE ACCT_REC EXCL
  356.         REINDEX
  357.         Status.Gauge.WIDTH = 35
  358.         Status.T3.Text = "Area Codes..."
  359.         USE CODES EXCL
  360.         REINDEX
  361.         USE
  362.         CLEA
  363.         lVoid = Status.Release()
  364.     ENDIF
  365. RETURN
  366. ****************************
  367. PROCEDURE PackTabl                         && Packing Tables
  368.     CLOSE ALL
  369.     DO Gauge
  370.     * Check to see if there are any tables open
  371.     IF LEN(DBF()) > 0
  372.         DO ErrorMsg WITH "You must exit all Forms to run this procedure .."
  373.     ELSE
  374.         Status.Gauge.WIDTH = 5
  375.         Status.T3.Text = "Employee ..."
  376.         USE Employee EXCL
  377.         PACK
  378.         Status.Gauge.WIDTH = 10
  379.         Status.T3.Text = "Vendors ... "
  380.         USE Vendors EXCL
  381.         PACK
  382.         Status.Gauge.WIDTH = 15
  383.         Status.T3.Text = "Goods ...   "
  384.         USE GOODS EXCL
  385.         PACK
  386.         Status.Gauge.WIDTH = 20
  387.         Status.T3.Text = "Customer ..."
  388.         USE CUST EXCL
  389.         PACK
  390.         Status.Gauge.WIDTH = 25
  391.         Status.T3.Text = "Orders ...  "
  392.         USE ORDERS EXCL
  393.         PACK
  394.         Status.Gauge.WIDTH = 30
  395.         Status.T3.Text = "Acct Rec ..."
  396.         USE ACCT_REC EXCL
  397.         PACK
  398.         USE
  399.         Status.Gauge.Width = 35
  400.         Status.T3.Text = "Area Code ..."
  401.         USE CODES EXCL
  402.         PACK
  403.         USE
  404.         CLEA
  405.         lVoid = Status.Release()
  406.     ENDIF
  407.     RETURN
  408. ****************************
  409. PROCEDURE Gauge
  410.     DEFINE FORM Status FROM 5,25 TO 10,65 ;
  411.         PROPERTY ;
  412.             Text "Status" ,;
  413.             COLORNORMAL "W/B"
  414.  
  415.     DEFINE TEXT t1 OF Status AT 0,1 ;
  416.         PROPERTY ;
  417.             TEXT "0%",;
  418.             COLORNORMAL "B/W"
  419.  
  420.     DEFINE TEXT t2 OF Status AT 0,34 ;
  421.         PROPERTY ;
  422.             Text "100%",;
  423.             COLORNORMAL "B/W"
  424.  
  425.     DEFINE TEXT t3 OF Status AT 3,1 ;
  426.         PROPERTY ;
  427.             Text "",;
  428.             COLORNORMAL "B/W"
  429.  
  430.     DEFINE RECTANGLE Gauge OF Status AT 4,1  ;
  431.         PROPERTY ;
  432.             TOP 1,;
  433.             LEFT 1,;
  434.             HEIGHT 2,;
  435.             Width 1,;
  436.             COLORNORMAL "R/W"
  437.  
  438.     lVoid = Status.Open()
  439.     RETURN
  440. ****************************
  441. PROCEDURE GOTOP                      && Going to top record in table
  442.     * Need to see if a form is on the desktop
  443.     * Use the _Clipboard reference (its always alive)
  444.     CurrObj = _ClipBoard.Parent.ActiveControl()
  445.     * Check to see if there is a form on the desktop
  446.     IF TYPE("CurrObj") = "L"
  447.         DO ErrorMsg WITH "A Form must be Open to Go Top ..."
  448.     ELSE
  449.        IF CurrObj.ClassName = "FORM"
  450.           lVoid = CurrObj.Submit()        && Check if Form before Submit()
  451.        ENDIF
  452.        GO TOP
  453.        IF CurrObj.ClassName = "FORM"       && Check if Form before Refresh()
  454.           lVoid = CurrObj.Refresh()
  455.        ENDIF
  456. *      IF CurrObj.ClassName = "BROWSE"     && If Browse, RefreshRecord()
  457. *         lVoid = CurrObj.RefreshRecord()
  458. *      ENDIF
  459.     ENDIF
  460.     RETURN
  461. ****************************
  462. PROCEDURE GOBOTT                  && Going to Bottom Record in table
  463.     * Need to see if a form is on the desktop
  464.     * Use the _Clipboard reference (its always alive)
  465.     CurrObj = _ClipBoard.Parent.ActiveControl()
  466.     * Check to see if there is a Form on the desktop
  467.     IF TYPE("CurrObj") = "L"
  468.         DO ErrorMsg WITH "A Form must be Open to Go Bottom ..."
  469.     ELSE
  470.     IF CurrObj.ClassName = "FORM"       && Check if Form before Submit()
  471.         lVoid = CurrObj.Submit()
  472.     ENDIF
  473.     GO BOTTOM
  474.     IF CurrObj.ClassName = "FORM"       && Check if Form before Refresh()
  475.         lVoid = CurrObj.Refresh()
  476.     ENDIF
  477.     IF CurrObj.ClassName = "BROWSE"     && If Browse, RefreshRecord()
  478.         lVoid = CurrObj.RefreshRecord()
  479.     ENDIF
  480.     ENDIF
  481.     RETURN
  482. ****************************
  483. PROCEDURE SubmitIt             && Writing Record info to dis
  484.     * Need to see if a form is on the desktop
  485.     * Use the _Clipboard reference (its always alive)
  486.     CurrObj = _ClipBoard.Parent.ActiveControl()
  487.     * check to see if a form is active
  488.  
  489.     IF TYPE("CurrObj.ClassName") = "C"
  490.         IF CurrObj.ClassName = "FORM"
  491.             lVoid = CurrObj.Submit()
  492.         ELSE
  493.             DO ErrorMsg WITH "A Form must be Open to Save ..."
  494.         ENDIF
  495.     ELSE
  496.         DO ErrorMsg WITH "A Form must be Open to Save ..."
  497.     ENDIF
  498.  
  499. *    If TYPE("CurrObj") = "L"    && Implies no form on desktop
  500. *        DO ErrorMsg WITH "A Form must be Open to Save ..."
  501. *    ELSE
  502. *        lVoid = CurrObj.Submit()
  503. *    ENDIF
  504.  
  505.     RETURN
  506. ***************************
  507. PROCEDURE UndoIt
  508.     * Need to see if a form is on the desktop
  509.     * Use the _Clipboard reference (its always alive)
  510.     CurrObj = _ClipBoard.Parent.ActiveControl()
  511.     * check to see if a form is active, if no form on the desktop
  512.     * the type of Currobj is logical .F.
  513.     IF TYPE("CurrObj") = "L"
  514.         DO ErrorMsg WITH "A Form must be Open to Undo ..."
  515.     ELSE
  516.         lVoid = CurrObj.Refresh()
  517.     ENDIF
  518.     RETURN
  519. ***************************
  520. PROCEDURE AddBrowse
  521.     IF LEN(DBF()) > 0
  522.        DEFINE BROWSE brwse ;
  523.             PROPERTY ;
  524.                 APPEND   .F.,;
  525.                 MOVEABLE .T.,;
  526.                 SIZEABLE .T.,;
  527.                 OnClose MnuEnable
  528.        lVoid = brwse.Open()
  529.        Main.V.Brws.Enabled=.F.
  530.     ELSE
  531.         DO ErrorMsg WITH "Need to have an active form or table first..."
  532.     ENDIF
  533. ****************************
  534. PROCEDURE AddForm
  535.     IF LEN(DBF()) > 0
  536.         STORE SUBSTR(DBF(),3) TO Fname
  537.         DO CASE
  538.             CASE SUBSTR(DBF(),3)="EMPLOYEE.DBF"
  539.                 DO EMPLOYEE
  540.             CASE SUBSTR(DBF(),3)="VENDORS.DBF"
  541.                 DO VENDORS
  542.             CASE SUBSTR(DBF(),3)="GOODS.DBF"
  543.                 DO GOODS
  544.             CASE SUBSTR(DBF(),3)="CUST.DBF"
  545.                 DO CUST
  546.             CASE SUBSTR(DBF(),3)="ACCT_REC.DBF"
  547.                 DO ACCT_REC
  548.             CASE SUBSTR(DBF(),3)="CODES.DBF"
  549.                 DO AREACODE
  550.             OTHERWISE
  551.                 DO ErrorMsg WITH "There is no FORM for "+Fname
  552.         ENDCASE
  553.     ENDIF
  554.     RETURN
  555. ****************************
  556. PROCEDURE Srchr
  557.     IF LEN(DBF()) = 0
  558.         DO ErrorMsg WITH "A table must be open to SEARCH"
  559.         RETURN
  560.     ENDIF
  561.     STORE SUBSTR(DBF(),3) TO Fname1
  562.     DO CASE
  563.         CASE SUBSTR(DBF(),3)="EMPLOYEE.DBF"
  564.             Procr="EMPLOYEE"
  565.             Funcr="FINDLAST()"
  566.         CASE SUBSTR(DBF(),3)="GOODS.DBF"
  567.             Procr="GOODS"
  568.             Funcr="FINDPART()"
  569.         CASE SUBSTR(DBF(),3)="CUST.DBF"
  570.             Procr="CUST"
  571.             Funcr="FINDID()"
  572.         CASE SUBSTR(DBF(),3)="ACCT_REC.DBF"
  573.             Procr="ACCT_REC"
  574.             Funcr="FINDPART()"
  575.         CASE SUBSTR(DBF(),3)="CODES.DBF"
  576.             Procr="AREACODE"
  577.             Funcr="FINDCODE()"
  578.         OTHERWISE
  579.             DO ErrorMsg WITH "There is no SEARCH for "+Fname1
  580.         RETURN
  581.     ENDCASE
  582.     SET PROCEDURE TO &Procr
  583.     ? &Funcr
  584. ******************************
  585. PROCEDURE LEAVE
  586.     CLOSE ALL
  587.     RELEASE ALL
  588.     QUIT
  589.     RETURN
  590. ******************************
  591. PROCEDURE Cl_Bus
  592.     PRIVATE oRef, oRefP, lVoid
  593.     * close any open forms
  594.     _CmdWindow.Visible = .T.
  595.     oRef  = _CmdWindow.Before
  596.     oRefP = _CmdWindow
  597.     DO WHILE oRef # _CmdWindow
  598.         IF oRef.ClassName = "FORM"
  599.             lVoid = oRef.Close()
  600.             IF TYPE("oRef.ClassName") = "C"
  601.                 lVoid = oRef.Release()
  602.             ENDIF
  603.             oRef = oRefP.Before
  604.         ELSE
  605.             oRefP = oRef
  606.             oRef  = oRefP.Before
  607.         ENDIF
  608.     ENDDO
  609.     IF TYPE("Main.ClassName") = "C"
  610.         lVoid = Main.Close()
  611.         lVoid = Main.Release()
  612.     ENDIF
  613.  
  614.     CLEAR ALL
  615.  
  616.     SET STATUS ON
  617.     RETURN
  618. ******************************
  619. PROCEDURE NotReady
  620.     DO Errormsg WITH "Feature is not ready yet ..."
  621.     RETURN
  622. *******************************
  623. PROCEDURE About
  624.     Lvoid=Abt_box.readmodal()
  625.     RETURN
  626. *******************************
  627. PROCEDURE CloseAbt
  628.     Lvoid=Abt_box.CLOSE()
  629.     RETURN
  630. *******************************
  631. PROCEDURE CloseAll
  632.     PRIVATE oRef, oRefP, lVoid
  633.     * close any open forms
  634.     oRef  = _CmdWindow.Before
  635.     oRefP = _CmdWindow
  636.     DO WHILE oRef # _CmdWindow
  637.         IF oRef.ClassName = "FORM"
  638.             lVoid = oRef.Close()
  639.             IF TYPE("oRef.ClassName") = "C"
  640.                 lVoid = oRef.Release()
  641.             ENDIF
  642.             oRef = oRefP.Before
  643.         ELSE
  644.             oRefP = oRef
  645.             oRef  = oRefP.Before
  646.         ENDIF
  647.     ENDDO
  648.  
  649.     CLOSE ALL
  650.     RETURN
  651. *******************************
  652. PROCEDURE OpenFile
  653.     DEFINE FORM OpenFile;
  654.         PROPERTY;
  655.             AUTOSIZE    .F.,;
  656.             HEIGHT      15,;
  657.             LEFT        8,;
  658.             MDI         .T.,;
  659.             MOVEABLE    .T.,;
  660.             SIZEABLE    .F.,;
  661.             SYSMENU     .T.,;
  662.             TEXT        "Open File",;
  663.             TOP         1,;
  664.             WIDTH       45
  665.  
  666.     DEFINE TEXT T1 OF OpenFile AT 2,2 ;
  667.         PROPERTY ;
  668.             TEXT "Table List :", ;
  669.             COLORNORMAL "R/W"
  670.  
  671.     DEFINE LISTBOX DbfList OF OpenFile;
  672.         PROPERTY;
  673.             HEIGHT      7,;
  674.             LEFT        2,;
  675.             TOP         4,;
  676.             DataSource  "FILEMASK *.dbf",;
  677.             WIDTH       20
  678.  
  679.     DEFINE CHECKBOX Excl OF OpenFile AT 10,25 ;
  680.         PROPERTY ;
  681.             Text "&Exclusive"  ,;
  682.             COLORNORMAL "N/W" ,;
  683.             WIDTH 15
  684.  
  685.     DEFINE PUSHBUTTON pbName11 OF OpenFile;
  686.         PROPERTY;
  687.             HEIGHT 2,;
  688.             LEFT 25,;
  689.             TEXT [&Ok],;
  690.             TOP 4,;
  691.             WIDTH 10, ;
  692.             OnClick     OpenIt, ;
  693.             Default     .T.
  694.  
  695.     DEFINE PUSHBUTTON pbName12 OF OpenFile;
  696.         PROPERTY;
  697.             HEIGHT      2,;
  698.             LEFT        25,;
  699.             TEXT        [Cancel],;
  700.             TOP         7,;
  701.             WIDTH       10, ;
  702.             OnClick     CanHand
  703.  
  704.     OpenFile.pbName12.PROCFILE = "CanHand.prg"
  705.  
  706.     lVoid = OpenFile.Open()
  707. ******************************
  708. PROCEDURE OpenIt
  709.  
  710.     FileName = OpenFile.DbfList.Value
  711.     IF OpenFile.Excl.Value
  712.         IF FileName="CODES.DBF"
  713.             USE CODES ORDER CITY ALIAS AreaCode EXCL
  714.         ELSE
  715.            USE &FileName EXCL
  716.         ENDIF
  717.     ELSE
  718.         IF Filename="CODES.DBF"
  719.             USE CODES ORDER CITY ALIAS AreaCode AGAIN
  720.          ELSE
  721.             USE &FileName
  722.         ENDIF
  723.     ENDIF
  724.     lVoid = OpenFile.Release()
  725.  
  726.     DO AddBrowse
  727.     Main.S.Srch.Enabled=.T.
  728.     Main.S.Tp.Enabled=.T.
  729.     Main.S.Btm.Enabled=.T.
  730.     Main.E.Undo.Enabled=.F.
  731.     Main.E.Save.Enabled=.F.
  732.  
  733. RETURN
  734. *******************************
  735. PROCEDURE MnuEnable
  736.     IF TYPE("Main.ClassName") = "C"
  737.         Main.S.Srch.Enabled=.F.
  738.         Main.S.Tp.Enabled=.F.
  739.         Main.S.Btm.Enabled=.F.
  740.         Main.E.Undo.Enabled=.F.
  741.         Main.E.Save.Enabled=.F.
  742.     ENDIF
  743. *   USE IN Brwse.Alias
  744.     lVoid=Brwse.Release()
  745. RETURN
  746. *******************************
  747. PROCEDURE CheckOpen
  748.     IF ChkOpen()
  749.         Main.S.pck.Enabled  = .F.
  750.         Main.S.Indx.Enabled = .F.
  751.     ELSE
  752.         Main.S.pck.Enabled  = .T.
  753.         Main.S.Indx.Enabled = .T.
  754.     ENDIF
  755.  
  756.     IF ISBLANK(ORDER())
  757.         Main.S.Srch.Enabled = .F.
  758.     ELSE
  759.         Main.S.Srch.Enabled = .T.
  760.     ENDIF
  761. RETURN
  762. *******************************
  763. FUNCTION ChkOpen
  764.     PRIVATE nWA, lRet, nOld
  765.  
  766.     SET TALK OFF
  767.  
  768.     IF .NOT. ISBLANK(ALIAS())
  769.         nOld = SELECT(ALIAS())
  770.     ELSE
  771.         nOld = SELECT()
  772.     ENDIF
  773.  
  774.     lRet = .F.
  775.  
  776.     FOR nWA = 1 TO 40
  777.         SELECT (nWA)
  778.         IF .NOT. ISBLANK(DBF())
  779.             lRet = .T.
  780.             EXIT
  781.         ENDIF
  782.     ENDFOR
  783.  
  784.     SELECT (nOld)
  785. RETURN lRet
  786. ********************************
  787. PROCEDURE ChkObj
  788.     PRIVATE oRef
  789.  
  790.     oRef = _CmdWindow.oDesk.ActiveControl()
  791.  
  792.     IF TYPE("oRef.ClassName") = "C"
  793.         IF oRef.Name # "_CMDWINDOW"
  794.             IF oRef.ClassName = "FORM"
  795.                 Main.V.Brws.Enabled = .T.
  796.                 Main.V.Frm.Enabled  = .F.
  797.             ENDIF
  798.             IF oRef.ClassName = "BROWSE"
  799.                 Main.V.Brws.Enabled = .F.
  800.                 Main.V.Frm.Enabled  = .T.
  801.             ENDIF
  802.         ELSE
  803.             IF .NOT. ISBLANK(ALIAS())
  804.                 Main.V.Brws.Enabled = .T.
  805.                 Main.V.Frm.Enabled  = .T.
  806.             ELSE
  807.                 Main.V.Brws.Enabled = .F.
  808.                 Main.V.Frm.Enabled  = .F.
  809.             ENDIF
  810.         ENDIF
  811.     ELSE
  812.         IF .NOT. ISBLANK(ALIAS())
  813.             Main.V.Brws.Enabled = .T.
  814.             Main.V.Frm.Enabled  = .T.
  815.         ELSE
  816.             Main.V.Brws.Enabled = .F.
  817.             Main.V.Frm.Enabled  = .F.
  818.         ENDIF
  819.     ENDIF
  820. RETURN
  821.  
  822.  
  823.  
  824. *** END BUSINESS.PRG *******************************************************
  825.  
  826.