home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / WordProcessors / 976-fwtc.lzx / FW_Tables1.1 / Create_Table < prev    next >
Encoding:
Text File  |  1996-01-03  |  26.1 KB  |  853 lines
  1. /* ======================================== */
  2. /*  FINAL WRITER AREXX MACRO                */
  3. /*    by Carsten Labinsky (C) 1995          */
  4. VER= "Create_Table v1.1 (29.12.95)"
  5. /*  $Ver:  Create_Table v1.1 (29.12.1995)   */
  6. /* ======================================== */
  7. /*  A Powerful AREXX-Program to create      */
  8. /*  auto-sized tables with FinalWriter      */
  9. /* ======================================== */
  10.  
  11. /* =============================================================== */
  12. /* = Legal Notice:  ITS FUCKING CRACKED HAHAHAHAHAHAHAAA!        = */
  13. /* =============================================================== */
  14.  
  15. TRUE  = 1
  16. FALSE = 0
  17.  
  18. /* =============================================================== */
  19. /* =============== USER-DEFINABLE PART starts here =============== */
  20. /* =============================================================== */
  21. /* Note: Numeric values match your FW-Unit-Prefs (except where     */
  22. /*       mentioned otherwise)                                      */
  23.  
  24.  
  25. /* --------------------------------------------------------------- */
  26. /* --- a) Line- and Box-Style Settings: -------------------------- */
  27. /* --------------------------------------------------------------- */
  28.  
  29. /* Line-Widhts for grid-box (in POINTS):       */
  30. /* None, Hairline, .5, 1, 2, 4, 6, 8, 10 or 12 */
  31.  
  32. LINE_WIDTH        = "Hairline"
  33. BOX_LINE_WIDTH    = "Hairline"
  34.  
  35. /* Should the table have round corners? */
  36. /* Set to FALSE to get normal corners   */
  37.  
  38. ROUND_BOX_CORNERS = FALSE
  39.  
  40.  
  41. /* --------------------------------------------------------------- */
  42. /* --- b) General Table-Layout Settings: ------------------------- */
  43. /* --------------------------------------------------------------- */
  44.  
  45. /* Space inbetween Double Lines that separate               */
  46. /* horizontal/vertical Table-Header from Table-Body.        */
  47. /* You'll be requested, if you really WANT them on startup  */
  48. /* If set to 0, no line doubling and no REQUEST appears     */
  49.  
  50. DblHLineOffset = 0.1
  51. DblVLineOffset = 0.1
  52.  
  53.  
  54. /* DEFAULTS for startup-requesters                 */
  55. /* (These settings may be overridden on startup):  */
  56. /* EQ_LSPACING: Force same Height for ALL lines?   */
  57. /* EQ_CSPACING: Force same Width for ALL columns?  */
  58. /* (FALSE means individual auto-spacing)           */
  59.  
  60. EQ_LSPACING = FALSE
  61. EQ_CSPACING = FALSE
  62.  
  63.  
  64. /* Minimal distance between Text and Vertical Lines */
  65. /* Example: ...|--->Text<---|--->Text<---|...       */
  66.  
  67. COL_SPACING  = 0.3
  68.  
  69. /* Minimal distance between Text and Horizontal Lines */
  70.  
  71. LINE_SPACING = 0.3
  72.  
  73.  
  74. /* --------------------------------------------------------------- */
  75. /* --- c) Text-Placement Settings: ------------------------------- */
  76. /* --------------------------------------------------------------- */
  77.  
  78. /* Title-Examples:
  79.  
  80.          ABOVE/CENTERED         BELOW/LEFT
  81.  
  82.             <Title>
  83. TITLE_OFFSET---{               +--+--+--+--+
  84.          +--+--+--+--+         |__|__|__|__|
  85.          |__|__|__|__|         |  |  |  |  |
  86.          |  |  |  |  |         +--+--+--+--+
  87.          +--+--+--+--+           }-----TITLE_OFFSET
  88.                                <Title>
  89.  */
  90.  
  91. /* Title-Options:                                                   */
  92. /* TITLE:          Should the table have a title? (FALSE = No Req.) */
  93. /* TITLE_CENTERED: Should the title be centered or left-justified?  */
  94. /* TITLE_BELOW:    Should the title be above or below the table?    */
  95. /* TITLE_OFFSET:   Distance between Title-Text and Table-Borders    */
  96.  
  97. TITLE           = TRUE
  98. TITLE_CENTERED  = FALSE
  99. TITLE_BELOW     = TRUE
  100. TITLE_OFFSET    = .3
  101.  
  102.  
  103. /* Default settings for Justification-Requester:       */
  104. /* Justification method for texts WITHIN the table     */
  105. /* Shall the text-lines be centered or left-justified? */
  106. /* Examples:
  107.        CENTERED                LEFT-JUSTIFIED
  108.    ----------------- ...     ----------------- ...
  109.    |   xxx   |     |         | xxx     |     |
  110.    |  xxxxx  | xxx |         | xxxxx   | xxx |
  111.    | xxxxxxx |  x  |         | xxxxxxx | x   |
  112.    |    x    |     |         | x       |     |
  113.    ----------------- ...     ----------------- ...
  114.    | xxxxxxx |  x  |         | xxxxxxx | x   |
  115.    |   xxx   | xxx |         | xxx     | xxx |
  116.    ----------------- ...     ----------------- ...
  117.  */
  118.  
  119. TEXT_CENTERED = TRUE
  120.  
  121.  
  122. /* Choose method for text-flow OUTSIDE of table   */
  123. /* Note: This does not include table-title, sorry */
  124. /* Options: None, LeftVert, LeftCont, RightVert,  */
  125. /*          RightCont                             */
  126.  
  127. TEXT_FLOW       = "RightVert"
  128.  
  129. /* Flow-Distance between table-box and surrounding text */
  130.  
  131. FLOW_DIST       = 1.0
  132.  
  133.  
  134. /* --------------------------------------------------------------- */
  135. /* --- d) Expert-User Settings: ---------------------------------. */
  136. /* --------------------------------------------------------------- */
  137.  
  138. /* Character to be used as a seperator between */
  139. /* multiple lines in a single matrix-cell      */
  140.  
  141. SEP_CHAR = '#'
  142.  
  143. /* Bracket-Chars to surround a textstyle-definition */
  144.  
  145. LBRACKET = '{'
  146. RBRACKET = '}'
  147.  
  148. /* This enables a BUGFIX for FW4's TextObject-      */
  149. /* handling (The TOP-Coordinate is in fact          */
  150. /* the Baseline-Coordinate [no kin with BOTTOM!])   */
  151.  
  152. FW4_BUGFIX = TRUE
  153.  
  154. /* This enables the DEBUG-Mode   */
  155. /* Better let it be FALSE! ;)    */
  156.  
  157. DEBUG = FALSE
  158.  
  159.  
  160. /* =============================================================== */
  161. /* =========== USER-DEFINABLE PART ends here ===================== */
  162. /* =============================================================== */
  163.  
  164. /*======================================================================*/
  165. /*==== DO NOT EDIT anything below unless you paid the SHAREWARE-fee ====*/
  166. /*======================================================================*/
  167.  
  168. /*--Init globals:----------------------------*/
  169.  
  170. ObjCounter = 0
  171. TextObjCounter = 0
  172. Columns = 0
  173. Lines = 0
  174. TotalWidth = 0
  175. TotalHeight = 0
  176. TableID = 0
  177. BoxID = 0
  178.  
  179.  
  180. /* Start Section: Dark Angel/976 - this is a dumbass protection method... */
  181. /* basically he puts all these in col 80+ so you can't see em in your editor */
  182. /* and these strings are 'encrypted' so you can't read em! HA! LAUGH!  */
  183. /* Oki... it's AREXX.. i'll give him cred for trying.. but REXX isn't */
  184. /* a HARD language to program in ;*) */
  185. /* All that's been done to it basically is to remove the calls to the time */
  186. /* delay loop and the strings... i left the first requester in.. :*)  */
  187. /* Good macro otherwise... but time delays? C'mon - make it free asswipe! */
  188. /* I did :) */
  189.  
  190. ri_text.1="âù Ãáòóôåî Ìáâéîóëù";
  191. ri_text.2="Òåáä ôèå ÓÈÁÒÅ×ÁÒÅ­îïôéãå¡";
  192. ri_text.3="Ðìåáóå âå ðáôéåîô¡";
  193.  
  194. ri_text.4="®®®áîä ôèéîë áâïõô òåçéóôåòéîç® »­©";
  195. ri_text.5="Ùïõ íáù ãïîôéîõå éî ";
  196. ri_text.6=" óåãïîäó®";                 
  197.  
  198. /*--Main                starts    here:------------------------*/
  199. Options Results
  200.  
  201. /* Make sure that we get valid AREXX numbers              */
  202. /* in case that DocItemPrefs-Decimal-Char is set to comma */
  203. /* (Prefs will be restored on exit) */
  204. TRACE R                      
  205. GetDocItemPrefs DECIMAL
  206. OldDecimal = Result
  207. DocItemPrefs DECIMAL Period
  208. TRACE O
  209.  
  210. /* Must determine the current page and the current */
  211. /* scroll-position so that the box will be placed  */
  212. /* in the field of view.                           */
  213. Status Page
  214. CurPage = Result
  215.  
  216. /* Make sure we are in the visible area */
  217. Status ScrollPos
  218. Parse VAR Result Left Top
  219.  
  220. Top = Top +3
  221. Left = Left +3
  222.  
  223.  
  224. IF DEBUG THEN CALL DEBUG_FILL()
  225.          ELSE CALL REQUEST_DATA()
  226.  
  227. CALL DRAW_TEXTOBJECTS()
  228. CALL CALC_DIMENSIONS()
  229. CALL PLACE_TEXT()
  230. CALL DRAW_GRID()
  231.  
  232. IF DEBUG THEN DO
  233.     Redraw
  234.     CALL DEBUG_OUTPUT()
  235. END
  236.  
  237. IF TITLE THEN DO
  238.     CALL ADD_TITLE(TitleText)
  239. END
  240.  
  241. CALL GROUP_OBJECTS()
  242. Redraw
  243. CALL POPUP("Table created.")
  244.  
  245. ABORT:
  246. /* Restore old Prefs-Settings */
  247. TRACE R
  248. DocItemPrefs DECIMAL OldDecimal
  249. TRACE O
  250. EXIT
  251.  
  252.  
  253. /*-Main ends here, Subroutines follow:---------------------*/
  254.  
  255.  
  256. /* Request all User-Input */
  257. REQUEST_DATA:
  258.                                                                                                                                                                                                                   IF ~BoxID THEN CALL REQUEST_INIT()
  259.     result = -1
  260.     RequestText '"Table-Dimensions" "Enter number of LINES:" "3"'
  261.     Lines = result
  262.     IF Lines = -1 THEN CALL ABORT()
  263.     IF ~datatype(Lines, 'w') THEN DO 
  264.         CALL POPUP("Illegal Entry: Integer Expected!")
  265.         CALL REQUEST_DATA()
  266.     END
  267.     IF Lines<2 THEN DO
  268.         CALL POPUP("Illegal Value: Must be [int] >= 2")
  269.         CALL REQUEST_DATA()
  270.     END
  271. REQUEST_COLUMNS:
  272.     result = -1
  273.     RequestText '"Table-Dimensions" "Enter number of COLUMNS:" "3"'
  274.     Columns = result
  275.     IF Columns = -1 THEN CALL ABORT()
  276.     IF ~datatype(Columns, 'w') THEN DO
  277.         CALL POPUP("Illegal Entry: Integer Expected!")
  278.         CALL REQUEST_DATA()
  279.     END
  280.     IF Columns<2 THEN DO
  281.         CALL POPUP("Illegal Value: Must be [int] >= 2")
  282.         CALL REQUEST_COLUMNS()
  283.     END
  284. SELECT_TEXTADJUST:
  285.     IF TEXT_CENTERED THEN Defbut=1
  286.     ELSE DefBut=2
  287.     ShowMessage DefBut 0 '"Select text-justification:" "Shall texts be centered or left-justified?" "" "Center" "Left" "Abort"'
  288.     choice = result
  289.     IF choice=1 THEN TEXT_CENTERED = 1
  290.     ELSE IF choice=2 THEN TEXT_CENTERED = 0
  291.     ELSE CALL ABORT()
  292.  
  293. SELECT_HDRTYPE:
  294.     IF DblHLineOffset >0 THEN DO
  295.         ShowMessage 1 0 '"Select header-type:" "Do you want a horizontal header?" "" "H-Hdr" "No" "Abort"'
  296.         choice = result
  297.         IF choice=2 THEN DblHLineOffset = 0
  298.         ELSE IF choice=3 THEN CALL ABORT()
  299.     END
  300.     IF DblVLineOffset >0 THEN DO
  301.         ShowMessage 1 0 '"Select header-type:" "Do you want a vertical header?" "" "V-Hdr" "No" "Abort"'
  302.         choice = result
  303.         IF choice=2 THEN DblVLineOffset = 0
  304.         ELSE IF choice=3 THEN CALL ABORT()
  305.     END
  306. SELECT_EQSPACING:
  307.     IF EQ_LSPACING THEN DefBut=1
  308.     ELSE DefBut=2
  309.     ShowMessage DefBut 0 '"Select spacing-type:" "Do you want equal LINE-heights?" "" "Equal" "No" "Abort"'
  310.     choice = result
  311.     IF choice=1 THEN EQ_LSPACING = 1
  312.     ELSE IF choice=2 THEN EQ_LSPACING=0
  313.     ELSE CALL ABORT()
  314.     IF EQ_CSPACING THEN DefBut=1
  315.     ELSE DefBut=2
  316.     ShowMessage DefBut 0 '"Select spacing-type:" "Do you want equal COLUMN-widths?" "" "Equal" "No" "Abort"'
  317.     choice = result
  318.     IF choice=1 THEN EQ_CSPACING = 1
  319.     ELSE IF choice=2 THEN EQ_CSPACING=0
  320.     ELSE CALL ABORT()
  321.  
  322.     IF (TITLE=1) THEN CALL REQUEST_TITLE()
  323.  
  324.     CALL REQUEST_TEXT()
  325. return
  326.  
  327.  
  328. /* Request the Table's title */
  329. REQUEST_TITLE:
  330.     c = '"'
  331.     s = ' '
  332.     result = -1
  333.     rtitle = "Enter text for table's title"
  334.     rprompt = "To disable the title-option,  hit <Abort>."
  335.     rtext = c||rtitle||c||s||c||rprompt||c||s||c||c
  336.     RequestText rtext
  337.     myresult = result
  338.     /* Handle Abort-Button => Disable Title */
  339.     IF (myresult = -1) THEN TITLE=0
  340.     ELSE DO
  341.         TitleText = myresult
  342.         IF length(TitleText)=0 THEN TITLE =0
  343.     END
  344. return
  345.  
  346.  
  347. /* Request Text for Matrix-Cells */
  348. REQUEST_TEXT: 
  349.     c = '"'
  350.     s = ' '
  351.     rtitle = "Table-Entries (LF-char is ''"||SEP_CHAR||"'')"
  352.     DO line=1 FOR Lines
  353.         DO col=1 FOR Columns
  354.             body = "Enter Text for Line "||line||", Column "||col||":"
  355.             rtext = c||rtitle||c||s||c||body||c||s||c||c
  356.             result = -1
  357.             RequestText rtext
  358.             text.col.line = result
  359.             IF text.col.line = -1 THEN CALL ABORT()
  360.         END
  361.     END
  362. return
  363.  
  364.  
  365. /* Calculates needed Line- and Column-Dimensions */
  366. CALC_DIMENSIONS:
  367.     /* calculate the needed Column-Widths */
  368.     colmax = 0
  369.     DO i=1 FOR Columns
  370.         CALL CALC_COLWIDTH(i)
  371.         ColWidth.i = result        
  372.         colmax = MAX(ColWidth.i, colmax)
  373.         TotalWidth = TotalWidth + ColWidth.i
  374.     END
  375.     IF EQ_CSPACING THEN DO
  376.         DO i=1 FOR Columns
  377.             ColWidth.i = colmax
  378.         END
  379.         TotalWidth = colmax * Columns
  380.     END      
  381.     TotalWidth = TotalWidth + DblVLineOffset    
  382.     
  383.  
  384.     /* ...and the needed Line-Heights */
  385.     linemax = 0
  386.     DO i=1 FOR Lines
  387.         LineHeight.i = CALC_LINEHEIGHT(i)
  388.         TotalHeight = TotalHeight + LineHeight.i
  389.         linemax = MAX(LineHeight.i, linemax)
  390.     END
  391.     IF EQ_LSPACING THEN DO
  392.         DO i=1 FOR Lines
  393.             LineHeight.i = linemax
  394.         END
  395.         TotalHeight = linemax * Lines
  396.     END
  397.     TotalHeight = TotalHeight + DblHLineOffset
  398. return
  399.  
  400.  
  401. /* This one calculates the needed width of column arg(1) */
  402. CALC_COLWIDTH:
  403.     col = arg(1)
  404.     maxtextwidth = 0
  405.     DO cc_l=1 FOR Lines
  406.         IF TextObjID.col.cc_l > -1 THEN DO
  407.             GetObjectCoords TextObjID.col.cc_l
  408.             myresult = result
  409.             PARSE VAR myresult TOPage TOLeft TOTop TOWidth TOHeight
  410.             maxtextwidth = MAX(TOWidth, maxtextwidth)
  411.         END
  412.     END
  413.     maxtextwidth = maxtextwidth + (COL_SPACING*2)
  414. return maxtextwidth
  415.  
  416.  
  417. /* This one calculates the needed height of line arg(1) */
  418. CALC_LINEHEIGHT:
  419.     line = arg(1)
  420.     maxtextheight = 0
  421.     DO cl_c=1 FOR Columns
  422.         IF TextObjID.cl_c.line > -1 THEN DO
  423.             GetObjectCoords TextObjID.cl_c.line
  424.             myresult = result
  425.             PARSE VAR myresult TOPage TOLeft TOTop TOWidth TOHeight
  426.             maxtextheight = MAX(TOHeight, maxtextheight)
  427.         END
  428.     END
  429.     maxtextheight = maxtextheight + (LINE_SPACING*2)
  430. return maxtextheight
  431.  
  432.  
  433. /* Function to draw the Table-GridBox*/
  434. DRAW_GRID:
  435.  
  436.     /* Store the current prefs */
  437.     GetLinePrefs LINEWT
  438.     oldprefs = result
  439.     GetBoxPrefs LINEWT TEXTFLOW FLOWDIST 
  440.     PARSE VAR result oldbl oldbt oldbf
  441.  
  442.     LinePrefs LINEWT LINE_WIDTH
  443.     BoxPrefs LINEWT BOX_LINE_WIDTH TEXTFLOW TEXT_FLOW FLOWDIST FLOW_DIST
  444.  
  445.     /* Draw surrounding box */    
  446.     ObjCounter = ObjCounter +1
  447.     IF ROUND_BOX_CORNERS THEN DrawBox CurPage Left Top TotalWidth TotalHeight BEVEL
  448.     ELSE DrawBox CurPage Left Top TotalWidth TotalHeight
  449.     ObjID.ObjCounter = result
  450.     ObjectToBack ObjID.ObjCounter    
  451.  
  452.     /*Draw vertical lines*/
  453.     xoffset= Left + ColWidth.1
  454.     /* Handle Double Vertical Line */
  455.     IF (DblVLineOffset > 0) THEN DO
  456.         ObjCounter = ObjCounter +1
  457.         DrawLine CurPage xoffset Top xoffset Top+TotalHeight
  458.         ObjID.ObjCounter = result
  459.         xoffset = xoffset + DblVLineOffset
  460.     END
  461.     /* Draw normal vertical lines */
  462.     DO i=2 FOR (Columns-1)
  463.         ObjCounter = ObjCounter +1
  464.         DrawLine CurPage xoffset Top xoffset Top+TotalHeight
  465.         ObjID.ObjCounter = result
  466.         xoffset = xoffset + ColWidth.i
  467.     END
  468.  
  469.     /*Draw horizontal lines*/
  470.     yoffset= Top+LineHeight.1
  471.     /* Handle double horizontal line */
  472.     IF (DblHLineOffset > 0) THEN DO
  473.         ObjCounter = ObjCounter +1
  474.         DrawLine CurPage Left yoffset Left+TotalWidth yoffset    
  475.         ObjID.ObjCounter = result
  476.         yoffset = yoffset + DblHLineOffset
  477.     END
  478.     /* Draw normal horizontal lines */
  479.     DO i=2 FOR (Lines-1)
  480.         ObjCounter = ObjCounter +1
  481.         DrawLine CurPage Left yoffset Left+TotalWidth yoffset
  482.         ObjID.ObjCounter = result
  483.         
  484.         yoffset = yoffset + LineHeight.i
  485.     END
  486.     
  487.     /* Restore the old prefs */
  488.        LinePrefs LINEWT oldprefs
  489.        BoxPrefs LINEWT oldbl TEXTFLOW oldbt FLOWDIST oldbf
  490. return
  491.  
  492.  
  493. /* Draw the Text-Contents of the Table-Matrix */
  494. DRAW_TEXTOBJECTS:
  495.     DO c=1 FOR Columns
  496.         DO l=1 FOR Lines
  497.             TextObjCounter = TextObjCounter+1
  498.             templines = 0
  499.             IF length(Text.c.l)>0 THEN DO
  500.             
  501.                 /* Create TextObj(s) for a Matrix Cell */
  502.                 j=1
  503.                 rest = Text.c.l
  504.                 DO WHILE length(rest)>0
  505.                     PARSE VAR rest tline.j (SEP_CHAR) rest
  506.                     /* Strip optional text-style-defs */
  507.                     fmtstring = ""
  508.                     IF (SUBSTR(tline.j, 1, 1)=LBRACKET) THEN DO
  509.                         rbpos = POS(RBRACKET, tline.j)
  510.                         fmtstring = SUBSTR(tline.j, 2, (rbpos-2))
  511.                         tline.j = SUBSTR(tline.j, (rbpos+1))
  512.                     END
  513.                     DrawTextBlock CurPage Left Top '"'||tline.j||'"'
  514.                     TempID.j = result
  515.                     /* Set optional text-styles */
  516.                     IF length(fmtstring)>0 THEN DO
  517.                         CALL SET_STYLE(TempID.j, fmtstring)
  518.                     END
  519.                     rest = rest
  520.                     j = j+1
  521.                 END
  522.                 templines = j-1
  523.                 
  524.                 /* Merge multiple textobjs to one textobjgroup, if any */
  525.                 IF templines > 1 THEN DO
  526.                     /* We have to redraw to get the correct widths (BUG!) */
  527.                     redraw
  528.                     
  529.                     GetObjectCoords TempID.1
  530.                     PARSE VAR result tpage tleft ttop twidth theight
  531.                     mycenter = tleft + (twidth/2)
  532.  
  533.                     /* BUG-Warning:
  534.                      * FW4 doesn't handle GetObjCoords correctly
  535.                      * for single TextObjects:
  536.                      *
  537.                      * The TOP-Returnvalue holds the BaseLine-
  538.                      * value in fact !!!!
  539.                      *
  540.                      * Workaround follows:
  541.                      */
  542.                      IF (FW4_BUGFIX) THEN DO
  543.                          BUGFIX_OFFSET = theight * 0.7    
  544.                      END
  545.                      ELSE BUGFIX_OFFSET =0
  546.  
  547.                      mytop = ttop - BUGFIX_OFFSET + theight
  548.  
  549.                     /* Place lines left-justified */
  550.                     k = 2
  551.                     DO UNTIL (k>templines)
  552.                         GetObjectCoords TempID.k
  553.                         PARSE VAR result ttp ttl ttt ttw tth
  554.  
  555.                        /* BUG-Warning: 
  556.                         * FW4 doesn't handle GetObjCoords correctly
  557.                         * for single TextObjects:
  558.                         *
  559.                         * The TOP-Returnvalue holds the BaseLine-
  560.                         * value in fact !!!!
  561.                         *
  562.                         * Workaround follows:
  563.                         */
  564.                         IF (FW4_BUGFIX) THEN DO
  565.                             BUGFIX_OFFSET = tth * 0.7
  566.                         END
  567.                         ELSE BUGFIX_OFFSET =0
  568.  
  569.                         mytop = mytop + BUGFIX_OFFSET
  570.                         IF TEXT_CENTERED THEN myleft = mycenter - (ttw/2)
  571.                         ELSE myleft = tleft
  572.                         SetObjectCoords TempID.k ttp myleft mytop ttw tth
  573.                         mytop = mytop + (tth - BUGFIX_OFFSET)
  574.                         k = k+1
  575.                     END
  576.  
  577.                     /* Group Objects */
  578.                     SelectObject TempID.1
  579.                     DO i=2 FOR templines
  580.                         SelectObject TempID.i MULTIPLE
  581.                     END
  582.                     Group
  583.                     FirstObject SELECTED
  584.                     TextObjID.c.l = result
  585.                     /* Set group-flag */
  586.                     TextGroup.c.l = 1
  587.                 END
  588.                 ELSE DO
  589.                     TextObjID.c.l = TempID.1
  590.                     /* UnSet group-flag */
  591.                     TextGroup.c.l = 0
  592.                 END
  593.  
  594.             END
  595.             ELSE DO
  596.                 TextObjID.c.l = -1
  597.             END
  598.         END
  599.     END
  600.     /* Redraw Display to get the correct widths for those
  601.        text-objects with changed text-styles 
  602.        (another BUG, sigh) */
  603.     redraw
  604. return
  605.  
  606.  
  607. /* Sets the specified TextBlock-Style */
  608. /* Args are: ObjID, Fmtstring */
  609. /* Fmtstring consists of a combination of the following:
  610.         B        - Sets Bold style
  611.         I        - Sets Italic style
  612.         S:<num>  - Sets Size to <num>
  613.         W:<num>  - Sets Width to <num>
  614.         F:<name> - Sets Fontname to <name>
  615.    Each of these must be seperated by spaces */
  616. SET_STYLE: PROCEDURE
  617.     ObjID  = arg(1)
  618.     fmtstr = UPPER(arg(2))
  619.     /* Get the original Settings */
  620.     GetObjectTypeSpecs ObjID SIZE WIDTH FONT
  621.     PARSE VAR result osize owidth ofont
  622.     
  623.     /* Remove path from fontname */
  624.     ofont=strip(ofont)
  625.     p = MAX(LASTPOS('/', ofont), LASTPOS(':',ofont))
  626.     ofont = SUBSTR(ofont, 1+p)
  627.  
  628.     settings = ""
  629.     BOLD = 0
  630.     ITALIC = 0
  631.     /* Parse the fmtstring */
  632.     DO WHILE (length(fmtstr)>0)
  633.         PARSE VAR fmtstr fmtdef fmtstr
  634.         IF fmtdef = "B" THEN BOLD=1
  635.         ELSE IF fmtdef = "I" THEN ITALIC=1
  636.              ELSE IF left(fmtdef,2) = "S:" THEN osize =substr(fmtdef,3)
  637.                   ELSE IF left(fmtdef,2) = "W:" THEN owidth =substr(fmtdef,3)
  638.                        ELSE IF left(fmtdef,2) = "F:" THEN ofont =substr(fmtdef,3)
  639.     END
  640.  
  641.     IF BOLD THEN   ofont = MAKE_BOLD(ofont)
  642.     IF ITALIC THEN ofont = MAKE_ITALIC(ofont)
  643.     SetObjectTypeSpecs ObjID SIZE osize WIDTH owidth FONT ofont
  644. return 
  645.  
  646.  
  647. /* Add bold-style to fontname in arg(1) */
  648. MAKE_BOLD: PROCEDURE
  649.     fname = UPPER(arg(1))
  650.     p= LASTPOS("_ITALIC", fname)
  651.     IF (p>0) THEN fname = SUBSTR(fname, 1, p)||"BOLDITALIC"
  652.     ELSE fname = fname||"_BOLD"
  653. return fname
  654.  
  655.  
  656. /* Add italic-style to fontname in arg(1) */
  657. MAKE_ITALIC: PROCEDURE
  658.     fname = UPPER(arg(1))
  659.     p= LASTPOS("_BOLD", fname)
  660.     IF (p>0) THEN fname = fname||"ITALIC" 
  661.     ELSE fname = fname||"_ITALIC"
  662. return fname
  663.  
  664.  
  665. /* This function places the TextObjects into the Grid */
  666. PLACE_TEXT:
  667.     ycenter = Top
  668.     DO l=1 FOR Lines
  669.         ycenter = ycenter + (LineHeight.l * 0.5)
  670.         xcenter = Left
  671.         DO c=1 FOR Columns
  672.             xcenter = xcenter + (ColWidth.c * 0.5)
  673.             IF TextObjID.c.l > -1 THEN DO
  674.  
  675.                 GetObjectCoords TextObjID.c.l
  676.                 PARSE VAR result TOPage TOLeft TOTop TOWidth TOHeight
  677.  
  678.                /* BUG-Warning: 
  679.                 * FW4 doesn't handle GetObjCoords correctly
  680.                 * for single TextObjects:
  681.                 *
  682.                 * The TOP-Returnvalue holds the BaseLine-
  683.                 * value in fact !!!!
  684.                 *
  685.                 * Workaround follows:
  686.                 */
  687.  
  688.                 IF (FW4_BUGFIX & ~TextGroup.c.l) THEN DO
  689.                     BUGFIX_OFFSET = TOHeight * 0.7
  690.                 END
  691.                 ELSE BUGFIX_OFFSET =0
  692.  
  693.                 y = ycenter-(TOHeight * 0.5) + BUGFIX_OFFSET
  694.                 IF TEXT_CENTERED THEN x = xcenter - (TOWidth * 0.5) 
  695.                 ELSE x = xcenter - (ColWidth.c/2) + COL_SPACING
  696.                 SetObjectCoords TextObjID.c.l CurPage x y TOWidth TOHeight
  697.             END
  698.             xcenter = xcenter + (ColWidth.c * 0.5)
  699.             if c=1 THEN xcenter = xcenter + DblVLineOffset
  700.         END
  701.         IF l=1 THEN ycenter = ycenter + DblHLineOffset
  702.         ycenter = ycenter + (LineHeight.l * 0.5)
  703.     END
  704. return
  705.  
  706.  
  707. /* Group all Table-Objects to a single Object */
  708. GROUP_OBJECTS:
  709.     SelectObject ObjID.1
  710.     DO i=2 FOR ObjCounter
  711.         SelectObject ObjID.i MULTIPLE
  712.     END
  713.     DO c=1 FOR Columns
  714.         DO l=1 FOR Lines
  715.             SelectObject TextObjID.c.l MULTIPLE
  716.         END
  717.     END
  718.     IF TITLE THEN SelectObject TitleID MULTIPLE
  719.     Group
  720.     FirstObject SELECTED
  721.     TableID = result
  722. return
  723.  
  724.  
  725. /* Add the table-title in arg(1)*/
  726. /* (can contain format-defs, see SET_STYLE) */
  727. ADD_TITLE:
  728.     text = arg(1)
  729.     
  730.     /* strip optional text-style-defs */
  731.     fmtstr = ""
  732.     IF (SUBSTR(text, 1, 1)=LBRACKET) THEN DO
  733.         rbpos = POS(RBRACKET, text)
  734.         fmtstr = SUBSTR(text, 2, (rbpos-2))
  735.         text = SUBSTR(text, (rbpos+1))
  736.     END
  737.  
  738.     DrawTextBlock CurPage Left Top '"'||text||'"'
  739.     TitleID = result
  740.  
  741.     /*Handle text-styles */    
  742.     IF length(fmtstr)>0 THEN DO
  743.         CALL SET_STYLE(TitleID, fmtstr)
  744.     END
  745.     redraw
  746.     
  747.     /*Place Title */
  748.     GetObjectCoords TitleID 
  749.     PARSE VAR result tp tl tt tw th
  750.  
  751.    /* 
  752.     * BUG-Warning: 
  753.     * FW4 doesn't handle GetObjCoords correctly
  754.     * for single TextObjects:
  755.     *
  756.     * The TOP-Returnvalue holds the BaseLine-
  757.     * value in fact !!!!
  758.     *
  759.     * Workaround follows:
  760.     */
  761.     IF (FW4_BUGFIX) THEN DO
  762.         BUGFIX_OFFSET = th * 0.7    
  763.     END
  764.     ELSE BUGFIX_OFFSET =0
  765.     
  766.     IF TITLE_CENTERED THEN tl = Left + (TotalWidth-tw)/2
  767.     ELSE tl = Left
  768.     IF TITLE_BELOW THEN tt = Top + TotalHeight + TITLE_OFFSET + BUGFIX_OFFSET 
  769.     ELSE tt = Top - th - TITLE_OFFSET + BUGFIX_OFFSET
  770.     
  771.     SetObjectCoords TitleID CurPage tl tt tw th
  772.  
  773. return
  774.  
  775.  
  776. /* Opens a Popup-Message w/ Texts in arg(1)-arg(3) */
  777. POPUP: PROCEDURE
  778.     c = '"'
  779.     s = ' '
  780.     text1 = arg(1)
  781.     text2 = arg(2)
  782.     text3 = arg(3)
  783.     text = c||text1||c||s||c||text2||c||s||c||text3||c||s||c||"OK"||c||s||c||c||s||c||c
  784.     ShowMessage 1 0 text
  785. return
  786.  
  787.  
  788. /* DEBUGGING-Output: Shows Coordinates */
  789. DEBUG_OUTPUT:
  790.     s = '/'
  791.     text1 = "Box(L/T/W/H): " Left s Top s TotalWidth s TotalHeight ", DblHLineOffset" DblHLineOffset
  792.  
  793.     text2 = "Lineheights: "
  794.     DO i=1 FOR Lines
  795.         text2 = text2 LineHeight.i s
  796.     END
  797.     text2 = text2 "Spacing:" LINE_SPACING
  798.  
  799.     text3 = "ColWidths: "
  800.     DO i=1 FOR Columns
  801.         text3 = text3 ColWidth.i s
  802.     END
  803.     text3 = text3 "Spacing:" COL_SPACING
  804.  
  805.     CALL POPUP(text1, text2, text3)
  806.  
  807.     s = '/'
  808.     DO l=1 FOR Lines
  809.         text.l = "Line"||l||" TObj(L/Base/W/H): "
  810.         DO c=1 FOR Columns
  811.             GetObjectCoords TextObjID.c.l
  812.             PARSE VAR result tp tl tt tw th
  813.             th = strip(th)
  814.             text.l = text.l||'('||tl||s||tt||s||tw||s||th||") "
  815.         END
  816.     END
  817.     
  818.     i=1
  819.     DO WHILE (i<=Lines)
  820.         j = i+1
  821.         k = i+2
  822.         CALL POPUP(text.i, text.j, text.k)
  823.         i = i+3
  824.     END
  825. return
  826.  
  827.  
  828. /* Fill out a table for DEBUGGING: */
  829. DEBUG_FILL:
  830.  
  831.     TitleText = LBRACKET||"B S:11"||RBRACKET||"Table 1: This is the debug-table"
  832.     Columns = 3
  833.     Lines = 3
  834.     /* Fill the Tab-Array with texts */
  835.     DO c=1 FOR Columns
  836.         DO l=1 FOR Lines
  837.             Text.c.l = "Text"||c||l
  838.             TextObjID.c.l = 0
  839.         END
  840.     END
  841.     Text.1.1 = "Line1 p"||SEP_CHAR||LBRACKET||"B I S:30 F:Courier"||RBRACKET||"Courier"||SEP_CHAR||"MultiLine3p"
  842.     Text.2.2 = LBRACKET||"B I S:20"||RBRACKET||"Test"
  843.     Text.1.2 = "no"||SEP_CHAR||"text"||SEP_CHAR||"below"
  844.     Text.1.3 = ""
  845.     Text.2.3 = "no"||SEP_CHAR||"text"||SEP_CHAR||"left"
  846.                                                                                                                                                                                                                        return; REQUEST_INIT:
  847.     to = 0;                                                                                                                                                                                                      DO i=1 FOR 6; ri_text.i= translate(ri_text.i, xrange('00'x, '7F'x), xrange('80'x,'FF'x)); END;
  848.     isecs = time(s);
  849.     CALL POPUP(VER, "     Five Second Crack " , "   By Dark Angel/976 Evil ")
  850.     /*ALL POPUP(VER, ri_text.1 , ri_text.2)*/
  851.     diff = time(s)-isecs
  852. return
  853.