home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Super Store 2.3 / TESTDRIVE_2.ISO / realizer / formdev / generate.rlz < prev    next >
Encoding:
Text File  |  1992-09-30  |  11.8 KB  |  455 lines
  1. '***********************************************************************
  2. '    FormDev: Generate.RLZ
  3. '
  4. '    Copyright ⌐ 1991-1992 Computer Associates International, Inc.
  5. '    All rights reserved.
  6. '
  7. '***********************************************************************
  8.  
  9. FUNC FDLogStr (logNum)
  10. '
  11. '    FAST append string s to Log #logNum.
  12. '
  13. 'WARNING: Use this routine only if you're sure the carriage returns and linefeeds
  14. 'are all OK.  If you are sure, this routine is a LOT FASTER than:
  15. '    PRINT #logNum; s
  16. 'since the PRINT statement guarantees proper carriage return handling.
  17.  
  18.     LOCAL    oldLen, hwt
  19.     LOCAL    WM_USER, EM_SETSEL, EM_REPLACESEL
  20.  
  21.     EXTERNAL "User" PROC SendMessage (word, word, word, pointer)
  22.     WM_USER = 1024
  23.     EM_SETSEL = (WM_USER + 1)
  24.     EM_REPLACESEL = (WM_USER + 18)
  25.  
  26.     oldLen = LogQSize
  27.     hwt = LogQ(_Hwnd)
  28.     SendMessage(hwt, EM_SETSEL, 0, Pointer(32767*2^16 + 32767))
  29.     SendMessage(hwt, EM_REPLACESEL, 0, fdOutStr)
  30.     IF oldLen + Len(fdOutStr) <> LogQSize THEN
  31.         INPUT "Error writing generated code to Log.", "FormDev";
  32.         RETURN 0
  33.     END IF
  34.     fdOutStr = ""
  35.     RETURN 1
  36. END FUNC
  37.  
  38.  
  39. PROC FDOut (s)
  40.     fdOutStr = fdOutStr + s + CRLF
  41. END PROC
  42.  
  43.  
  44. FUNC GenstrModifiers(n)
  45.     LOCAL m1, m2, s
  46.  
  47.     SELECT CASE item.type[n]
  48.         CASE _OptionButton, _CheckBox
  49.             s = IF bitand(item.modval1[n], 2) THEN "_Notify, " ELSE ""
  50.             RETURN sprint("; &P(0), P(0)", s, item.modval1[n] mod 2, item.modval1[n] \ 4)
  51.         CASE _EditText
  52.             IF item.modval1[n] = 0 THEN
  53.                 RETURN ""
  54.             END IF
  55.             s = ""
  56.             IF bitand(item.modval1[n], 1) THEN
  57.                 s = s + " + _NoBorder"
  58.             END IF
  59.             IF bitand(item.modval1[n], 2) THEN
  60.                 s = s + " + _MultiLine"
  61.             END IF
  62.             IF bitand(item.modval1[n], 4) THEN
  63.                 s = s + " + _Notify"
  64.             END IF
  65.             RETURN "; " + Mid$(s, 3)
  66.         CASE _Chart
  67.             IF item.modval1[n] THEN
  68.                 RETURN sprint("; P(0)", item.modval1[n])
  69.             ELSE
  70.                 RETURN ""
  71.             END IF
  72.         CASE _ListBox, _ComboBox, _DropDownList, _DropDownCombo
  73.             SELECT CASE item.modval1[n] mod 4
  74.                 CASE 0
  75.                     m1 = ""
  76.                 CASE 1
  77.                     m1 = "_Sorted"
  78.                 CASE 2
  79.                     m1 = "_Notify"
  80.                 CASE 3
  81.                     m1 = "_Sorted + _Notify"
  82.             END SELECT
  83.             SELECT CASE item.modval1[n] \ 4
  84.                 CASE _ListFiles
  85.                     m2 = ""
  86.                     IF bitand(item.modval2[n], 2) THEN
  87.                         m2 = m2 + " + _NoFiles"
  88.                     END IF
  89.                     IF bitand(item.modval2[n], 4) THEN
  90.                         m2 = m2 + " + _Drives"
  91.                     END IF
  92.                     IF bitand(item.modval2[n], 8) THEN
  93.                         m2 = m2 + " + _SubDirs"
  94.                     END IF
  95.                     IF m2 = "" THEN
  96.                         m2 = "_NormFiles"
  97.                     ELSE
  98.                         m2 = Mid$(m2, 3)
  99.                     END IF
  100.                     m2 = "_ListFiles, " + m2 + ", ""*.*"""
  101.                 CASE _ListVars
  102.                     m2 = ""
  103.                     IF bitand(item.modval2[n], _Real) THEN
  104.                         m2 = m2 + " + _Real"
  105.                     END IF
  106.                     IF bitand(item.modval2[n], _Alpha) THEN
  107.                         m2 = m2 + " + _Alpha"
  108.                     END IF
  109.                     IF bitand(item.modval2[n], _DateTime) THEN
  110.                         m2 = m2 + " + _DateTime"
  111.                     END IF
  112.                     IF bitand(item.modval2[n], _Array) THEN
  113.                         m2 = m2 + " + _Array"
  114.                     END IF
  115.                     IF bitand(item.modval2[n], _Scalar) THEN
  116.                         m2 = m2 + " + _Scalar"
  117.                     END IF
  118.                     IF m2 = "" THEN
  119.                         m2 = "0"
  120.                     ELSE
  121.                         m2 = Mid$(m2, 3)
  122.                     END IF
  123.                     m2 = "_ListVars, " + m2
  124.                 CASE _ListFams
  125.                     m2 = "_ListFams"
  126.                 CASE _ListFonts
  127.                     m2 = "_ListFonts"
  128.                 CASE _ListFontSizes
  129.                     m2 = "_ListFontSizes, """ + item.modstr[n] + """"
  130.                 CASE 15
  131.                     m2 = item.modstr[n]
  132.             END SELECT
  133.             IF m1 = "" AND m2 = "" THEN
  134.                 RETURN ""
  135.             ELSEIF m1 = "" THEN
  136.                 RETURN "; " + m2
  137.             ELSEIF m2 = "" THEN
  138.                 RETURN "; " + m1
  139.             ELSE
  140.                 RETURN "; "+ m1 + ", " + m2
  141.             END IF
  142.         CASE ELSE
  143.             RETURN ""
  144.     END SELECT
  145. END FUNC
  146.  
  147. FUNC GenstrStyle(style)
  148.     LOCAL s
  149.  
  150.     IF style = 0 THEN
  151.         RETURN ""
  152.     END IF
  153.     s = "X"
  154.     s = s + IF bitand(style, _Close) THEN " + _Close" ELSE ""
  155.     s = s + IF bitand(style, _Frame) THEN " + _Frame" ELSE ""
  156.     s = s + IF bitand(style, _Size) THEN " + _Size" ELSE ""
  157.     s = s + IF bitand(style, _Title) THEN " + _Title" ELSE ""
  158.     s = s + IF bitand(style, _Minimize) THEN " + _Minimize" ELSE ""
  159.     s = s + IF bitand(style, _ContextEnter) THEN " + _ContextEnter" ELSE ""
  160.     s = s + IF bitand(style, _HotClick) THEN " + _HotClick" ELSE ""
  161.     RETURN SubStr$(s, "X +", ",")
  162. END FUNC
  163.  
  164. FUNC GenstrFontstyle(style)
  165.     LOCAL s, n
  166.  
  167.     n = StrToNum(style)
  168.     s = IF bitand(n, _Bold) THEN " + _Bold" ELSE ""
  169.     s = s + IF bitand(n, _Italics) THEN " + _Italics" ELSE ""
  170.     s = s + IF bitand(n, _Underline) THEN " + _Underline" ELSE ""
  171.     s = s + IF bitand(n, _Strikeout) THEN " + _Strikeout" ELSE ""
  172.     IF s = "" THEN
  173.         RETURN ""
  174.     ELSE
  175.         RETURN ", " + Mid$(s, 4)
  176.     END IF
  177. END FUNC
  178.  
  179. FUNC GenstrSV(specval, rawval, fmtstr, unitstr)
  180.     IF specval THEN
  181.         SELECT CASE specval
  182.             CASE _Left
  183.                 RETURN "_Left"
  184.             CASE _Right
  185.                 RETURN "_Right"
  186.             CASE _Top
  187.                 RETURN "_Top"
  188.             CASE _Bottom
  189.                 RETURN "_Bottom"
  190.             CASE _Center
  191.                 RETURN "_Center"
  192.             CASE _Default
  193.                 RETURN "_Default"
  194.         END SELECT
  195.     ELSE
  196.         RETURN sprint(fmtstr + " &", rawval, unitstr)
  197.     END IF
  198. END FUNC    
  199.  
  200. PROC GenerateFontNew(tabs)
  201.     LOCAL i, s
  202.  
  203.     IF Sum(fonts.refs) = 0 THEN
  204.         EXIT PROC
  205.     END IF
  206.     FDOut(tabs + "'Define the fonts")
  207.     s = "LOCAL "
  208.     FOR i = 2 to EndValid(fonts.name)
  209.         IF fonts.name[i] <> "" THEN
  210.             s = s + Sprint("fontP(0), ", i)
  211.         END IF
  212.     NEXT i
  213.     FDOut(tabs + Left$(s, Len(s) - 2))
  214.     FOR i = 2 to EndValid(fonts.name)
  215.         IF fonts.name[i] <> "" THEN
  216.             FDOut(tabs + sprint("fontP(0) = FontQUnique", i))
  217.             FDOut(tabs + sprint("FontNew(fontP(0); ""&"", &&)", i, fonts.name[i], fonts.size[i], GenstrFontstyle(fonts.style[i])))
  218.         END IF
  219.     NEXT i
  220.     FDOut("")
  221. END PROC
  222.     
  223. PROC GenerateFontClose(tabs)
  224.     LOCAL i
  225.  
  226.     IF Sum(fonts.refs) = 0 THEN
  227.         EXIT PROC
  228.     END IF
  229.     FDOut("" + CRLF + "'Close the fonts")
  230.     FOR i = 2 to EndValid(fonts.name)
  231.         IF fonts.name[i] <> "" THEN
  232.             FDOut(tabs + sprint("FontSelect(fontP(0))", i))
  233.             FDOut(tabs + "FontControl(_Close)")
  234.         END IF
  235.     NEXT i
  236. END PROC
  237.  
  238.  
  239. PROC GenerateCCLibRun
  240.     ' DigitalClock?
  241.     FOR i = 1 TO fdNumItems
  242.         IF item.type[i] < 0 THEN
  243.             FDOut("RUN ""CCLib1""" + CRLF)
  244.             EXIT PROC
  245.         END IF
  246.     NEXT
  247. END PROC
  248.  
  249.  
  250. PROC GenerateHeader(saveflags)
  251.     LOCAL list, i
  252.  
  253.     FDOut("'****************************************")
  254.     FDOut("'**      FormName: " + theform.name)
  255.     FDOut("'****************************************")
  256.     FDOut("")
  257.  
  258.     GenerateCCLibRun
  259.  
  260.     IF NOT(bitand(saveflags, 16)) THEN
  261.         FDOut("IF QVar(%%flag" + theform.name + ", _Defined) THEN")
  262.         FDOut("    EXIT MACRO")
  263.         FDOut("END IF")
  264.         FDOut("%%flag" + theform.name + " = 1")
  265.         FDOut("")
  266.     END IF
  267.  
  268.     IF theform.bitmapdir <> "" THEN
  269.         FDOut("SetSys(_LoadDir, QSys(_LoadDir) + "";"" + """ + theform.bitmapdir + """)")
  270.         FDOut("")
  271.     END IF
  272.  
  273.     ListOfLinks(theform.init, list)
  274.     FOR i = 1 to fdNumItems
  275.         IF item.code[i] <> "" THEN
  276.             ListOfLinks(item.code[i], list)
  277.         END IF
  278.     NEXT i    
  279.     IF EndValid(list) THEN
  280.         IF theform.linkdir <> "" THEN
  281.             FDOut("SetSys(_MacroDir, QSys(_MacroDir) + "";"" + """ + theform.linkdir + """)")
  282.         END IF
  283.         FOR i = 1 to EndValid(list)
  284.             FDOut("RUN """ + list[i] + """")
  285.         NEXT i
  286.         FDOut("")
  287.     END IF    
  288. END PROC
  289.  
  290. FUNC GenColor(cPacked, asWhich)
  291.     LOCAL c
  292.  
  293.     c = ColorUnpack(cPacked)
  294.     IF QVar(c, _Scalar) THEN
  295.         RETURN Sprint("FormSetColor(__&; &)", ColorNames[c], asWhich)
  296.     ELSE
  297.         RETURN Sprint("FormSetColor(P(-3), P(-3), P(-3); &)", c[1], c[2], c[3], asWhich)
  298.     END IF
  299. END FUNC
  300.  
  301.  
  302. PROC GenerateMakeform(fGen)
  303.     LOCAL s, fs, fmt, i, tab
  304.     LOCAL fontstr, leftstr, topstr, widthstr, heightstr, modstr, textstr, typestr
  305.     LOCAL fieldcolorlast, textcolorlast
  306.  
  307.     tab = IF fGen THEN "    " ELSE ""
  308.     IF fGen THEN
  309.         FDOut("PROC Make"+ theform.name)
  310.     ELSE
  311.         IF theform.bitmapdir <> "" THEN
  312.             FDOut("SetSys(_LoadDir, QSys(_LoadDir) + "";"" + """ + theform.bitmapdir + """)")
  313.             FDOut("")
  314.         END IF
  315.     END IF
  316.     GenerateFontNew(tab)
  317.     FDOut(tab + "form" + theform.name + " = FormQUnique")
  318.     FDOut(SPRINT(tab + "FormNew(form" + theform.name + "; ""&""&)", theform.title, GenstrStyle(theform.style)))
  319.     IF QVar(theform.bgcolor, _Array) THEN
  320.         FDOut(tab + GenColor(ColorPack(theform.bgcolor), "_Background"))
  321.     ELSE
  322.         IF theform.bgcolor <> _White THEN
  323.             FDOut(tab + GenColor(ColorPack(theform.bgcolor), "_Background"))
  324.          END IF
  325.     END IF
  326.     fs = UnitFormatStr(theform.units)
  327.     fmt = Sprint("FormControl(____Size; & _&, & _&, & _&, & _&)", fs, fs, fs, fs)
  328.     s = UnitShortStr(theform.units)
  329.     FDOut(SPRINT(tab + fmt, theform.rawleft, s, theform.rawtop, s, theform.rawwidth, s, theform.rawheight, s))
  330.     FormSelect(fdMain)
  331.     ItemsLocateAll
  332.     ItemsIntoRaw
  333.     IF theform.itemunits = 1 THEN
  334.         s = UnitShortStr(theform.units)
  335.         fs = UnitFormatStr(theform.units)
  336.     ELSE
  337.         s = UnitShortStr(2)        'percent
  338.         fs = UnitFormatStr(2)
  339.     END IF
  340.     textcolorlast = ColorPack(_Black)
  341.     fieldcolorlast = ColorPack(_White)
  342.     FOR i = 1 TO fdNumItems
  343.         IF item.textcolor[i] <> textcolorlast THEN
  344.             FDOut(tab + GenColor(item.textcolor[i], "_Text"))
  345.             textcolorlast = item.textcolor[i]
  346.         END IF
  347.         IF item.fieldcolor[i] <> fieldcolorlast THEN
  348.             FDOut(tab + GenColor(item.fieldcolor[i], "_Field"))
  349.             fieldcolorlast = item.fieldcolor[i]
  350.         END IF
  351.         textstr = item.text[i]
  352.         textstr = IF Left$(textstr, 1) = "=" THEN Right$(textstr, Len(textstr) - 1) ELSE """" + textstr + """"
  353.         fontstr = IF item.font[i] THEN sprint("fontP(0), ", item.font[i]) else ""
  354.         leftstr = GenstrSV(item.leftsv[i], item.left[i], fs, s)
  355.         topstr = GenstrSV(item.topsv[i], item.top[i], fs, s)
  356.         widthstr = GenstrSV(item.widthsv[i], item.width[i], fs, s)
  357.         heightstr = GenstrSV(item.heightsv[i], item.height[i], fs, s)
  358.         modstr = GenstrModifiers(i)
  359.         typestr = ItemNames[FirstMatch(ItemNums, item.type[i])]
  360.         FDOut(SPRINT(tab + "FormSetObject(P(0), __&, &, &&, &, &, &&)", ItemID(i), typestr, textstr, fontstr, leftstr, topstr, widthstr, heightstr, modstr))
  361.     NEXT i
  362.     IF textcolorlast <> ColorPack(_Black) THEN
  363.         FDOut(tab + "FormSetColor(_Black; _Text)")
  364.     END IF
  365.     IF fieldcolorlast <> ColorPack(_White) THEN
  366.         FDOut(tab + "FormSetColor(_White; _Field)")
  367.     END IF
  368.     IF theform.type = 50 AND fGen THEN
  369.         FDOut("    FormSetProc(formproc" + theform.name + ")")
  370.     END IF
  371.     GenerateFontClose(tab)
  372.     ItemsIntoPixels
  373.     IF theform.init <> "" THEN
  374.         FDOut(CRLF + tab + "' Initialize the form" + CRLF + SubLinks(theform.init, tab))
  375.     END IF
  376.     IF fGen THEN
  377.         FDOut("END PROC")
  378.     END IF
  379.     FDOut("")
  380. END PROC
  381.  
  382. PROC GenerateSelect(tab, caseWhat)
  383.     LOCAL i
  384.  
  385.     FDOut(tab + "SELECT CASE " + caseWhat)
  386.     FOR i = 1 TO fdNumItems
  387.         IF item.code[i] <> "" THEN
  388.             FDOut(tab + "CASE " + NumToStr(ItemID(i)) + "        '" + item.text[i])
  389.             FDOut(SubLinks(item.code[i], tab + "    "))
  390.         END IF
  391.     NEXT i
  392.     FDOut(tab + "END SELECT")
  393. END PROC
  394.  
  395. FUNC GenerateFormloop
  396.     FDOut("FUNC Modal" + theform.name)
  397.     FDOut("    FormSelect(form" + theform.name + ")")
  398.     FDOut("    LOOP")
  399.     GenerateSelect("        ", "FormWait")
  400.     FDOut("    END LOOP")
  401.     FDOut("    FormSelect(form" + theform.name + ")")
  402.     FDOut("    FormControl(_Close)")
  403.     FDOut("    RETURN 1")
  404.     FDOut("END FUNC")
  405.     RETURN 1
  406. END FUNC
  407.  
  408. FUNC GenerateFormproc
  409.     FDOut("PROC formproc" + theform.name + "(params)")
  410.     FDOut("    FormSelect(form" + theform.name + ")")
  411.     GenerateSelect("    ", "params[_ItemNum]")
  412.     FDOut("END PROC")
  413.     RETURN 1
  414. END FUNC
  415.  
  416. PROC GenerateMain
  417.     FDOut(CRLF + "'Main program" + CRLF)
  418.     IF theform.type = 50 THEN
  419.         FDOut("Make" + theform.name)
  420.         FDOut("FormSelect(form" + theform.name + ")")
  421.         FDOut("FormControl(_Show)")
  422.     ELSE
  423.         FDOut("Make" + theform.name)
  424.         FDOut("dummy = Modal" + theform.name)
  425.     END IF        
  426. END PROC
  427.  
  428. FUNC GenerateCode(fdOutLog, saveflags)
  429.     LOCAL    success, CRLF, fdOutStr
  430.  
  431.     CRLF = CHR$(13) + CHR$(10)
  432.     fdOutStr = ""
  433.     IF bitand(saveflags, 4) THEN
  434.         GenerateCCLibRun
  435.         GenerateMakeform(0)
  436.         FDOut("FormControl(_Show)")
  437.         success = 1
  438.     ELSE
  439.         GenerateHeader(saveflags)
  440.         GenerateMakeform(1)
  441.         IF theform.type = 50 THEN
  442.             success = GenerateFormproc
  443.         ELSE
  444.             success = GenerateFormloop
  445.         END IF
  446.         IF success AND bitand(saveflags, 16) THEN
  447.             GenerateMain
  448.         END IF
  449.     END IF
  450.     IF success THEN
  451.         success = FDLogStr(fdOutLog)
  452.     END IF
  453.     RETURN success
  454. END FUNC
  455.