home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / TOOLS / XSOURCE / XSOURCE.ZIP / vfpsource / Builders / wbmain.prg < prev    next >
Encoding:
Text File  |  1998-05-01  |  43.1 KB  |  1,363 lines
  1. * Program:        WBMAIN.PRG
  2. * Description:    Wizard-Builder parent class, used by wizard and builder programs.
  3. *                _BUILDER and _WIZARD programs will SET PROC (later, SET CLASSLIB)
  4. *                to this file and then create builder/wizard object AS WizBldr,
  5. *                inheriting common methods and properties and overriding them as
  6. *                appropriate.
  7. * -----------------------------------------------------------------------------------------
  8.  
  9. #INCLUDE "WB.H"
  10.  
  11. DEFINE CLASS WizBldr AS CUSTOM
  12.     wbcAppDir        = ""                            && .app's path
  13.     wbcVersion        = ""
  14.     wbcClass        = ""                            && class of underlying control
  15.     wbcBaseClass    = ""                            && base class of underlying control
  16.     wbcNamedClass    = ""                            && named class, passed in as parameter to builder.app
  17.     wbcRegTable        = ""                            && holds name of registration table
  18.     wbcRegTblLoc    = ""
  19.     wbcLibrary        = ""                            && name of class library for specific wizard/builder
  20.     wbcToolLibrary    = ""                            && fully qualified name of tool library
  21.     wbcType            = ""                            && object type - wizard or builder
  22.     wbcTypeDisplay    = ""                            && object type, localizable - wizard or builder
  23.     wbcName            = ""                            && name of wizard/builder from reg table
  24.     wbcBldrClass    = ""                            && name of class from reg table
  25.     wbcDefTable        = ""                            && default reg table name
  26.     wbcDefFPT        = ""                        
  27.     wbcDefLib        = ""                            && default library
  28.     wbcDefDir        = ""                            && default reg table directory
  29.     wbcLocMsg        = ""                            && specific alert message strings
  30.     wbcNoWB            = ""
  31.     wbcBadTable        = ""
  32.     wbcNoName        = ""
  33.     wbcNoClassLib    = ""
  34.     wbcNoReg        = ""
  35.     wbcNoDesc        = ""
  36.     wbcStatMsg        = ""
  37.     wbcAlertTitle    = ""
  38.     wboName            = ""                            && created object name
  39.     wbcTemplateTbl    = ""                            && name of table to build new reg table from
  40.     wbReturnValue    = ""                            && passed by reference to wizards, so they can return a value
  41.     wbParm            = ""                            && parameter string
  42.     wbOptParms        = 0                                && number of optional parameters received
  43.     wblModal        = .t.                            && flag for modality of wizards/builders. See Builder.prg.
  44.     
  45.     wblObject        = .f.                            && wizard/builder is an object, not a program
  46.     wblNoScrn        = .f.                            && flags for wbcpOptions parameter
  47.     wblModify        = .f.
  48.     
  49.     DIMENSION wbaEnvir[29]                            && holds environment settings
  50.     DIMENSION wbaAreas[1]                            && holds work areas we've opened
  51.     DIMENSION wbaAllData[1,8]                        && all selected data from reg table
  52.     DIMENSION wbaData[1,8]                            && data about specific wizard/builder
  53.     DIMENSION wbaSearchOrder[7]                        && specifies search sequence for locating files
  54.  
  55.     wbaEnvir    = ""
  56.     wbaAreas    = ""
  57.     wbaAllData    = ""
  58.     wbaData        = ""
  59.     wbaSearchOrder[1] = "WIZARDS"                    && "wizards" subdir under wizard.app
  60.     wbaSearchOrder[2] = "REGLOC"                    && wherever the reg table is
  61.     wbaSearchOrder[3] = "CURRENT"                    && current directory
  62.     wbaSearchOrder[4] = "APPDIR"                    && wizard.app's directory
  63.     wbaSearchOrder[5] = "ROOTWIZARDS"                && "wizards" subdir under SYS(2004)
  64.     wbaSearchOrder[6] = "STARTUP"                    && SYS(2004)
  65.     wbaSearchOrder[7] = "FULLPATH"                    && uses FILE()
  66.     
  67.     
  68.     PROCEDURE WBSaveEnvironment
  69.     * ----------------------------------------------------------------------------
  70.     * Save some environment settings coming in. 
  71.     * ----------------------------------------------------------------------------
  72.         WITH THIS
  73.             .wbaEnvir[1] = SET("TALK")
  74.                 SET TALK OFF
  75.             .wbaEnvir[2] = SET("STEP")
  76.                 SET STEP OFF
  77.             .wbaEnvir[3] = SET("COMPATIBLE")
  78.                 SET COMPATIBLE OFF NOPROMPT
  79.             .wbaEnvir[4] = SET("PROCEDURE")
  80.             .wbaEnvir[5] = SELECT()
  81.             .wbaEnvir[6] = SET("LIBRARY", 1)
  82.             .wbaEnvir[7] = SET("MESSAGE", 1)
  83.             .wbaEnvir[8] = SET("SAFETY")
  84.                 SET SAFETY OFF
  85.             .wbaEnvir[9] = SET("PATH")
  86.             .wbaEnvir[10] = SET("TRBETWEEN")
  87.                 SET TRBETWEEN OFF
  88.             .wbaEnvir[11] = SET("DEVELOPMENT")
  89.                 SET DEVELOPMENT OFF
  90.             .wbaEnvir[12] = SET("FIELDS")
  91.                 SET FIELDS OFF
  92.             .wbaEnvir[13] = SET("FIELDS", 2)
  93.                 SET FIELDS LOCAL
  94.             .wbaEnvir[14] = ON("ERROR")
  95.             .wbaEnvir[15] = SET("HELP")
  96.             .wbaEnvir[16] = SET("HELP",1)
  97.             .wbaEnvir[17] = SET("CLASSLIB")
  98.                 SET CLASSLIB TO
  99.             .wbaEnvir[18] = SET("ESCAPE")
  100.                 SET ESCAPE OFF
  101.             .wbaEnvir[19] = SET("EXACT")
  102.                 SET EXACT ON
  103.             .wbaEnvir[20] = SET("ECHO")
  104.                 SET ECHO OFF
  105.             .wbaEnvir[21] = SET("MEMOWIDTH")
  106.             .wbaEnvir[22] = SET("UDFPARMS")
  107.                 SET UDFPARMS TO VALUE
  108.             .wbaEnvir[23] = SET("NEAR")
  109.                 SET NEAR OFF
  110.             .wbaEnvir[24] = SET("UNIQUE")
  111.                 SET UNIQUE OFF
  112.             .wbaEnvir[25] = SET("ANSI")
  113.                 SET ANSI OFF
  114.             .wbaEnvir[26] = SET("CARRY")
  115.                 SET CARRY OFF
  116.             .wbaEnvir[27] = SET("CPDIALOG")
  117.                 SET CPDIALOG OFF        
  118.             .wbaEnvir[28] = SET("STATUS BAR")
  119.             .wbaEnvir[29] = SELECT()
  120.         ENDWITH
  121.         PUSH KEY CLEAR
  122.         
  123.         SET SKIP OF BAR _mwi_hide OF _mwindow .t.
  124.         SET SKIP OF BAR _mwi_arran OF _mwindow .t.
  125.         SET SKIP OF BAR _mwi_rotat OF _mwindow .t.
  126.     
  127.     ENDPROC
  128.     
  129.     PROCEDURE WBSetEnvironment
  130.     * ----------------------------------------------------------------------------
  131.     * Reset saved environment settings before leaving. 
  132.     * ----------------------------------------------------------------------------
  133.  
  134.         PRIVATE m.wbiLength, m.wbi, m.wbtemp
  135.  
  136.         WITH THIS
  137.             IF NOT EMPTY(.wbaAreas[1])                && close any files opened
  138.                 m.wbiLength = ALEN(THIS.wbaAreas, 1)
  139.                 FOR m.wbi=1 TO m.wbiLength
  140.                     IF USED(.wbaAreas[m.wbi])
  141.                         USE IN (.wbaAreas[m.wbi])
  142.                     ENDIF
  143.                 ENDFOR
  144.             ENDIF
  145.  
  146.             IF .wbaEnvir[1] = "ON"
  147.                 SET TALK ON
  148.             ENDIF
  149.             
  150.             IF .wbaEnvir[3] = "ON"
  151.                 SET COMPATIBLE ON
  152.             ENDIF
  153.             
  154.             SET PROCEDURE TO
  155.             
  156.             IF NOT EMPTY(.wbaEnvir[4])
  157.                 m.wbatemp = .wbaEnvir[4]
  158.                 SET PROCEDURE TO &wbatemp
  159.             ENDIF
  160.             
  161.             IF NOT EMPTY(.wbaEnvir[7])
  162.                 SET MESSAGE TO .wbaEnvir[7]
  163.             ELSE
  164.                 SET MESSAGE TO
  165.             ENDIF
  166.             
  167.             IF .wbaEnvir[8] = "ON"
  168.                 SET SAFETY ON
  169.             ENDIF
  170.             
  171.             IF NOT EMPTY(.wbaEnvir[9])
  172.                 SET PATH TO (.wbaEnvir[9])
  173.             ENDIF
  174.             
  175.             IF .wbaEnvir[10] = "ON"
  176.                 SET TRBETWEEN ON
  177.             ENDIF
  178.             
  179.             IF .wbaEnvir[11] = "ON"
  180.                 SET DEVELOPMENT ON
  181.             ENDIF
  182.             
  183.             IF .wbaEnvir[12] = "ON"
  184.                 SET FIELDS ON
  185.             ENDIF
  186.             
  187.             IF .wbaEnvir[13] = "GLOBAL"
  188.                 SET FIELDS GLOBAL
  189.             ENDIF
  190.  
  191.             IF NOT EMPTY(.wbaEnvir[14])
  192.                 m.wbtemp = .wbaEnvir[14]
  193.                 ON ERROR &wbtemp
  194.             ELSE
  195.                 ON ERROR
  196.             ENDIF
  197.             
  198.             IF NOT EMPTY(.wbaEnvir[15]) AND SET("HELP") <> .wbaEnvir[15]
  199.                 m.wbtemp = .wbaEnvir[15]
  200.                 set help &wbtemp
  201.             ENDIF
  202.             
  203.             IF NOT EMPTY(.wbaEnvir[16]) AND SET("HELP",1) <> .wbaEnvir[16]
  204.                 m.wbtemp = .wbaEnvir[16]
  205.                 set help to (m.wbtemp)
  206.             ENDIF
  207.  
  208.             IF NOT EMPTY(.wbaEnvir[17])
  209.                 m.templib = .wbaEnvir[17]
  210.                 SET CLASSLIB TO &templib
  211.             ELSE
  212.                 SET CLASSLIB TO
  213.             ENDIF
  214.  
  215.             IF .wbaEnvir[18] = "ON"
  216.                 SET ESCAPE ON
  217.             ENDIF
  218.  
  219.             IF SET("EXACT") <> .wbaEnvir[19]
  220.                 m.wbtemp = .wbaEnvir[19]
  221.                 SET EXACT &wbtemp
  222.             ENDIF
  223.  
  224.             IF SET("MEMOWIDTH") <> .wbaEnvir[21]
  225.                 SET MEMOWIDTH TO (.wbaEnvir[21])
  226.             ENDIF
  227.             
  228.             IF SET("UDFPARMS") <> .wbaEnvir[22]
  229.                 m.wbtemp = .wbaEnvir[22]
  230.                 SET UDFPARMS TO &wbtemp
  231.             ENDIF
  232.             
  233.             IF SET("NEAR") <> .wbaEnvir[23]
  234.                 m.wbtemp = .wbaEnvir[23]
  235.                 SET NEAR &wbtemp
  236.             ENDIF
  237.             
  238.             IF SET("UNIQUE") <> .wbaEnvir[24]
  239.                 m.wbtemp = .wbaEnvir[24]
  240.                 SET UNIQUE &wbtemp
  241.             ENDIF
  242.             
  243.             IF SET("ANSI") <> .wbaEnvir[25]
  244.                 m.wbtemp = .wbaEnvir[25]
  245.                 SET ANSI &wbtemp
  246.             ENDIF
  247.             
  248.             IF SET("CARRY") <> .wbaEnvir[26]
  249.                 m.wbtemp = .wbaEnvir[26]
  250.                 SET CARRY &wbtemp
  251.             ENDIF
  252.             
  253.             IF SET("CPDIALOG") <> .wbaEnvir[27]
  254.                 m.wbtemp = .wbaEnvir[27]
  255.                 SET CPDIALOG &wbtemp
  256.             ENDIF
  257.             
  258.             IF SET("STATUS BAR") <> .wbaEnvir[28]
  259.                 m.wbtemp = .wbaEnvir[28]
  260.                 SET STATUS BAR &wbtemp
  261.             ENDIF
  262.             SELECT (.wbaEnvir[29])    &&RED00KDY  Added this
  263.         ENDWITH
  264.     
  265.         POP KEY
  266.         SET SKIP OF BAR _mwi_hide OF _mwindow .f.
  267.         SET SKIP OF BAR _mwi_arran OF _mwindow .f.
  268.         SET SKIP OF BAR _mwi_rotat OF _mwindow .f.
  269.         set skip of bar _mpr_suspend of _mprog .F.
  270.         set skip of popup _mtools .F.
  271.  
  272.     ENDPROC
  273.     
  274.     PROCEDURE WBCheckparms
  275.     * ----------------------------------------------------------------------------
  276.     * Parameter checking
  277.     * ----------------------------------------------------------------------------
  278.  
  279.         IF THIS.wbcType = "WIZARD"
  280.             m.wbcpClass = IIF(type("m.wbcpClass") <> "C", "", m.wbcpClass)
  281.             m.wbcpName  = IIF(type("m.wbcpName") <> "C", "", m.wbcpName)
  282.             m.wbcpOptions  = IIF(type("m.wbcpOptions") <> "C", "", m.wbcpOptions)
  283.  
  284.             THIS.wblNoScrn = C_NOSCRN $ m.wbcpOptions
  285.             THIS.wblModify = C_MODIFY $ m.wbcpOptions
  286.             THIS.wbcClass  = m.wbcpClass
  287.         ELSE
  288.             wbaControl[1] = IIF(type("wbaControl[1]") <> "O", "", wbaControl[1])
  289.             m.wbcpOrigin  = IIF(type("m.wbcpOrigin") <> "C", "", m.wbcpOrigin)
  290.             m.wbcpOptions  = IIF(type("m.wbcpOptions") <> "C", "", m.wbcpOptions)
  291.             m.wbcpName  = IIF(type("m.wbcpName") <> "C", "", m.wbcpName)
  292.         ENDIF
  293.  
  294.     ENDPROC
  295.     
  296.     PROCEDURE WBCheckErrors
  297.     * ----------------------------------------------------------------------------
  298.     * Basic entry-level error checking
  299.     * ----------------------------------------------------------------------------
  300.  
  301.         DO CASE
  302.             CASE VAL(SUBSTR(VERSION(),ATC("FOXPRO",VERSION())+7)) < N_MINFOXVERSION
  303.                 THIS.WBAlert(IIF(THIS.wbcType = "WIZARD", C_BADWIZVERSION_LOC, C_BADBDRVERSION_LOC))
  304.                 m.wblError = .t.
  305.             CASE _UNIX or _MAC or _DOS                             && other platforms
  306.                 THIS.WBAlert(IIF(THIS.wbcType = "WIZARD", C_BADWIZPLATFORM_LOC, C_BADBDRPLATFORM_LOC))
  307.                 m.wblError = .t.
  308.             CASE VERSION(2) = 0                                    && use of runtime library
  309.                 * THIS.WBAlert(IIF(THIS.wbcType = "WIZARD", C_RUNTIMEWIZ_LOC, C_RUNTIMEBDR_LOC))
  310.                 * m.wblError = .t.
  311.         ENDCASE
  312.  
  313.         IF m.wblError
  314.             THIS.WBSetEnvironment
  315.             RETURN
  316.         ENDIF
  317.     ENDPROC
  318.     
  319.     PROCEDURE WBSetTools
  320.     * ----------------------------------------------------------------------------
  321.     * Set library here
  322.     * ----------------------------------------------------------------------------
  323.  
  324.     *    set library to (THIS.wbcToolLibrary)
  325.  
  326.     ENDPROC
  327.     
  328.     PROCEDURE WBSetPlatform
  329.     * ----------------------------------------------------------------------------
  330.     * Platform-specific code
  331.     * ----------------------------------------------------------------------------
  332.  
  333.     ENDPROC
  334.  
  335.     PROCEDURE WBSetProps
  336.     * ----------------------------------------------------------------------------
  337.     * Set properties here based on whether this is a wizard or a builder.
  338.     * ----------------------------------------------------------------------------
  339.     
  340.         WITH THIS
  341.             .wbcVersion        = IIF(.wbcType = "WIZARD", m.wbcWizVer, m.wbcBldVer)
  342.             .wbcDefTable    = IIF(.wbcType = "WIZARD", C_REGDBFWIZ, C_REGDBFBDR)
  343.             .wbcDefFPT        = IIF(.wbcType = "WIZARD", C_REGFPTWIZ, C_REGFPTBDR)
  344.             .wbcDefDir      = IIF(.wbcType = "WIZARD", C_DIRWIZ, C_DIRBDR)
  345.             .wbcDefLib      = IIF(.wbcType = "WIZARD", C_LIBWIZ, C_LIBBDR)
  346.             .wbcLocMsg        = IIF(.wbcType = "WIZARD", C_FINDWIZREG_LOC, C_FINDBDRREG_LOC)
  347.             .wbcNoWB           = IIF(.wbcType = "WIZARD", C_NOWIZARDS_LOC, C_NOBUILDERS_LOC)
  348.             .wbcBadTable      = C_BADREGTABLE_LOC
  349.             .wbcNoName       = IIF(.wbcType = "WIZARD", C_NOWIZNAME_LOC, C_NOBDRNAME_LOC)
  350.             .wbcNoClassLib    = IIF(.wbcType = "WIZARD", C_NOWIZLIB_LOC, C_NOBDRLIB_LOC)
  351.             .wbcNoReg        = IIF(.wbcType = "WIZARD", C_NOWIZREG_LOC, C_NOBDRREG_LOC)
  352.             .wbcNoDesc       = IIF(.wbcType = "WIZARD", C_NOWIZDESC_LOC, C_NOBDRDESC_LOC)
  353.             .wbcStatMsg       = IIF(.wbcType = "WIZARD", C_STATMSGWIZ_LOC, C_STATMSGBDR_LOC)
  354.             .wbcTemplateTbl    = IIF(.wbcType = "WIZARD", C_TPLDBFWIZ, C_TPLDBFBDR)
  355.             .wbcAlertTitle     = IIF(.wbcType = "WIZARD", MB_MSGBOXWIZTITLE_LOC, MB_MSGBOXBDRTITLE_LOC)
  356.         ENDWITH
  357.     
  358.         SET MESSAGE TO THIS.wbcStatMsg
  359.  
  360.         this.wbcAppDir=""
  361.         IF ATC("BUILDER.FXP",SYS(16,1))>0
  362.             this.wbcDefDir="BUILDERS\"
  363.             RETURN
  364.         ENDIF
  365.         FOR m.wbi = 1 TO 10000
  366.             m.wbtestdir = SYS(16,m.wbi)
  367.             IF NOT EMPTY(m.wbtestdir)
  368.                 THIS.wbcAppDir = m.wbtestdir
  369.                 m.appslash = RAT("\",THIS.wbcAppDir)
  370.                 m.wbappname = IIF(m.appslash>0, SUBSTR(THIS.wbcAppDir,m.appslash+1), "")
  371.                 m.wbapptest = UPPER(THIS.wbcType + ".APP")        && do not localize
  372.                 IF m.wbapptest $ UPPER(m.wbappname)
  373.                     EXIT
  374.                 ENDIF
  375.             ELSE
  376.                 EXIT
  377.             ENDIF
  378.         ENDFOR        
  379.         
  380.         THIS.wbcAppDir = LEFT(THIS.wbcAppDir, RAT("\",THIS.wbcAppDir))
  381.         IF LEFT(this.wbcAppDir,10)=="PROCEDURE "
  382.             this.wbcAppDir=ALLTRIM(SUBSTR(this.wbcAppDir,RAT(" ",this.wbcAppDir)+1))
  383.         ENDIF
  384.  
  385.     ENDPROC
  386.  
  387.     
  388.     PROCEDURE WBGetRegTable
  389.     * ----------------------------------------------------------------------------
  390.     * Locate the registration table, verify its integrity, build a new one if
  391.     * necessary. Populate array wbaAllData[] with info about the wizards/builders
  392.     * of interest, update registration table preference in FoxUser.dbf. Return
  393.     * name of registration table.
  394.     * ----------------------------------------------------------------------------
  395.  
  396.         PRIVATE m.wbcTable, m.wbcOnError, m.wblError, m.wbiSelect, m.wbi, m.wbi2, m.wbiLength, ;
  397.                 m.defTable, m.defDir, m.wblPrefIsDef, m.wbcJustname
  398.  
  399.         m.wblError    = .f.
  400.         m.wbiSelect    = SELECT()
  401.         
  402.         * Find the registration table.
  403.         * ----------------------------        
  404.         m.wbcTable    = THIS.WBGetRegPref("PREFW", THIS.wbcTypeDisplay + "S", C_REGTBLSTRING_LOC)
  405.         
  406.         IF empty(m.wbcTable)
  407.             m.wbcTable = THIS.wbcDefTable        
  408.         ENDIF
  409.         
  410.         m.wbcJustname = SUBSTR(m.wbcTable, RAT("\",m.wbcTable) + 1)
  411.         m.wblPrefIsDef = m.wbcJustname = THIS.wbcDefTable            && preference name = default name?
  412.         IF not file(m.wbcTable)                                        && if specified file does not exist,
  413.             m.wbcTable = THIS.WBSearch(m.wbcTable)                    && look for it
  414.             
  415.             IF empty(m.wbcTable) and not m.wblPrefIsDef
  416.                 m.wbcTable = THIS.WBSearch(THIS.wbcDefTable)        && look for default reg table
  417.             ELSE
  418.                 IF NOT FILE(m.wbcTable)
  419.                     m.wbcTable=""
  420.                 ENDIF
  421.             ENDIF
  422.             IF empty(m.wbcTable)
  423.                 IF NOT "WBPICK" $ UPPER(SET("CLASSLIB"))
  424.                     SET CLASSLIB TO wbpick ADDITIVE
  425.                 ENDIF
  426.                 m.cLocAction = ""
  427.                 oLocate = CREATE("wbLocate", THIS.wbcType, THIS.wbcTypeDisplay)            && updates m.cLocAction
  428.                 oLocate.SHOW
  429.                 RELEASE oLocate
  430.                 RELEASE CLASS WBPICK
  431.                 DO CASE
  432.                     CASE m.cLocAction = "Locate"
  433.                         m.wbcTable = THIS.WBFindFile(THIS.wbcDefTable, "DBF")
  434.                     CASE m.cLocAction = "Create"                    
  435.                         m.wbcTable = THIS.WBMakeRegTable()
  436.                 ENDCASE
  437.             ENDIF
  438.         ENDIF
  439.         
  440.         * See IF we can open the reg table.
  441.         * ---------------------------------
  442.         IF NOT EMPTY(m.wbcTable)                        && check for no table name - WBMakeRegTable() may
  443.             IF USED("_wbregtbl_")                        && have failed
  444.                 SELECT _wbregtbl_
  445.             ELSE
  446.                 SELECT 0
  447.             ENDIF
  448.  
  449.             m.wbcOnError = on("error")
  450.             ON ERROR m.wblError = .t.
  451.  
  452.             USE (m.wbcTable) AGAIN ALIAS _wbregtbl_ SHARED
  453.  
  454.             ON ERROR &wbcOnError
  455.             IF m.wblError
  456.                 = THIS.WBAlert(C_BADREGOPEN_LOC + m.wbcTable)
  457.                 m.wbcTable = ""
  458.             ELSE
  459.                 = THIS.WBAddArea(ALIAS())
  460.             ENDIF
  461.         ENDIF
  462.         
  463.         * See if reg table is populated. If not, offer to recreate the default reg table.
  464.         * -------------------------------------------------------------------------------
  465.         IF NOT EMPTY(m.wbcTable)
  466.             IF eof("_wbregtbl_")
  467.                 USE IN _wbregtbl_
  468.                 IF THIS.WBAlert(THIS.wbcNoWB, MB_OKCANCEL) = MB_RET_OK
  469.                     m.wbcTable = THIS.WBMakeRegTable()
  470.                 ELSE
  471.                       m.wbcTable = ""
  472.                 ENDIF
  473.             ENDIF
  474.         ENDIF
  475.                   
  476.         * Verify structure of reg table. If bad, offer to recreate the default table.
  477.         * ---------------------------------------------------------------------------
  478.         IF NOT EMPTY(m.wbcTable)
  479.             USE (m.wbcTable) AGAIN ALIAS _wbregtbl_ SHARED
  480.             IF NOT (type("name") = "C" AND type("descript") = "M" AND type("bitmap") = "M" AND ;
  481.                     type("type") = "C" AND type("program") = "M" AND type("classlib") = "M" AND ;
  482.                     type("classname") = "M" AND type("parms") = "M")
  483.                 IF THIS.WBAlert(m.wbcTable + THIS.wbcBadTable, MB_YESNO) = MB_RET_YES
  484.                     USE IN _wbregtbl_
  485.                     m.wbcTable = THIS.WBMakeRegTable()
  486.                 ELSE
  487.                     m.wbcTable = ""
  488.                 ENDIF
  489.             ENDIF
  490.         ENDIF
  491.                   
  492.  
  493.         * Update preference in foxuser.
  494.         * -----------------------------
  495.         IF NOT EMPTY(m.wbcTable)
  496.             USE (m.wbcTable) AGAIN ALIAS _wbregtbl_ SHARED
  497.             = THIS.WBPutRegPref('PREFW', THIS.wbcTypeDisplay + "S", C_REGTBLSTRING_LOC, .f., m.wbcTable)
  498.         ENDIF
  499.         
  500.         THIS.wbcRegTblLoc = LEFT(m.wbcTable,RAT("\",m.wbcTable)-1)
  501.             
  502.         * Populate the wbaAllData[] array.
  503.         * --------------------------------
  504.         IF NOT EMPTY(m.wbcTable)
  505.             THIS.WBGetData
  506.         ENDIF
  507.         
  508.         IF USED("_wbregtbl_")
  509.             USE IN _wbregtbl_
  510.         ENDIF
  511.         SELECT (m.wbiSelect)
  512.  
  513.         THIS.wbcRegTable = m.wbcTable
  514.         
  515.     ENDPROC
  516.     
  517.  
  518.     PROCEDURE WBGetData
  519.     * ----------------------------------------------------------------------------
  520.     * Populate the wbaAllData[] array from the registration table.
  521.     * ----------------------------------------------------------------------------    
  522.     
  523.         m.wbiTally = 0
  524.         
  525.         IF NOT EMPTY(m.wbcpName)                                            && specific file requested
  526.             m.wbiTally = THIS.WBDoSelect("NAMEDFILE")
  527.         ENDIF
  528.         
  529.         IF m.wbiTally = 0 AND NOT EMPTY(THIS.wbcNamedClass)                    && specific class requested (builders only)
  530.             m.wbiTally = THIS.WBDoSelect("NAMEDCLASS")
  531.         ENDIF
  532.         
  533.         IF m.wbiTally = 0 AND NOT EMPTY(THIS.wbcClass)                        && class of selected control, or wizard class
  534.             m.wbiTally = THIS.WBDoSelect("CLASS")
  535.         ENDIF
  536.  
  537.         IF m.wbiTally = 0 AND NOT EMPTY(THIS.wbcBaseClass)                    && base class of selected control (builders only)
  538.             m.wbiTally = THIS.WBDoSelect("BASECLASS")
  539.         ENDIF
  540.                 
  541.         IF m.wbiTally = 0
  542.             DO CASE
  543.                 CASE NOT EMPTY(m.wbcpName)                                && specific file not found
  544.                     = THIS.WBAlert(THIS.wbcNoName)
  545.  
  546.                 CASE NOT EMPTY(THIS.wbcClass)                                && specific type of file not found
  547.                     IF TYPE("m.wbcpOrigin")= "U" OR m.wbcpOrigin <> "TOOLBOX"
  548.                         = THIS.WBAlert(THIS.wbcNoClassLib)
  549.                     ENDIF
  550.                 
  551.                 OTHERWISE
  552.                     IF m.wbiTally = 0
  553.                         m.wbiTally = THIS.WBDoSelect("")
  554.                     ENDIF
  555.             ENDCASE
  556.         ENDIF
  557.  
  558.         IF m.wbiTally = 0
  559.             m.wbcTable = ""
  560.         ELSE
  561.             IF NOT EMPTY(ALLTRIM(m.wbcpOptions))
  562.                 m.wbiLength = ALEN(THIS.wbaAllData, 1)                        && react to params if any - make copy of 
  563.                 m.wbCopysize = 0                                            && array for those with correct param, update
  564.                 FOR m.wbi=1 TO m.wbiLength                                    && wbaAllData from that
  565.                     IF ! EMPTY(THIS.wbaAllData[m.wbi, 8])
  566.                         IF " " + UPPER(ALLTRIM(THIS.wbaAllData[m.wbi, 8])) + " " $ " " + UPPER(m.wbcpOptions) + " "
  567.                             m.wbCopysize = m.wbCopysize + 1
  568.                             DIMENSION wbaCopy[m.wbCopysize, 8]
  569.                             FOR m.wbi2 = 1 to 8
  570.                                 wbaCopy[m.wbCopysize, m.wbi2] = THIS.wbaAllData[m.wbi, m.wbi2]
  571.                             ENDFOR
  572.                         ENDIF
  573.                     ENDIF
  574.                 ENDFOR
  575.                 
  576.                 IF m.wbCopysize > 0                                        && One or more registered entries had something
  577.                     DIMENSION THIS.wbaAllData[ALEN(wbaCopy,1), 8]        && in the PARAMS field that is also in the
  578.                     = ACOPY(wbaCopy,THIS.wbaAllData)                    && m.wbcpOptions parameter. Alter wbaAllData[]
  579.                 ENDIF                                                    && to include only these.
  580.             ENDIF
  581.  
  582.             m.wbiLength = ALEN(THIS.wbaAllData, 1)                        && supply generic description message
  583.             FOR m.wbi=1 TO m.wbiLength                                    && where needed
  584.                 IF EMPTY(THIS.wbaAllData[m.wbi, 2])
  585.                     THIS.wbaAllData[m.wbi, 2] = THIS.wbcNoDesc
  586.                 ENDIF
  587.                 FOR m.wbi2=3 TO 7
  588.                     THIS.wbaAllData[m.wbi, m.wbi2] = UPPER(THIS.wbaAllData[m.wbi, m.wbi2])
  589.                 ENDFOR
  590.             ENDFOR
  591.         ENDIF
  592.  
  593.     ENDPROC
  594.  
  595.  
  596.     PROCEDURE WBDoSelect
  597.     * Suppress "auto" wizard types unless they're being explicitly asked for by the product
  598.     * ----------------------------------------------------------------------------
  599.         PARAMETER wbcSelectCode
  600.         
  601.         DO CASE
  602.             CASE m.wbcSelectCode == "NAMEDFILE"
  603.                                                                                   && in program field
  604.                 SELECT name, descript, bitmap, type, program, ;
  605.                     classlib, classname, parms ;
  606.                     FROM _wbregtbl_ ;
  607.                     WHERE UPPER(m.wbcpName) $ UPPER(program) OR UPPER(type) = C_ALL  ;
  608.                     INTO ARRAY THIS.wbaAllData ;
  609.                     ORDER BY name ;
  610.                     GROUP BY name
  611.              
  612.                 IF _tally = 0                                                    && if no program, look in classname field
  613.                     SELECT name, descript, bitmap, type, program, ;
  614.                         classlib, classname, parms ;
  615.                         FROM _wbregtbl_ ;
  616.                         WHERE UPPER(m.wbcpName) = UPPER(classname) OR UPPER(type) = C_ALL ;
  617.                         INTO ARRAY THIS.wbaAllData ;
  618.                         ORDER BY name;
  619.                         GROUP BY name
  620.                 ENDIF
  621.             
  622.             CASE m.wbcSelectCode == "NAMEDCLASS" OR m.wbcSelectCode == "CLASS" OR m.wbcSelectCode == "BASECLASS"
  623.                 DO CASE
  624.                     CASE m.wbcSelectCode == "NAMEDCLASS"
  625.                         m.wbcThisclass = THIS.wbcNamedClass
  626.                     CASE m.wbcSelectCode == "CLASS"
  627.                         m.wbcThisclass = THIS.wbcClass
  628.                     CASE m.wbcSelectCode == "BASECLASS"
  629.                         m.wbcThisclass = THIS.wbcBaseClass
  630.                 ENDCASE
  631.                 
  632.                 IF LEFT(UPPER(m.wbcThisclass),4) = "AUTO"
  633.                     SELECT name, descript, bitmap, type, program, ;
  634.                         classlib, classname, parms ;
  635.                         FROM _wbregtbl_ ;
  636.                         WHERE upper(type) = upper(m.wbcThisclass) OR UPPER(type) = C_ALL ;
  637.                         INTO ARRAY THIS.wbaAllData ;
  638.                         ORDER BY name;
  639.                         GROUP BY name
  640.                 ELSE
  641.                     SELECT name, descript, bitmap, type, program, ;
  642.                         classlib, classname, parms ;
  643.                         FROM _wbregtbl_ ;
  644.                         WHERE (UPPER(type) = UPPER(m.wbcThisclass) OR UPPER(type) = C_ALL) AND LEFT(UPPER(type),4) <> "AUTO" ;
  645.                         INTO ARRAY THIS.wbaAllData ;
  646.                         ORDER BY name;
  647.                         GROUP BY name
  648.                 ENDIF
  649.  
  650.             OTHERWISE                                                            && otherwise take all entries
  651.                 SELECT name, descript, bitmap, type, program, ;
  652.                     classlib, classname, parms ;
  653.                 FROM _wbregtbl_ ;
  654.                 WHERE LEFT(UPPER(type),4) <> "AUTO" OR UPPER(type) = C_ALL  ;
  655.                 INTO ARRAY THIS.wbaAllData ;
  656.                 ORDER BY name;
  657.                 GROUP BY name
  658.         ENDCASE
  659.         
  660.         RETURN _TALLY
  661.  
  662.     ENDPROC
  663.  
  664.     PROCEDURE WBGetName
  665.     * ----------------------------------------------------------------------------
  666.     * Find specific file to run.
  667.     * ----------------------------------------------------------------------------
  668.  
  669.         PRIVATE wbcToDo, wbcToFind, wbcFile, wbi, wbiSlot, wbiSelect, wblUserLib
  670.  
  671.         m.wbiSelect = SELECT()
  672.         STORE "" TO m.wbcToDo, wbcToFind
  673.         m.wblUserLib = .f.
  674.  
  675.         * one and only one entry found
  676.         IF ALEN(THIS.wbaAllData,1) = 1 and NOT EMPTY(THIS.wbaAllData[1,1])
  677.             m.wbiSlot = 1
  678.         ELSE
  679.             m.wbiSlot = THIS.WBNameSelect()        && pick list, returns slot of desired entry in wbaAllData[]
  680.             IF TYPE("wbiSlot") <> "N" OR m.wbiSlot = 0
  681.                 RETURN ""                        && user bailed out of picklist
  682.             ENDIF
  683.         ENDIF
  684.         
  685.         * We now have a slot with an entry, store it to wbaData[].
  686.         FOR m.wbi = 1 TO 8
  687.             THIS.wbaData[1, m.wbi] = ALLTRIM(THIS.wbaAllData[m.wbiSlot, m.wbi])
  688.         ENDFOR
  689.         
  690.         * Handle cases of what's registered. Program names have priority, otherwise use the class
  691.         * library to create an instance.
  692.  
  693.         DO CASE
  694.             CASE NOT EMPTY(THIS.wbaData[1,5])                    && program name
  695.                 m.wbcToDo = alltrim(THIS.wbaData[1,5])
  696.                 THIS.wbcBldrClass = ALLTRIM(THIS.wbaData[1,7])
  697.                 
  698.             CASE NOT EMPTY(THIS.wbaData[1,7])
  699.                 THIS.wblObject = .t.
  700.                 m.wbcToDo = THIS.wbaData[1, 7]                    && class name
  701.                 THIS.wbcLibrary = THIS.wbaData[1, 6]            && class library containing this class definition
  702.                 IF empty(THIS.wbcLibrary)
  703.                     THIS.wbcLibrary = THIS.wbcAppDir + THIS.wbcDefDir + THIS.wbcDefLib        && assume default library
  704.                 ELSE                                                                    && if none specified
  705.                     m.wblUserLib = .t.
  706.                 ENDIF                                                                    
  707.                 
  708.             OTHERWISE
  709.                 IF m.wbcpOrigin <> "TOOLBOX"
  710.                     = THIS.WBAlert(THIS.wbcNoReg)                && neither a program nor a class
  711.                 ENDIF
  712.                 
  713.                 RETURN ""                                    && was registered
  714.         ENDCASE
  715.  
  716.         m.wbcFile = ""
  717.  
  718.         * If it's a .prg, look for that. If it's an object, look for the class
  719.         * library, and then look in that for the class name. If we can't find the 
  720.         * user-specified class library, look in the default class library (WIZARD.VCX
  721.         * or BUILDER.VCX). If either a library can't be found, or the class name can't be
  722.         * found in the library, alert message asks user if they want to locate the
  723.         * library containing the definition
  724.         
  725.         m.wbcToFind = IIF(THIS.wblObject, THIS.wbcLibrary, m.wbcToDo)
  726.  
  727.         DO WHILE .t.
  728.  
  729.             m.wbcFile = THIS.WBSearch(m.wbcToFind)
  730.           
  731.             * if user-specified library not found, try default class library
  732.             IF empty(m.wbcFile) and m.wblUserLib
  733.                 THIS.wbcLibrary = THIS.wbcAppDir + THIS.wbcDefDir + THIS.wbcDefLib
  734.                 m.wblUserLib = .f.
  735.                 m.wbcToFind = THIS.wbcLibrary
  736.                 loop
  737.             ENDIF
  738.             
  739.             DO CASE
  740.                 CASE not THIS.wblObject                && not an object
  741.                     m.wbcToDo = m.wbcFile
  742.                     IF empty(m.wbcToDo)
  743.                         = THIS.WBAlert(THIS.wbcNoName)
  744.                     ELSE
  745.                         IF !FILE(m.wbcToDo)
  746.                             wbcToDo = HOME() + wbcToDo
  747.                             IF !FILE(m.wbcToDo)
  748.                                 THIS.WBAlert(THIS.wbcNoName)
  749.                                 m.wbcToDo = ""
  750.                             ENDIF
  751.                         ENDIF
  752.                     ENDIF
  753.                     
  754.                 CASE NOT EMPTY(m.wbcFile)            && found an object library - now be sure that
  755.                     THIS.wbcLibrary = m.wbcFile        && class definition exists also
  756.                     SELECT 0
  757.                     USE (THIS.wbcLibrary) AGAIN ALIAS _WBlib SHARED NOUPDATE
  758.                     = THIS.WBAddArea(ALIAS())
  759.                     locate for alltrim(upper(objname)) == alltrim(THIS.wbaData[1, 7]) and empty(parent)    && class definition
  760.                     IF not found()
  761.                         m.wbcToDo = ""
  762.                         IF THIS.WBAlert(THIS.wbcNoClassLib + CHR(13) + C_NOLIB2_LOC, MB_OKCANCEL) = MB_RET_OK
  763.                             loop
  764.                         ENDIF
  765.                     ELSE
  766.                         m.wbcToDo = alltrim(THIS.wbaData[1, 7])
  767.                     ENDIF
  768.                     USE IN _WBlib
  769.                     
  770.                 otherwise                            && class library not found
  771.                     IF THIS.WBAlert(THIS.wbcNoClassLib + CHR(13) + C_NOLIB2_LOC, MB_OKCANCEL) = MB_RET_OK
  772.                         loop
  773.                     ENDIF
  774.             ENDCASE
  775.             
  776.             exit
  777.  
  778.         enddo
  779.  
  780.         THIS.wbcName = m.wbcToDo
  781.  
  782.         THIS.WBAddparms
  783.     
  784.     ENDPROC
  785.     
  786.     
  787.     PROCEDURE WBAddparms
  788.     * ----------------------------------------------------------------------------
  789.     * Construct parameters string. In general, two types of parameters are possible. Parameters can be 
  790.     * passed in to a specific wizard or builder ("DO <wizard> WITH <param1>, <param2>", etc). Also, wizards/builders
  791.     * can have variations and these can be registered in the parms field of the reg table. For example, DO FORMWIZ.APP
  792.     * WITH "NORMALFORM", or DO FORMWIZ.APP WITH "ONE_TO_MANY" - the same formwiz.app runs either wizard, depending
  793.     * on this flag. This function prepends any parameters in the parms field of the reg table onto whatever parameter
  794.     * string may exist.
  795.     * ----------------------------------------------------------------------------
  796.     
  797.         THIS.wbParm = "'wbReturnValue'"                                            && return value reference
  798.         THIS.wbParm = THIS.wbParm + ",'" + alltrim(THIS.wbaData[1, 8]) + "'"    && entry in parms field of reg table
  799.         THIS.wbParm = THIS.wbParm + ",m.wbcpOptions"                            && optional keyword parameter (eg "NOSCRN")
  800.         
  801.         FOR m.wbi=1 to THIS.wbOptParms
  802.             m.thisp = "wbcpP" + LTRIM(STR(m.wbi))
  803.             THIS.wbParm = THIS.wbParm + "," + m.thisp    && will create ...,wbcpP1,wbcpP2..." etc
  804.         ENDFOR
  805.     
  806.         * Sample result - THIS.wbParm = "'wbReturnValue','',m.wbcpOptions,wbcpP1,wbcpP2"
  807.     
  808.     ENDPROC
  809.     
  810.     
  811.     PROCEDURE WBCall
  812.     * ----------------------------------------------------------------------------
  813.     * Call the file. 
  814.     * ----------------------------------------------------------------------------
  815.  
  816.         SELECT (THIS.wbaEnvir[5])
  817.  
  818.         PRIVATE m.wbReturnValue, m.cParmstring
  819.         m.wbReturnValue = THIS.wbReturnValue
  820.         m.cParmstring = THIS.wbParm
  821.  
  822.         IF THIS.wblObject
  823.             SET CLASSLIB TO (THIS.wbcLibrary) ADDITIVE
  824.             
  825.             PUBLIC wboName
  826.  
  827.             wboName = CREATEOBJ(THIS.wbcName, &cParmstring)        && all builders and wizards are modal formsets
  828.  
  829.  
  830.             IF TYPE("_TIMING") <> "U" AND _TIMING
  831.                 RETURN
  832.             ENDIF
  833.             
  834.             IF TYPE("wboName") = "O"
  835.                 wboName.SHOW
  836.                 IF THIS.wbcName = "RIBUILDR"
  837.                     SET SKIP OF BAR _MWI_DEBUG OF _MSM_TOOLS .f.
  838.                     SET SKIP OF BAR _MWI_TRACE OF _MSM_TOOLS .f.
  839.                 ENDIF
  840.             ENDIF
  841.  
  842.         ELSE
  843.             
  844.             IF UPPER(JUSTEXT(THIS.wbcName))="SCX"
  845.                 DO FORM (THIS.wbcName) WITH &cParmstring
  846.             ELSE
  847.                 DO (THIS.wbcName) WITH &cParmstring
  848.             ENDIF
  849.         ENDIF
  850.  
  851.         THIS.wbReturnValue = m.wbReturnValue
  852.         
  853.         IF THIS.wblModal                            && don't release, if modeless for testing
  854.             RELEASE wboName
  855.             IF THIS.wblObject AND FILE(THIS.wbcLibrary)
  856.                 RELEASE CLASSLIB (THIS.wbcLibrary)
  857.             ENDIF
  858.         ENDIF
  859.         
  860.     ENDPROC
  861.     
  862.     PROCEDURE WBSearch
  863.     * ----------------------------------------------------------------------------
  864.     * Locates program files or class libraries, using a flexible search logic as 
  865.     * specified in THIS.SearchOrder array. 
  866.     * ----------------------------------------------------------------------------
  867.  
  868.         PARAMETERS wbcFind
  869.  
  870.         PRIVATE m.wbcFind, m.wbiLength, m.wbi, m.wblFoundit
  871.         
  872.         IF TYPE("m.wbcFind") <> "C"
  873.             RETURN ""
  874.         ENDIF
  875.  
  876.         IF "\" $ m.wbcFind
  877.             * qualified filename is okay
  878.             IF !FILE(m.wbcFind) AND TYPE("EVAL(m.wbcFind)")=="C" AND FILE(EVAL(m.wbcFind))
  879.                 m.wbcFind = EVAL(m.wbcFind)
  880.             ENDIF
  881.         ELSE
  882.             m.wbjustfile = m.wbcFind
  883.             IF "\" $ m.wbjustfile
  884.                 m.wbjustfile = SUBSTR(m.wbjustfile,RAT("\",m.wbjustfile)+1)
  885.             ENDIF
  886.             m.wbiLength = ALEN(THIS.wbaSearchOrder, 1)
  887.             m.wblFoundit = .f.
  888.             FOR m.wbi = 1 TO m.wbiLength
  889.             
  890.                 * For specific directory testing, use ADIR() because FILE() will find files of the same name
  891.                 * inside the .app and incorrectly return .t.
  892.                 
  893.                 DO CASE
  894.                     CASE THIS.wbaSearchOrder[m.wbi] = "WIZARDS" ;
  895.                         AND ADIR(wbaTemp, THIS.wbcAppDir + THIS.wbcDefDir + m.wbjustfile) > 0        && check wizards subdirectory
  896.                             m.wbcFind = THIS.wbcAppDir + THIS.wbcDefDir + m.wbjustfile                && under wizard.app, SYS(16,1)
  897.                             m.wblFoundit = .t.
  898.                             EXIT
  899.                     CASE THIS.wbaSearchOrder[m.wbi] = "REGLOC" AND NOT EMPTY(THIS.wbcRegTblLoc) ;
  900.                         AND ADIR(wbaTemp, THIS.wbcRegTblLoc + "\" + m.wbjustfile) > 0        && check reg table location,
  901.                             m.wbcFind = THIS.wbcRegTblLoc + "\" + m.wbjustfile                && whereever that is
  902.                             m.wblFoundit = .t.
  903.                             EXIT
  904.                     CASE THIS.wbaSearchOrder[m.wbi] = "CURRENT" ;
  905.                         AND ADIR(wbaTemp, IIF(SYS(2003)=="\","",SYS(2003)) + "\" + ;
  906.                                 m.wbjustfile) > 0        && check current subdirectory
  907.                             m.wbcFind = SYS(2003) + "\" + m.wbjustfile
  908.                             m.wblFoundit = .t.
  909.                             EXIT
  910.                     CASE THIS.wbaSearchOrder[m.wbi] = "APPDIR" ;
  911.                         AND ADIR(wbaTemp, THIS.wbcAppDir + m.wbjustfile) > 0        && check wizard.app's directory, SYS(16,1)
  912.                             m.wbcFind = THIS.wbcAppDir + m.wbjustfile
  913.                             m.wblFoundit = .t.
  914.                             EXIT
  915.                     CASE THIS.wbaSearchOrder[m.wbi] = "ROOTWIZARDS" ;
  916.                         AND ADIR(wbaTemp, SYS(2004) + THIS.wbcDefDir + m.wbjustfile) > 0        && check SYS(2004)\wizards subdirectory
  917.                             m.wbcFind = SYS(2004) + THIS.wbcDefDir + m.wbjustfile
  918.                             m.wblFoundit = .t.
  919.                             EXIT
  920.                     CASE THIS.wbaSearchOrder[m.wbi] = "STARTUP" ;
  921.                         AND ADIR(wbaTemp, SYS(2004) + m.wbjustfile) > 0                        && check startup directory, SYS(2004)
  922.                             m.wbcFind = SYS(2004) + m.wbjustfile
  923.                             m.wblFoundit = .t.
  924.                             EXIT
  925.                     CASE THIS.wbaSearchOrder[m.wbi] = "FULLPATH" ;
  926.                         AND FILE(m.wbjustfile)                                        && check full path with file() 
  927.                             m.wblFoundit = .t.
  928.                             EXIT
  929.                 ENDCASE
  930.             ENDFOR
  931.             IF NOT m.wblFoundit 
  932.                 m.wbcFind = ""
  933.             ENDIF
  934.         ENDIF
  935.  
  936.         RETURN m.wbcFind
  937.  
  938.     ENDPROC
  939.     
  940.     PROCEDURE WBFindFile
  941.     * ----------------------------------------------------------------------------
  942.     * Uses GETFILE() to locate a particular file.
  943.     * ----------------------------------------------------------------------------
  944.  
  945.         PARAMETERS m.wbcFile, wbcExtension, wbcBtnCaption
  946.  
  947.         PRIVATE wbcFile, wbcExtension, wbcBtnCaption
  948.         m.wbcExtension = IIF(empty(m.wbcExtension), "", m.wbcExtension)
  949.         m.wbcBtnCaption = IIF(empty(m.wbcBtnCaption), "OK", m.wbcBtnCaption)
  950.  
  951.         RETURN getfile(m.wbcExtension, C_LOCATE_LOC + alltrim(m.wbcFile) + ":", m.wbcBtnCaption)
  952.     ENDPROC
  953.     
  954.     PROCEDURE WBMakeRegTable
  955.     * ----------------------------------------------------------------------------
  956.     * Creates subdirectory if necessary and calls WBPutRegTable() to create
  957.     * the registration table.
  958.     * ----------------------------------------------------------------------------
  959.  
  960.         PRIVATE wbcTblName
  961.  
  962.         m.wbcTblName = ""
  963.         IF ADIR(wbaTemp, THIS.wbcAppDir + STRTRAN(THIS.wbcDefDir, "\"), "D") = 0
  964.             MD (THIS.wbcAppDir + STRTRAN(THIS.wbcDefDir, "\"))                        && create directory
  965.         ENDIF
  966.  
  967.         DO WHILE .t.
  968.             m.wbcTblName = THIS.WBPutRegTable(THIS.wbcAppDir + THIS.wbcDefDir)
  969.             IF EMPTY(m.wbcTblName)
  970.                 IF THIS.WBAlert(C_MAKEREGERROR_LOC, MB_OKCANCEL) = MB_RET_OK
  971.                     LOOP
  972.                 ENDIF
  973.             ENDIF
  974.             EXIT
  975.         ENDDO
  976.  
  977.         RETURN m.wbcTblName
  978.     ENDPROC
  979.     
  980.     PROCEDURE WBPutRegTable
  981.     * ----------------------------------------------------------------------------
  982.     * Creates registration table.
  983.     * ----------------------------------------------------------------------------
  984.  
  985.         PARAMETER m.wbcStartDir
  986.  
  987.         PRIVATE m.wbcStartDir, wbcDirName, wbiSelect, wbcOnerror, wblError
  988.  
  989.         m.wblError = .f.
  990.         DO WHILE .t.
  991.             m.wbcDirName = IIF(!EMPTY(m.wbcStartDir), m.wbcStartDir,  ;
  992.                 GETDIR(CURDIR(), C_SELDIR_LOC))
  993.             m.wbcStartDir = ""
  994.             IF EMPTY(m.wbcDirName)
  995.                 EXIT
  996.             ENDIF
  997.             m.wbiSelect = SELECT()
  998.             SELECT 0
  999.             m.wbcOnError = ON("ERROR")
  1000.             ON ERROR m.wblError = .t.
  1001.             IF NOT USED("_wbnewreg_")
  1002.                 USE (THIS.wbcTemplateTbl) ALIAS _wbnewreg_        && wRegTbl.dbf/bRegTbl.dbf will be burned into app
  1003.             ELSE
  1004.                 SELECT _wbnewreg_
  1005.             ENDIF
  1006.             = THIS.WBAddArea(ALIAS())
  1007.                     
  1008.             m.wblProVersion = VERSION(2) = 2                    && pro version = 2, standard = 1, runtime = 0
  1009.             m.wblStdVersion = VERSION(2) = 1
  1010.             
  1011.             IF FILE(m.wbcDirName + THIS.wbcDefTable)        && table could exist with bad structure, make
  1012.                 m.wzstest = m.wbcDirName + THIS.wbcDefTable    && sure it's writable
  1013.                 m.wzihandle = FOPEN(m.wzstest,12)
  1014.                 IF m.wzihandle < 0
  1015.                     = THIS.WBAlert(UPPER(m.wzstest) + " " + C_BADOPEN_LOC,0)
  1016.                     m.wbcDirName = ""
  1017.                     EXIT
  1018.                   ELSE
  1019.                     = FCLOSE(m.wzihandle)
  1020.                 ENDIF
  1021.                 
  1022.                 m.cMemoname = IIF(UPPER(RIGHT(m.wzstest,4)) = ".DBF",LEFT(m.wzstest,LEN(m.wzstest)-4),m.wzstest) + ".fpt"
  1023.                 IF FILE(m.cMemoname)
  1024.                     m.wzihandle = FOPEN(m.cMemoname,12)
  1025.                     IF m.wzihandle < 0
  1026.                         = THIS.WBAlert(UPPER(m.wzstest) + " " + C_BADOPEN_LOC,0)
  1027.                         m.wbcDirName = ""
  1028.                         EXIT
  1029.                       ELSE
  1030.                         = FCLOSE(m.wzihandle)
  1031.                     ENDIF
  1032.                 ENDIF
  1033.             ENDIF
  1034.             
  1035.             IF m.wblProVersion
  1036.                 DO CASE
  1037.                     CASE _DOS
  1038.                         COPY TO (m.wbcDirName + THIS.wbcDefTable) ;
  1039.                         FIELDS name, descript, bitmap, type, program, classlib, classname, parms ;
  1040.                         FOR platform = "D"
  1041.  
  1042.                     CASE _WINDOWS
  1043.                         COPY TO (m.wbcDirName + THIS.wbcDefTable) ;
  1044.                         FIELDS name, descript, bitmap, type, program, classlib, classname, parms ;
  1045.                         FOR platform = "W"
  1046.                       
  1047.                     CASE _MAC
  1048.                         COPY TO (m.wbcDirName + THIS.wbcDefTable) ;
  1049.                         FIELDS name, descript, bitmap, type, program, classlib, classname, parms ;
  1050.                         FOR platform = "M"
  1051.                 ENDCASE
  1052.             ENDIF
  1053.             
  1054.             IF m.wblStdVersion
  1055.                 DO CASE
  1056.                     CASE _DOS
  1057.                         COPY TO (m.wbcDirName + THIS.wbcDefTable) ;
  1058.                         FIELDS name, descript, bitmap, type, program, classlib, classname, parms ;
  1059.                         FOR platform = "D" AND NOT proversion
  1060.  
  1061.                     CASE _WINDOWS
  1062.                         COPY TO (m.wbcDirName + THIS.wbcDefTable) ;
  1063.                         FIELDS name, descript, bitmap, type, program, classlib, classname, parms ;
  1064.                         FOR platform = "W" AND NOT proversion
  1065.                       
  1066.                     CASE _MAC
  1067.                         COPY TO (m.wbcDirName + THIS.wbcDefTable) ;
  1068.                         FIELDS name, descript, bitmap, type, program, classlib, classname, parms ;
  1069.                         FOR platform = "M" AND NOT proversion
  1070.                 ENDCASE
  1071.             ENDIF
  1072.             
  1073.             USE IN _wbnewreg_
  1074.             
  1075.             ON ERROR &wbcOnError
  1076.             IF m.wblError
  1077.                 IF FILE(m.wbcDirName + THIS.wbcDefTable)
  1078.                     ERASE (m.wbcDirName + THIS.wbcDefTable)
  1079.                 ENDIF
  1080.                 IF FILE(m.wbcDirName + THIS.wbcDefFPT)
  1081.                     ERASE (m.wbcDirName + THIS.wbcDefFPT)
  1082.                 ENDIF
  1083.                 IF THIS.WBAlert(C_MAKEREGERROR_LOC, MB_OKCANCEL) = MB_RET_OK        && Error - try again?
  1084.                     LOOP
  1085.                 ELSE
  1086.                     m.wbcDirName = ""
  1087.                 ENDIF
  1088.             ENDIF
  1089.             EXIT
  1090.         ENDDO
  1091.  
  1092.         RETURN m.wbcDirName + IIF(!empty(m.wbcDirName), THIS.wbcDefTable, "")
  1093.         
  1094.     ENDPROC
  1095.     
  1096.     PROCEDURE WBGetRegPref
  1097.     * ----------------------------------------------------------------------------
  1098.     * Locates the registration preference entry in the resource file.
  1099.     * ----------------------------------------------------------------------------
  1100.  
  1101.         PARAMETERS m.wbcPrefType, m.wbcPrefID, m.wbcPrefName
  1102.  
  1103.         PRIVATE wbcPrefType, wbcPrefID, wbcPrefName, wbiSelect, wbcOnError, ;
  1104.                 wbcErrorMsg, wblError, wbcExact, wbcData
  1105.  
  1106.         IF set("resource") = "OFF"
  1107.             RETURN ""
  1108.         ENDIF
  1109.         IF empty(m.wbcPrefType) and empty(m.wbcPrefID) and empty(m.wbcPrefName)
  1110.             RETURN ""
  1111.         ENDIF
  1112.  
  1113.         m.wbcPrefType = IIF(empty(m.wbcPrefType), "", m.wbcPrefType)
  1114.         m.wbcPrefID = IIF(empty(m.wbcPrefID), "", m.wbcPrefID)
  1115.         m.wbcPrefName = IIF(empty(m.wbcPrefName), "", m.wbcPrefName)
  1116.         m.wbcErrMsg = C_RSCERROR_LOC + CHR(13) + CHR(13) + SYS(2005)
  1117.  
  1118.         m.wbiSelect = SELECT()
  1119.         SELECT 0
  1120.         m.wbcOnError = on("error")
  1121.         m.wblError = .f.
  1122.         ON ERROR m.wblError = .t.
  1123.         USE SYS(2005) AGAIN ALIAS wbcRsc SHARED
  1124.         IF m.wblError
  1125.             m.wblError = .f.
  1126.             = THIS.WBAlert(m.wbcErrMsg)
  1127.             IF m.wblError
  1128.                 wait window m.wbcErrorMsg
  1129.             ELSE
  1130.                 m.wblError = .t.
  1131.             ENDIF
  1132.         ENDIF
  1133.         ON ERROR &wbcOnError
  1134.         IF m.wblError
  1135.             SELECT (m.wbiSelect)
  1136.             RETURN ""
  1137.         ELSE
  1138.             = THIS.WBAddArea(ALIAS())
  1139.         ENDIF
  1140.  
  1141.         m.wbcExact = set("exact")
  1142.         set exact on
  1143.         locate for IIF(!empty(m.wbcPrefType), type = m.wbcPrefType, .t.) ;
  1144.             and IIF(!empty(m.wbcPrefID), id = m.wbcPrefID, .t.) ;
  1145.             and IIF(!empty(m.wbcPrefName), name = m.wbcPrefName, .t.)
  1146.         m.wbcData = IIF(found(), data, "")
  1147.         set exact &wbcExact
  1148.  
  1149.         USE IN wbcRsc
  1150.         SELECT (m.wbiSelect)
  1151.  
  1152.         RETURN m.wbcData
  1153.     ENDPROC
  1154.     
  1155.     PROCEDURE WBPutRegPref
  1156.     * ----------------------------------------------------------------------------
  1157.     * Updates the registration preference entry in the resource file.
  1158.     * ----------------------------------------------------------------------------
  1159.  
  1160.         PARAMETERS m.wbcPrefType, m.wbcPrefID, m.wbcPrefName, m.wblReadonly, m.wbcData
  1161.  
  1162.         PRIVATE m.wbcPrefType, m.wbcPrefID, m.wbcPrefName, m.wblReadonly, m.wbcData, ;
  1163.                 m.wbiSelect, m.wbcOnError, m.wblError, m.wbcExact
  1164.  
  1165.         IF set("resource") = "OFF"
  1166.             RETURN .f.
  1167.         ENDIF
  1168.         IF empty(m.wbcPrefType) and empty(m.wbcPrefID) and empty(m.wbcPrefName)
  1169.             RETURN .f.
  1170.         ENDIF
  1171.  
  1172.         m.wbcPrefType = IIF(empty(m.wbcPrefType), "", m.wbcPrefType)
  1173.         m.wbcPrefID = IIF(empty(m.wbcPrefID), "", m.wbcPrefID)
  1174.         m.wbcPrefName = IIF(empty(m.wbcPrefName), "", m.wbcPrefName)
  1175.         m.wbcData = IIF(empty(m.wbcData), "", m.wbcData)
  1176.         m.wbcErrorMsg = C_RSCERROR_LOC + CHR(13) + CHR(13) + SYS(2005)
  1177.  
  1178.         m.wbiSelect = SELECT()
  1179.         SELECT 0
  1180.         m.wbcOnError = ON("error")
  1181.         m.wblError = .f.
  1182.         ON ERROR m.wblError = .t.
  1183.         USE SYS(2005) AGAIN ALIAS wbcRsc SHARED
  1184.         IF m.wblError
  1185.             m.wblError = .f.
  1186.             = THIS.WBAlert(m.wbcErrMsg)
  1187.             IF m.wblError
  1188.                 = MESSAGEBOX(m.wbcErrorMsg)
  1189.             ELSE
  1190.                 m.wblError = .t.
  1191.             ENDIF
  1192.         ENDIF
  1193.         IF ISREADONLY()
  1194.             USE IN wbcRsc
  1195.             m.wblError = .t.
  1196.         ENDIF
  1197.         IF m.wblError
  1198.             ON ERROR &wbcOnError
  1199.             SELECT (m.wbiSelect)
  1200.             RETURN .f.
  1201.         ELSE
  1202.             = THIS.WBAddArea(ALIAS())    
  1203.         ENDIF
  1204.  
  1205.         m.wbcExact = set("exact")
  1206.         SET EXACT ON
  1207.         LOCATE FOR IIF(!empty(m.wbcPrefType), type = m.wbcPrefType, .t.) ;
  1208.             AND IIF(!empty(m.wbcPrefID), id = m.wbcPrefID, .t.) ;
  1209.             AND IIF(!empty(m.wbcPrefName), name = m.wbcPrefName, .t.)
  1210.                
  1211.         IF FOUND()
  1212.             REPLACE readonly WITH m.wblReadonly,  ;
  1213.                     ckval WITH VAL(SYS(2007, m.wbcData)),  ;
  1214.                     data WITH m.wbcData,  ;
  1215.                     updated WITH date()
  1216.         ELSE
  1217.             APPEND BLANK
  1218.             REPLACE type WITH m.wbcPrefType,  ;
  1219.                     id WITH m.wbcPrefID,  ;
  1220.                     name WITH m.wbcPrefName,  ;
  1221.                     readonly WITH m.wblReadonly,  ;
  1222.                     ckval WITH VAL(SYS(2007, m.wbcData)),  ;
  1223.                     data WITH m.wbcData,  ;
  1224.                     updated WITH date()
  1225.         ENDIF
  1226.         SET EXACT &wbcExact
  1227.         ON ERROR &wbcOnError
  1228.  
  1229.         USE IN wbcRsc
  1230.         SELECT (m.wbiSelect)
  1231.  
  1232.         RETURN !m.wblError
  1233.         
  1234.     ENDPROC
  1235.     
  1236.     PROCEDURE WBAddArea
  1237.     * ----------------------------------------------------------------------------
  1238.     * Whenever we SELECT 0 to use a table, record that work area in the wbaAreas[]
  1239.     * array. Procedure WBSetEnvironment issues a USE in all such work areas on the 
  1240.     * way out. Tables originally in use should not be affected by this app, and
  1241.     * tables opened by this app should be closed.
  1242.     * ----------------------------------------------------------------------------
  1243.  
  1244.         PARAMETER wbiAlias
  1245.  
  1246.         PRIVATE m.wbiAlias
  1247.  
  1248.         IF ASCAN(THIS.wbaAreas, m.wbiAlias) = 0
  1249.             IF NOT EMPTY(THIS.wbaAreas[1])
  1250.                 DIMENSION THIS.wbaAreas[ALEN(THIS.wbaAreas, 1) + 1]
  1251.             ENDIF
  1252.             THIS.wbaAreas[ALEN(THIS.wbaAreas, 1)] = m.wbiAlias
  1253.         ENDIF
  1254.  
  1255.     ENDPROC
  1256.     
  1257.     PROCEDURE WBNameSelect
  1258.     * ----------------------------------------------------------------------------
  1259.     * Presents a form with a picklist of relevant entries for the user to 
  1260.     * select from, using the wbaAllData[] array for the list. The form called 
  1261.     * here should be based on the wizard or builder base class. Returns the row 
  1262.     * number in wbaAllData[], or 0 IF user cancels. 
  1263.     * ----------------------------------------------------------------------------
  1264.  
  1265.         PRIVATE m.wbiPicked, m.wbi, m.wbarrlen
  1266.  
  1267.         m.wbiPicked = 1
  1268.  
  1269.         IF NOT "WBPICK" $ UPPER(SET("CLASSLIB"))
  1270.             SET CLASSLIB TO wbpick ADDITIVE
  1271.         ENDIF
  1272.         oPick = CREATEOBJECT("wbpicklist")
  1273.         oPick.SHOW
  1274.         
  1275.         RELEASE oPick
  1276.         RELEASE CLASS wbpick
  1277.         
  1278.         IF TYPE("wbipicked") <> "N"
  1279.             m.wbipicked = 0
  1280.         ENDIF
  1281.                 
  1282.         RETURN m.wbiPicked
  1283.  
  1284.     ENDPROC
  1285.     
  1286.     PROCEDURE WBHelp
  1287.     * ----------------------------------------------------------------------------
  1288.     * Custom help for wizards/builders.
  1289.     * ----------------------------------------------------------------------------
  1290.     
  1291.         = THIS.WBAlert("Help is not yet implemented.")
  1292.     
  1293.     ENDPROC
  1294.     
  1295.     PROCEDURE Error
  1296.     * ----------------------------------------------------------------------------
  1297.     * Error handler for wizard/builder object (created by wbmain.prg).
  1298.     * ----------------------------------------------------------------------------
  1299.  
  1300.         PARAMETERS m.wbcNum, m.wbcMethod, m.wbcLine
  1301.  
  1302.         PRIVATE m.wbcMsg, m.wbcMsg1, m.wbcProgram, m.wbcAlertMsg, m.wbiAction
  1303.         LOCAL lcErrorMsg,lcCodeLineMsg
  1304.     
  1305.         IF C_DEBUG
  1306.  
  1307.             lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+'Builder:   '+this.Name+CHR(13)
  1308.             lcErrorMsg=lcErrorMsg+'Method:    '+m.wbcMethod
  1309.             lcCodeLineMsg=MESSAGE(1)
  1310.             IF BETWEEN(m.wbcLine,1,10000) AND NOT lcCodeLineMsg='...'
  1311.                 lcErrorMsg=lcErrorMsg+CHR(13)+'Line:  '+ALLTRIM(STR(m.wbcLine))
  1312.                 IF NOT EMPTY(lcCodeLineMsg)
  1313.                     lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
  1314.                 ENDIF
  1315.             ENDIF
  1316.             WAIT CLEAR
  1317.             WAIT WINDOW lcErrorMsg NOWAIT
  1318.  
  1319.             m.wbcAlertMsg = alltrim(MESSAGE()) + CHR(13) + CHR(13) + ;
  1320.                 C_PRG_LOC + alltrim(m.wbcMethod) + CHR(13) + ;
  1321.                 C_MSG1_LOC + "(" + alltrim(str(m.wbcLine)) + ") " + MESSAGE(1) + CHR(13)
  1322.  
  1323.             m.wbiAction = THIS.WBAlert(m.wbcAlertMsg, MB_ICONEXCLAMATION + MB_ABORTRETRYIGNORE)
  1324.             DO CASE
  1325.                 CASE m.wbiAction = MB_RET_RETRY
  1326.                     set step on
  1327.                     retry
  1328.                 CASE m.wbiAction = MB_RET_IGNORE
  1329.                     RETURN
  1330.                 OTHERWISE
  1331.                     CLEAR PROG
  1332.                     RETURN TO MASTER
  1333.             ENDCASE
  1334.         ELSE
  1335.             m.wbcAlertMsg = C_ERRGENERIC_LOC + UPPER(m.wbcMethod)
  1336.             = THIS.WBAlert(m.wbcAlertMsg, MB_ICONEXCLAMATION + MB_OK)
  1337.             RETURN TO MASTER
  1338.         ENDIF
  1339.  
  1340.     ENDPROC
  1341.  
  1342.     PROCEDURE WBAlert
  1343.     * ----------------------------------------------------------------------------
  1344.     * Display procedure for error messages. This is called by the error
  1345.     * routine, which can also be invoked by wizards and builders.
  1346.     * ----------------------------------------------------------------------------
  1347.  
  1348.         PARAMETERS m.wbcMessage, m.wbcOpts, m.wbcTitle
  1349.         
  1350.         PRIVATE m.wbcOpts, m.wbcResponse, m.wbcTitle, m.wbcOldError
  1351.  
  1352.         m.wbcOpts=IIF(empty(m.wbcOpts), MB_OK, m.wbcOpts)
  1353.         IF NOT EMPTY(m.wbcTitle)
  1354.             m.wbcResponse = MessageBox(m.wbcMessage, m.wbcOpts, m.wbcTitle)
  1355.         ELSE
  1356.             m.wbcResponse = MessageBox(m.wbcMessage, m.wbcOpts, THIS.wbcAlertTitle)
  1357.         ENDIF
  1358.         
  1359.         RETURN m.wbcResponse
  1360.  
  1361.     ENDPROC
  1362.     
  1363. ENDDEFINE