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 / builder.prg < prev    next >
Encoding:
Text File  |  1998-05-01  |  13.5 KB  |  535 lines
  1. * Program:        BUILDER.PRG
  2. * Description:    Main program of Builder.app
  3.  
  4. * Parameters:
  5. *    wbopCtrl        - possible object reference
  6. *    wbcpOrigin        - origin of call to builder - PSHEET, RTMOUSE, TOOLBOX
  7. *    wbcpName        = (reserved)
  8. *    wbcpOptions        - (reserved)
  9. *     wbcpP1-9        - optional parameters to pass to builder
  10. * -----------------------------------------------------------------------------------------------------
  11.  
  12. parameters wbopCtrl, wbcpOrigin, wbcpClass, wbcpName, wbcpOptions, wbcpP1, wbcpP2, wbcpP3, wbcpP4, wbcpP5, wbcpP6, wbcpP7, wbcpP8, wbcpP9
  13. LOCAL toObject,tuSource,tcRunBuilder
  14. LOCAL lcBuilder,lcBuilder2, cTopWindow
  15.  
  16. #DEFINE C_BUILDER_LOC            "BUILDER"
  17. #INCLUDE "BUILDERS\BUILDER.H"
  18.  
  19. IF SET("TALK") = "ON"
  20.     SET TALK OFF
  21.     m.wbTalk = "ON"
  22. ELSE
  23.     m.wbTalk = "OFF"
  24. ENDIF
  25.  
  26. * -------------------------------------------------
  27. * DEBUG - set timer flag .T. to time builder - debug window line is
  28. *     fwrite(fp,padr(prog(),80)+str(line(),4)+str(seconds(),10,3)+chr(13))
  29. _TIMING = IIF(TYPE("_TIMING") <> "L", .f., _TIMING)
  30. _TIMECODE = 1        && 0 - time load, up to show
  31.                     && 1 - time entire code
  32.  
  33. * Create timer log
  34. IF _TIMING
  35.     starttime = seconds()
  36.     fp=fcrea("log.txt")
  37. ENDIF
  38. * -------------------------------------------------
  39.  
  40. m.wbOptionalParms = parameters() - 4                && first 4 are known parameters, remainder are optional
  41.  
  42. tcRunBuilder=wbcpClass
  43.  
  44. m.wbcBldVer = " version .078"
  45.  
  46. m.wbStartingProc = SET("PROCEDURE")
  47.  
  48. IF TYPE("wbopCtrl") <> "O"                            && We may have an object reference passed in,
  49.     FOR m.wbi=9 to 2 step -1                        && so we may need to adjust parameters.
  50.         thisp = "wbcpP" + ltrim(str(m.wbi))            && In any case, we now use ASELOBJ() to determine selected object(s).
  51.         prevp = "wbcpP" + ltrim(str(m.wbi-1))
  52.         &thisp = &prevp
  53.     ENDFOR
  54.     wbcpP1 = wbcpOptions
  55.     wbcpOptions = wbcpName
  56.     wbcpName = wbcpClass
  57.     wbcpClass = wbcpOrigin
  58.     wbcpOrigin = wbopCtrl
  59. ENDIF
  60.  
  61.  
  62. * Check for 5.0 or later
  63. IF  VAL(SUBSTR(VERSION(),ATC("FOXPRO",VERSION())+7)) < 5
  64.         =MESSAGEBOX(C_VERS5_LOC)
  65. #if !C_DEBUG
  66.         RETURN
  67. #endif
  68. ENDIF
  69.  
  70.  
  71. PUBLIC wbaControl[1], wbaContainer[1]
  72. m.wbSelNum       = ASELOBJ(wbaSelObj)
  73. m.wbContainer = ASELOBJ(wbaContainer, 1)
  74.  
  75. IF m.wbSelNum = 0 AND m.wbContainer >0 AND wbaContainer[1].class = "Page"
  76.     =MessageBox(C_WRONGCLASS_LOC,ERRORTITLE_LOC)
  77.     RELEASE wbaControl,wbaContainer
  78.     RETURN
  79. ENDIF
  80.  
  81. IF TYPE("m.wbcpOrigin")=="C" AND UPPER(m.wbcpOrigin)=="QFORM" AND ;
  82.         NOT LOWER(m.wbaContainer[1].BaseClass)=="form"
  83.     MESSAGEBOX(C_NOFORM_LOC,ERRORTITLE_LOC)
  84.     RELEASE wbaControl,wbaContainer
  85.     RETURN
  86. ENDIF
  87.  
  88. IF TYPE("wbopCtrl") <> "O"                        && no object was passed in...use selected object(s),
  89.     IF TYPE("wbaSelObj[1]") = "O"                && or container object, or _SCREEN
  90.         DIMENSION wbaControl[m.wbSelNum]
  91.         = ACOPY(wbaSelObj, wbaControl)
  92.     ELSE
  93.         IF TYPE("wbaContainer[1]") = "O"
  94.             wbaControl[1] = wbaContainer[1]
  95.         ELSE
  96.             wbaControl[1] = _SCREEN
  97.         ENDIF
  98.     ENDIF
  99. ELSE                                            && object was passed in (usual case)
  100.  
  101.     m.lUseParameter = .t.
  102.     IF TYPE("wbaSelObj[1]") = "O"                    && we have a selected object
  103.         IF UPPER(m.wbcpOrigin) = "AUTOFORMAT"            && we want autoformat button to go against all selected
  104.             m.lSelObjInList = .t.                        && objects - currently, the product passes in a ref to the form
  105.         ELSE
  106.             m.lSelObjInList = .f.
  107.             FOR m.wbi = 1 TO m.wbSelNum
  108.                 IF COMPOBJ(wbaSelObj[m.wbi], wbopCtrl)
  109.                     m.lSelObjInList = .t.
  110.                     EXIT
  111.                 ENDIF
  112.             ENDFOR
  113.         ENDIF
  114.         IF m.lSelObjInList
  115.             DIMENSION wbaControl[m.wbSelNum]            && object passed in is among selected object(s) (usual case) -
  116.             = ACOPY(wbaSelObj, wbaControl)                && builder will work against all selected objects
  117.             m.lUseParameter = .f.
  118.         ENDIF
  119.     ENDIF
  120.     IF m.lUseParameter
  121.         wbaControl[1] = wbopCtrl                    && Otherwise, make the passed-in object the target of the builder.
  122.                                                     && If selected control and container are the same object, then
  123.                                                     && container is in edit mode and prop sheet will crash on return.
  124.                                                     && This condition is trapped for in CheckBuilderSupport() in
  125.                                                     && BuilderTemplate, called from Load of each builder.
  126.         
  127.         IF TYPE("m.wbcpOrigin")=="C" AND TYPE("wbopCtrl.PARENT") = "O" AND ;
  128.                 NOT COMPOBJ(wbaControl[1],wbaContainer[1])
  129.             wbaContainer[1] = wbopCtrl.PARENT
  130.         ENDIF
  131.     ENDIF
  132. ENDIF
  133.  
  134. IF TYPE("wbaControl[1]") <> "O"                        && Some object reference is required, stored in wbaControl. Release
  135.     DO wbSetTalk
  136.     RETURN                                            && others.
  137. ENDIF
  138. IF TYPE("wbaSelObj[1]") = "O"
  139.     RELEASE wbaSelObj
  140. ENDIF
  141. IF TYPE("wbopctrl") = "O"
  142.     RELEASE wbopctrl
  143. ENDIF
  144.  
  145. wboForm = ""
  146. IF TYPE("wbaContainer[1]") = "O"
  147.     wboForm = wbaContainer[1]
  148.     DO WHILE TYPE("wboForm.Parent") = "O"
  149.         IF LOWER(wboForm.Baseclass) = "form"
  150.             EXIT
  151.         ENDIF
  152.         wboForm = wboForm.Parent
  153.     ENDDO
  154. ENDIF
  155.  
  156. toObject=wbaControl[1]
  157. tuSource=wbcpOrigin
  158.  
  159. *--    Check for object containing a Builder property.
  160. *    A Builder property will automatically execute a specific builder.
  161. lcBuilder=""
  162. IF NOT ISNULL(tcRunBuilder)
  163.  
  164. *-- Check for specified tcRunBuilder.
  165.     IF TYPE("tcRunBuilder")=="C" AND NOT EMPTY(tcRunBuilder)
  166.         lcBuilder=tcRunBuilder
  167.         RETURN DoBuilder(toObject,tuSource,lcBuilder,.T.)
  168.     ENDIF
  169.  
  170. *-- Check for specified BuilderX property.
  171.     IF TYPE("toObject.BuilderX")=="C" AND NOT EMPTY(toObject.BuilderX)
  172.         lcBuilder=toObject.BuilderX
  173.         RETURN DoBuilder(toObject,tuSource,lcBuilder)
  174.     ENDIF
  175.  
  176. *-- Check for specified Builder property.
  177.     IF TYPE("toObject.Builder")=="C" AND NOT EMPTY(toObject.Builder)
  178.         lcBuilder=toObject.Builder
  179.         RETURN DoBuilder(toObject,tuSource,lcBuilder)
  180.     ENDIF
  181.  
  182. ENDIF
  183.  
  184. IF NOT ISNULL(lcBuilder) AND NOT EMPTY(lcBuilder) AND NOT FILE(lcBuilder)
  185.     lcBuilder2=LOWER(FULLPATH(JUSTFNAME(lcBuilder),HOME()))
  186.     IF NOT FILE(lcBuilder2)
  187.         =FileNotFoundMsg(lcBuilder)
  188.         RETURN .F.
  189.     ENDIF
  190.     lcBuilder=lcBuilder2
  191. ENDIF
  192. IF TYPE("tuSource")#"C"
  193.     tuSource=""
  194. ENDIF
  195.  
  196. IF ALEN(wbaControl) = 1    AND TYPE("wbaControl[1].Builder")=="C" AND NOT EMPTY(wbaControl[1].Builder)
  197.     lcBuilder=wbaControl[1].Builder
  198.     DoBuilder(wbaControl[1],tuSource,lcBuilder)
  199.     RETURN
  200. ENDIF
  201. toObject=.NULL.
  202.  
  203. m.WBRow = 0
  204. m.WBCol = 0
  205. IF EMPTY(m.wbcpOrigin)
  206.     m.wbcpOrigin = "PSHEET"
  207. ENDIF
  208. IF m.wbcpOrigin = "RTMOUSE"
  209.     m.WBRow = MROW(WONTOP())    && * (FONTMETRIC(4) + FONTMETRIC(1))
  210.     m.WBCol = MCOL(WONTOP())     && * FONTMETRIC(7)
  211. ENDIF
  212.  
  213. IF NOT "WBMAIN" $ SET("PROCEDURE")
  214.     SET PROCEDURE TO WBMAIN.FXP ADDITIVE                && main wizard/builder class library
  215. ENDIF
  216.  
  217. m.wbReturnValue = ""                        && return value from BUILDER.APP
  218. m.wblError = .f.
  219. m.wbcAlertTitle = ""
  220. m.Debug = .t.
  221.  
  222. m.wboObject = CREATEOBJ("builder")                && create builder object - class definition below
  223.  
  224. WITH wboObject
  225.     .wbOptParms = m.wbOptionalParms
  226.     IF UPPER(wbaControl[1].Name) <> "SCREEN"
  227.         .wbcClass = wbaControl[1].Class
  228.         .wbcBaseClass = wbaControl[1].BaseClass
  229.     ENDIF
  230.     .wbcNamedClass = IIF(TYPE("m.wbcpClass") = "C", m.wbcpClass, "")
  231.  
  232.  
  233.     IF UPPER(m.wbcpOrigin) = "AUTOFORMAT"
  234.         .wbcClass = "AUTOFORMAT"
  235.     ELSE
  236.         IF ALEN(wbaControl) > 1
  237.             .wbcClass = "MULTISELECT"
  238.         ENDIF
  239.     ENDIF
  240. ENDWITH
  241. * ---------------------------------------------
  242. * DEBUG - when timing builder, make it modeless
  243. IF _TIMING OR C_DEBUG
  244.     IF TYPE("wbcpOptions") <> "C"
  245.         wbcpOptions = ""
  246.     ENDIF
  247.     IF NOT " SNOQUALMIE::FLEW " $ " " + UPPER(ALLTRIM(wbcpOptions)) + " "
  248.         wbcpOptions = wbcpOptions + " SNOQUALMIE::FLEW "
  249.     ENDIF
  250. ENDIF
  251. * ---------------------------------------------
  252. WITH wboObject
  253.     .wblModal = .t.
  254.     IF TYPE("wbcpOptions") = "C"
  255.         IF  (" SNOQUALMIE::FLEW " $ " " + UPPER(m.wbcpOptions) + " ")
  256.             .wblModal = .f.
  257.         ENDIF
  258.     ENDIF
  259.     * Testing will pass in "SNOQUALMIE::FLEW" as parameter 4
  260.  
  261.     .WBSaveEnvironment
  262.     .WBSetProps
  263.     .WBCheckparms
  264.     .WBCheckErrors
  265.     IF m.wblError
  266.         RETURN 
  267.     ENDIF
  268.     .WBSetTools
  269.     .WBSetPlatform
  270.  
  271.     .WBGetRegTable
  272. ENDWITH
  273.  
  274. m.wblHavePropSheet = WEXIST("PROPERTIES")
  275.  
  276. IF NOT EMPTY(wboObject.wbcRegTable)
  277.     wboObject.WBGetName
  278.     IF NOT EMPTY(wboObject.wbcName)
  279.         IF m.wblHavePropSheet
  280.             cTopWindow = WONTOP()            && remember top window
  281.             HIDE WINDOW PROPERTIES
  282.         ENDIF
  283.  
  284.         wboObject.WBCall                    && call specific builder
  285.         
  286.         * -----
  287.         * DEBUG
  288.         IF _TIMING
  289.             ? SECONDS() - STARTTIME
  290.         ENDIF
  291.         IF _TIMING AND _TIMECODE = 0
  292.             DO LOGTIMES
  293.         ENDIF
  294.         * -----
  295.  
  296.         IF m.wblHavePropSheet AND wboObject.wblModal
  297.             SHOW WINDOW PROPERTIES
  298.             SHOW WINDOW "&cTopWindow"        && make sure the window is on top of properties window, if "always on top"
  299.                                             && is not checked
  300.         ENDIF
  301.     ENDIF
  302. ENDIF
  303.  
  304. m.wbReturnValue = wboObject.wbReturnValue
  305. IF wboObject.wblModal
  306.     wboObject.WBSetEnvironment                    && reset environment if modal, else we're in automated test
  307.     RELEASE wboObject, wbaControl, wbaContainer
  308.  
  309.     IF NOT EMPTY(m.wbStartingProc)
  310.         SET PROCEDURE TO &wbStartingProc
  311.     ELSE
  312.         SET PROCEDURE TO
  313.     ENDIF
  314. ENDIF
  315.  
  316. *------
  317. * DEBUG 
  318. IF _TIMING AND _TIMECODE = 1
  319.     DO LOGTIMES
  320. ENDIF
  321. *------
  322.  
  323. DO wbSetTalk
  324.  
  325. RETURN m.wbReturnValue
  326.  
  327.  
  328. PROCEDURE wbSetTalk
  329.  
  330. IF m.wbTalk = "ON"
  331.     SET TALK ON
  332. ENDIF
  333.  
  334. RETURN
  335.  
  336.  
  337. PROCEDURE LOGTIMES
  338.     =fclose(fp)
  339.  
  340.     sele 0
  341.     crea tabl tim (prog c(80),line c(4),sec n(10,4),diff n(10,4))
  342.     appe from log.txt sdf
  343.     if !eof()
  344.  
  345.         locate
  346.         m=sec
  347.         repl all sec with sec-m
  348.         locate
  349.         m=sec
  350.         skip
  351.         scan rest
  352.             repl diff with sec-m
  353.             m=sec
  354.         endscan
  355.         inde on -diff tag t
  356.         brow nowait field prog,line,diff
  357.     ENDIF
  358.  
  359. RETURN
  360.  
  361.  
  362. DEFINE CLASS Builder AS WizBldr        && WizBldr class is defined in the WB.PRG library
  363. * ---------------------------------------------------------------------------------------
  364.  
  365.     m.wbcType = "BUILDER"                    && do not localize
  366.     m.wbcTypeDisplay = C_BUILDER_LOC        && this line is localizable, defined at top of this file
  367.  
  368. ENDDEFINE
  369.  
  370.  
  371.  
  372. PROC LENC(dummy)
  373. RETURN LEN(m.dummy)
  374.  
  375. PROC SUBSTRC(dummy1,dummy2,dummy3)
  376. RETURN SUBSTR(m.dummy1,m.dummy2,m.dummy3)
  377.  
  378. PROC IsLeadByte(dummy)
  379. RETURN .f.
  380.  
  381.  
  382.  
  383. FUNCTION DoBuilder(toObject,tuSource,tcBuilder,tlSkipSearch)
  384. LOCAL lcBuilder,lnAtPos,lcClass,lcLastOnError,lnLastMemoWidth
  385. LOCAL laInstance[1]
  386.  
  387. lnLastMemoWidth=SET("MEMOWIDTH")
  388. SET MEMOWIDTH TO 1024
  389. lcBuilder=ALLTRIM(MLINE(tcBuilder,1))
  390. lnAtPos=AT(",",lcBuilder)
  391. IF lnAtPos=0
  392.     lcClass=""
  393. ELSE
  394.     lcClass=LOWER(ALLTRIM(SUBSTR(lcBuilder,lnAtPos+1)))
  395.     lcBuilder=LOWER(ALLTRIM(MLINE(LEFT(lcBuilder,lnAtPos-1),1)))
  396.     IF EMPTY(lcBuilder)
  397.         lcBuilder=toObject.ClassLibrary
  398.     ENDIF
  399.     IF EMPTY(JUSTEXT(lcBuilder))
  400.         lcBuilder=FORCEEXT(lcBuilder,"vcx")
  401.     ENDIF
  402. ENDIF
  403. SET MEMOWIDTH TO (lnLastMemoWidth)
  404.  
  405. IF lcBuilder=="?"
  406. *--    Execute dialog to select builder program.
  407.     lcBuilder=GETFILE("prg;scx;app","Select Builder program:","Open")
  408.     IF EMPTY(lcBuilder)
  409.         RETURN
  410.     ENDIF
  411. ENDIF
  412.  
  413. IF lcBuilder=="*"
  414. *--    Create public reference o and activate the Command window.
  415.     RELEASE o
  416.     PUBLIC o
  417.     o=toObject
  418.     WAIT WINDOW LEFT("Name:  "+toObject.Name+SPACE(10)+CHR(13)+ ;
  419.             "Type: "+tuSource+SPACE(10)+CHR(13)+ ;
  420.             "Class:  "+toObject.Class+SPACE(10)+CHR(13)+ ;
  421.             "ParentClass:  "+toObject.ParentClass+SPACE(10)+CHR(13)+ ;
  422.             "Base Class:  "+toObject.BaseClass+SPACE(10)+CHR(13)+ ;
  423.             "Reference:  o"+SPACE(10),254) NOWAIT
  424.     ACTIVATE WINDOW Command
  425.     RETURN
  426. ENDIF
  427.  
  428. *--    Execute builder specified in _BuilderX memvar.
  429. IF EMPTY(JUSTEXT(lcBuilder))
  430.     lcBuilder=FORCEEXT(lcBuilder,"prg")
  431. ENDIF
  432. IF (NOT EMPTY(lcBuilder) OR EMPTY(lcClass)) AND NOT FILE(lcBuilder)
  433.     IF NOT "\"$lcBuilder
  434.         lcBuilder=FULLPATH(JUSTFNAME(lcBuilder),toObject.ClassLibrary)
  435.     ENDIF
  436.     IF NOT FILE(lcBuilder)
  437.         lcBuilder2=LOWER(FULLPATH(JUSTFNAME(lcBuilder),HOME()))
  438.         IF NOT FILE(lcBuilder2)
  439.             =FileNotFoundMsg(lcBuilder)
  440.             RETURN .F.
  441.         ENDIF
  442.         lcBuilder=lcBuilder2
  443.     ENDIF
  444. ENDIF
  445. DO CASE
  446.     CASE NOT EMPTY(lcClass)
  447.         IF TYPE("_BuilderEdit")=="L" AND _BuilderEdit
  448.             _BuilderEdit=.F.
  449.             IF AINSTANCE(laInstance,lcClass)>0
  450.                 WAIT WINDOW [Class "]+lcClass+[" is in use] NOWAIT
  451.                 RETURN
  452.             ENDIF
  453.             MODIFY CLASS (lcClass) OF (lcBuilder) NOWAIT
  454.             RETURN
  455.         ENDIF
  456.         lnCount=0
  457.         DO WHILE .T.
  458.             lnCount=lnCount+1
  459.             lcObjName=PROPER(lcClass+ALLTRIM(STR(lnCount)))
  460.             IF TYPE(lcObjName)=="U"
  461.                 EXIT
  462.             ENDIF
  463.         ENDDO
  464.         DOEVENTS
  465.         WAIT CLEAR
  466.         lcLastOnError=ON("ERROR")
  467.         ON ERROR =.F.
  468.         oNewObject=NEWOBJECT(lcClass,lcBuilder,"",toObject,tuSource,tlSkipSearch)
  469.         IF EMPTY(lcLastOnError)
  470.             ON ERROR
  471.         ELSE
  472.             ON ERROR &lcLastOnError
  473.         ENDIF
  474.         IF TYPE("oNewObject")#"O" OR ISNULL(oNewObject)
  475.             ShowMsg([Class (]+lcClass+ ;
  476.                     [) of "]+LOWER(lcBuilder)+[" could not be instantiated.])
  477.             RETURN .F.
  478.         ENDIF
  479.         PUBLIC (lcObjName)
  480.         lcCode=lcObjname+[=oNewObject]
  481.         &lcCode
  482.         IF oNewObject.lAutoShow
  483.             oNewObject.Show()
  484.         ENDIF
  485.         IF TYPE("oNewObject")#"O" OR ISNULL(oNewObject)
  486.             RETURN .F.
  487.         ENDIF
  488.         IF oNewObject.lAutoRelease
  489.             oNewObject.Release()
  490.             RELEASE (lcObjName)
  491.         ENDIF
  492.         RETURN
  493.     CASE LOWER(RIGHT(lcBuilder,4))==".scx"
  494.         IF TYPE("_BuilderEdit")=="L" AND _BuilderEdit
  495.             _BuilderEdit=.F.
  496.             MODIFY FORM (lcBuilder) NOWAIT
  497.             RETURN
  498.         ENDIF
  499.         DO FORM (lcBuilder) WITH (toObject),(tuSource)
  500.         RETURN
  501.     CASE LOWER(RIGHT(lcBuilder,4))==".vcx"
  502.         RETURN ShowMsg([File "]+LOWER(lcBuilder)+ ;
  503.                 [" requires class name (ex. TestLib,TestClass).])
  504.     CASE LOWER(RIGHT(lcBuilder,4))==".prg"
  505.         IF TYPE("_BuilderEdit")=="L" AND _BuilderEdit
  506.             _BuilderEdit=.F.
  507.             MODIFY COMM (lcBuilder) NOWAIT
  508.             RETURN
  509.         ENDIF
  510.         DO (lcBuilder) WITH (toObject),(tuSource)
  511.         RETURN
  512. ENDCASE
  513. IF TYPE("tuSource")#"C"
  514.     tuSource=""
  515. ENDIF
  516. DO (lcBuilder) WITH (toObject),(tuSource)
  517. RETURN
  518.  
  519.  
  520.  
  521. FUNCTION ShowMsg
  522. LPARAMETERS tcMessage
  523. LOCAL lnResult
  524.  
  525. lnResult=MESSAGEBOX(tcMessage,48,"Builder")
  526. WAIT CLEAR
  527. RETURN lnResult
  528.  
  529.  
  530.  
  531. FUNCTION FileNotFoundMsg
  532. LPARAMETERS tcFileName
  533.  
  534. RETURN ShowMsg([File "]+LOWER(tcFileName)+[" not found.])
  535.