home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Super Store 2.3 / TESTDRIVE_2.ISO / realizer / formdev / visual.rlz < prev    next >
Encoding:
Text File  |  1992-09-30  |  8.8 KB  |  375 lines
  1. '***********************************************************************
  2. '    FormDev: Visual.RLZ
  3. '
  4. '    Copyright ⌐ 1991-1992 Computer Associates International, Inc.
  5. '    All rights reserved.
  6. '
  7. '***********************************************************************
  8.  
  9. PROC ToolOn (toolNumber)
  10.     LOCAL    oldForm, toolInfo
  11.  
  12.     IF toolNumber <> currentOn THEN
  13.         oldForm = FormQ(_Selected)
  14.         IF currentOn = 10 AND toolNumber > 2 THEN
  15.             fdCurrentBmpFN = ""
  16.             IF QVar(%%browser) THEN
  17.                 FormSelect(%%browser)
  18.                 FormControl(_Hide)
  19.                 UpdateBrowser
  20.             END IF
  21.         END IF
  22.         FormSelect(toolForm)
  23.         IF currentOn THEN
  24.             toolInfo = FormQObject(32000 + currentOn)
  25.             FormModifyObject(32000 + currentOn, _Gray, "",toolInfo[_FQO_Left], 20 in)
  26.             FormModifyObject(31000 + currentOn, _Normal, "",toolInfo[_FQO_Left], toolInfo[_FQO_Top])
  27.         END IF
  28.         IF toolNumber THEN
  29.             toolInfo = FormQObject(31000 + toolNumber)
  30.             FormModifyObject(32000 + toolNumber, _Normal, "", toolInfo[_FQO_Left], toolInfo[_FQO_Top])
  31.             FormModifyObject(31000 + toolNumber, _Gray, "", toolInfo[_FQO_Left], 20 in)
  32.         END IF
  33.         currentOn = toolNumber
  34.         IF oldForm THEN
  35.             FormSelect(oldForm)
  36.         END IF
  37.     END IF
  38. END PROC
  39.  
  40.  
  41. PROC LastFrameOff
  42.     LOCAL    oldForm
  43.  
  44.     IF lastFrameNum THEN
  45.         oldForm = FormQ(_Selected)
  46.         ItemLocate(lastFrameNum)
  47.         SafeSetObject(lastFrameNum, NOT viewForm)
  48.         lastFrameNum = 0
  49.         IF oldForm THEN
  50.             FormSelect(oldForm)
  51.         END IF
  52.     END IF
  53. END PROC
  54.  
  55.  
  56. PROC AISVSetDefaults(n)
  57.     SELECT CASE item.type[n]
  58.         CASE _CaptionLeft, _CaptionCenter, _CaptionRight, _Bitmap, _BitmapButton
  59.             item.heightsv[n] = _Default
  60.             item.widthsv[n] = _Default
  61.         CASE _TextBox
  62.             item.heightsv[n] = _Default
  63.     END SELECT
  64. END PROC
  65.  
  66.  
  67. PROC NewButPrep (itemNum, xCoord, yCoord)
  68.     LOCAL    sz, J, lf, tp, wd, ht
  69.  
  70.     ' Get the default size for the new item in a scratch form.
  71.     sz = FormQ(_Size; fdMain)
  72.     FormNew(FormQUnique; theform.title, theform.style)
  73.     FormControl(_Size; sz[1], sz[2], sz[3], sz[4])
  74.     item.left[itemNum] = xCoord
  75.     item.top[itemNum] = yCoord
  76.     SafeSetObject(itemNum, 2)
  77.     J = item.id[itemNum]
  78.     sz = FormQObject(J)
  79.     lf = sz[_FQO_Left]
  80.     tp = sz[_FQO_Top]
  81.     wd = sz[_FQO_Width]
  82.     ht = sz[_FQO_Height]
  83.     FormSetObject(J, _Frame, "", 0, 0, 100pct, 100pct)
  84.     sz = FormQObject(J)
  85.     SELECT CASE item.type[itemNum]
  86.         CASE _Chart, _Sheet, _Log        ' max out at bottom-right
  87.             wd = MIN(MAX(60, sz[_FQO_Width] - lf), wd)
  88.             ht = MIN(MAX(60, sz[_FQO_Height] - tp), ht)
  89.     END SELECT
  90.     lf = MIN(lf, sz[_FQO_Width] - wd)
  91.     tp = MIN(tp, sz[_FQO_Height] - ht)
  92.     item.left[itemNum] = lf
  93.     item.top[itemNum] = tp
  94.     item.width[itemNum] = wd
  95.     item.height[itemNum] = ht
  96.     FormControl(_Close)
  97.     FormSelect(fdMain)
  98.  
  99.     lastFrameNum = itemNum
  100.     SafeSetObject(itemNum, 1)
  101.     FormModifyObject(item.id[itemNum], _SetFocus)
  102.     MenuEnable
  103.     fdChanged = 1
  104. END PROC
  105.  
  106.  
  107. PROC SetNextItem (bUpdate)
  108.     LOCAL    orig
  109.  
  110.     orig = fdNextItem
  111.     IF fdNextItem > 32764 THEN
  112.         fdNextItem = 10 + 1000 * RND()
  113.     END IF
  114.     WHILE FirstMatch(item.id, fdNextItem)
  115.         fdNextItem = fdNextItem + 10
  116.         IF fdNextItem > 32764 THEN
  117.             fdNextItem = 10 + 1000 * RND()
  118.         END IF
  119.     END WHILE
  120.     IF bUpdate AND orig <> fdNextItem THEN
  121.         UpdateTool
  122.     END IF
  123. END PROC
  124.  
  125.  
  126. PROC FDNewItem (typeDex, ..)
  127.     LOCAL    textStr, modvals, modstrs, itemNum
  128.  
  129.     SetHourglass
  130.     FormSelect(fdMain)
  131.     LastFrameOff
  132.  
  133.     itemNum = ItemNew
  134.     IF QNOptParams() THEN
  135.         textStr = QOptParam(1)
  136.     ELSE
  137.         textStr = ItemNames[typeDex]
  138.     END IF
  139.     IF typeDex <> 11 AND textStr <> "" THEN
  140.         textStr = SPRINT("& P(0)", textStr, ItemID(itemNum))
  141.     END IF
  142.     item.text[itemNum] = textStr
  143.     item.type[itemNum] = ItemNums[typeDex]
  144.     ValidBMP(itemNum)
  145.  
  146.     AISetModvals(itemNum)    ' AFTER item.type is set.
  147.     AIUnsetModvals(itemNum)
  148.     AISVSetDefaults(itemNum)
  149.     NewButPrep(itemNum, xCoord, yCoord)
  150.     SetNextItem(0)
  151.     UpdateTool
  152.  
  153.     ResetHourglass
  154. END PROC
  155.  
  156.  
  157. PROC ToolProc(params)
  158.     LOCAL    currFocus, oldToolOn, itemNum
  159.  
  160.     FormSelect(fdMain)
  161.     currFocus = FormQObject()[_FQO_ItemNum]
  162.     LastFrameOff
  163.  
  164.     IF params[_Invoke] <> _Click THEN
  165.         IF params[_Invoke] = _Close THEN
  166.             ShutdownProc(params)
  167.         END IF
  168.         EXIT PROC
  169.     END IF
  170.  
  171.     SELECT CASE params[_ItemNum]
  172.     CASE 31001, 32001, 31002, 32002    ' Arrow or trashcan
  173.         IF fdNumItems < 1 THEN
  174.             INPUT "No items in the form.", "FormDev";
  175.             EXIT PROC
  176.         END IF
  177.         oldToolOn = currentOn
  178.         ToolOn(params[_ItemNum] MOD 1000)
  179.         ItemsEnableAll
  180.         itemNum = FirstMatch(item.id, FormWait(_PickDrag))
  181.         IF itemNum <> 0 THEN
  182.             IF params[_ItemNum] = 31002 OR params[_ItemNum] = 32002 THEN
  183.                 ItemDelete(itemNum)
  184.                 lastFrameNum = 0
  185.             ELSE
  186.                 ' Selector code.
  187.                 ItemLocate(itemNum)
  188.                 lastFrameNum = itemNum
  189.                 SafeSetObject(itemNum, 1)
  190.                 FormModifyObject(item.id[itemNum], _SetFocus)
  191.                 fdChanged = 1
  192.             END IF
  193.         END IF
  194.         ToolOn(oldToolOn)
  195.  
  196.     CASE 31010
  197.         ToolOn(10)
  198.         ShowBrowser(1)
  199.         EXIT PROC    'avoid the _Show
  200.  
  201.     CASE 32010
  202.         ShowBrowser(1)
  203.         EXIT PROC    'avoid the _Show
  204.  
  205.     CASE 31003 TO 31016                ' Palette button
  206.         ToolOn(params[_ItemNum] - 31000)
  207.  
  208.     CASE 32760                        ' Color button
  209.         SetColor
  210.         UpdateTool
  211.  
  212.     CASE 32761                        ' Font button
  213.         theform.font = FDFontModal(theform.font)
  214.         UpdateTool
  215.  
  216.     CASE 32762                        ' Options button
  217.         ItemsLocateAll
  218.         ItemsEnableAll
  219.         itemNum = 0
  220.         IF currFocus > 0 AND currFocus < 32766 THEN
  221.             IF QVar(item.id) THEN
  222.                 itemNum = FirstMatch(item.id, currFocus)
  223.             END IF
  224.         END IF
  225.         IF itemNum = 0 THEN
  226.             INPUT "Select an item in the form then press Options.", "FormDev";
  227.         ELSE
  228.             SELECT CASE VisOption(itemNum)
  229.                 CASE -2    'Cancel
  230.                     FormModifyObject(currFocus, _SetFocus)
  231.                 CASE -3    'Delete
  232.                 CASE ELSE
  233.                     FormModifyObject(item.id[itemNum], _SetFocus)
  234.             END SELECT
  235.         END IF
  236.     END SELECT
  237.  
  238.     FormSelect(fdMain)
  239.     FormControl(_Show)
  240. END PROC
  241.  
  242.  
  243. PROC UpdateTool
  244.     LOCAL    oldForm, fontvect
  245.  
  246.     oldForm = FormQ(_Selected)
  247.     FormSelect(toolForm)
  248.  
  249.     FormModifyObject(32750, _Gray, SPrint("Next: P(0)", fdNextItem))
  250.  
  251.     FormSetColor(ColorUnpack(theform.txtC); _Text)
  252.     FormSetColor(ColorUnpack(theform.fldC); _Field)
  253.     FormModifyObject(32752, _SetColor)
  254.  
  255.     IF theform.font THEN
  256.         fontvect = {fonts.name[theform.font], fonts.size[theform.font], fonts.style[theform.font]}
  257.     ELSE
  258.         fontvect = {"", "", ""}
  259.     END IF
  260.     FormModifyObject(32753, _Gray, FdFontStr(fontvect))
  261.  
  262.     IF oldForm THEN
  263.         FormSelect(oldForm)
  264.     END IF
  265. END PROC
  266.  
  267.  
  268. PROC MainProc(params)
  269.     LOCAL    xCoord, yCoord, bitmapFN
  270.  
  271.     FormSelect(fdMain)
  272.  
  273.     SELECT CASE params[_Invoke]
  274.     CASE _Close
  275.         ShutdownProc(params)
  276.     CASE _Click
  277.         IF params[_ItemNum] <> 32767 THEN
  278.             EXIT PROC
  279.         END IF
  280.         ' This is a click in "White.BMP"
  281.         xCoord = params[_XPos]
  282.         yCoord = params[_YPos]
  283.         SELECT CASE currentOn
  284.             CASE 3                        ' Textbox
  285.                 FDNewItem(3, "")
  286.             CASE 4                        ' Button
  287.                 FDNewItem(2)
  288.             CASE 5                        ' Group box
  289.                 FDNewItem(6)
  290.             CASE 6                        ' Caption Text
  291.                 FDNewItem(7, "Text")
  292.             CASE 7                        ' Radio button
  293.                 FDNewItem(5)
  294.             CASE 8                        ' Checkbox
  295.                 FDNewItem(4)
  296.             CASE 9                        ' Frame
  297.                 FDNewItem(10)
  298.             CASE 10                        ' Bitmap
  299.                 IF fdCurrentBmpFN = "" THEN
  300.                     INPUT "No bitmap is selected.", "FormDev";
  301.                     ShowBrowser(1)
  302.                 ELSE
  303.                     FDNewItem(11, fdCurrentBmpPath + fdCurrentBmpFN)
  304.                     fdCurrentBmpFN = ""
  305.                     UpdateBrowser
  306.                 END IF
  307.             CASE 11                        ' Drop-down list
  308.                 FDNewItem(14)
  309.             CASE 12                        ' List box
  310.                 FDNewItem(13)
  311.             CASE 13                        ' Log
  312.                 FDNewItem(17)
  313.             CASE 14                        ' Chart
  314.                 FDNewItem(18)
  315.             CASE 15                        ' Digital Clock
  316.                 FDNewItem(20)
  317.             CASE 16                        ' Spreadsheet
  318.                 FDNewItem(19)
  319.         END SELECT
  320.     END SELECT
  321. END PROC
  322.  
  323.  
  324. PROC SetColor(..)
  325.     LOCAL    itemHit, n, c
  326.  
  327.     FormNew(FormQUnique)
  328.     FormControl(_Size; _Center, _Center, 50.2 pct,11 pct)
  329.     FormSetObject(1, _DefButton, "Text Color", 2 pct, _Center, 30 pct, _Default)
  330.     FormSetObject(200, _Button, "Field Color", 35 pct, _Center, 30 pct, _Default)
  331.     FormSetObject(2, _Button, "Cancel", 68 pct, _Center, 30 pct, _Default)
  332.     itemHit = FormWait
  333.     FormControl(_Close)
  334.  
  335.     SELECT CASE itemHit
  336.     CASE 2                                            ' Cancel
  337.         EXIT SELECT
  338.     CASE 1                                            ' Text color
  339.         IF QNOptParams THEN
  340.             n = QOptParam(1)
  341.             c = StdColor(ColorUnpack(item.textcolor[n]), "Select a color for the item's text")
  342.         ELSE
  343.             c = StdColor(ColorUnpack(theform.txtC), "Select a color for the text")
  344.         END IF
  345.  
  346.         IF QVar(c, _Scalar) THEN
  347.             IF c = 0 THEN
  348.                 EXIT SELECT
  349.             END IF
  350.         END IF
  351.         IF QNOptParams THEN
  352.             item.textcolor[n] = ColorPack(c)
  353.         ELSE
  354.             theform.txtC = ColorPack(c)
  355.         END IF
  356.     CASE 200                                            ' Field color
  357.         IF QNOptParams THEN
  358.             n = QOptParam(1)
  359.             c = StdColor(ColorUnpack(item.fieldcolor[n]), "Select a color for the item's field")
  360.         ELSE
  361.             c = StdColor(ColorUnpack(theform.fldC), "Select a color for background field")
  362.         END IF
  363.         IF QVar(c, _Scalar) THEN
  364.             IF c = 0 THEN
  365.                 EXIT SELECT
  366.             END IF
  367.         END IF
  368.         IF QNOptParams THEN
  369.             item.fieldcolor[n] = ColorPack(c)
  370.         ELSE
  371.             theform.fldC = ColorPack(c)
  372.         END IF
  373.     END SELECT
  374. END PROC
  375.