/* ======================================== */
/*  FINAL WRITER AREXX MACRO                */
/*    by Carsten Labinsky (C) 1995          */
VER= "Create_Table v1.1 (29.12.95)"
/*  $Ver:  Create_Table v1.1 (29.12.1995)   */
/* ======================================== */
/*  A Powerful AREXX-Program to create      */
/*  auto-sized tables with FinalWriter      */
/* ======================================== */

/* =============================================================== */
/* = Legal Notice:                                               = */
/* =                                                             = */
/* = This piece of software is distributed as SHAREWARE. It may  = */
/* = be distributed for free via                                 = */
/* =    - electronic networks and BBS,                           = */
/* =    - PD-FloppyDisk's (as long as distribution-costs do not  = */
/* =                       exceed 5 DM [or equiv.] in total)     = */
/* =    - Aminet CD-ROM                                          = */
/* = Its use may be tested for a period of 4 weeks. If you use   = */
/* = it longer than this, you have to pay for it.                = */
/* = The SHAREWARE-fee equals 15 DM or 15 US-DOLLARS. (Read the  = */
/* = file register.doc for further details)                      = */
/* =                                                             = */
/* = No parts of this code may be altered or reused without my   = */
/* = permission (except for the User-Definable Parts,of course). = */
/* =                                                             = */
/* =    The author takes no liability about this software, its   = */
/* = use or any damage that may result from its use (... one     = */
/* = never knows ;-).                                            = */
/* =                                                             = */
/* = (You may delete this notice AFTER reading it... :)          = */
/* =                                                             = */
/* =============================================================== */
/* =                                                             = */
/* = IMPORTANT BUG-NOTICE:                                       = */
/* =                                                             = */
/* = At least the german version of FinalWriter v4.01 does not   = */
/* = handle text-object-coordinates correctly.                   = */
/* = The TOP-value contains in fact the y-coordinate for the     = */
/* = text's BASELINE (which is approximately 0.7 * HEIGHT below)!= */
/* =                                                             = */
/* = This script provides a WORK-AROUND which is ENABLED by      = */
/* = default. If you use a different version of FinalWriter      = */
/* = and find the text-objects scattered in y-direction, set     = */
/* = FW4_BUGFIX to FALSE (see Expert-User-Settings below).       = */
/* =                                                             = */
/* =============================================================== */

TRUE  = 1
FALSE = 0

/* =============================================================== */
/* =============== USER-DEFINABLE PART starts here =============== */
/* =============================================================== */
/* Note: Numeric values match your FW-Unit-Prefs (except where     */
/*       mentioned otherwise)                                      */


/* --------------------------------------------------------------- */
/* --- a) Line- and Box-Style Settings: -------------------------- */
/* --------------------------------------------------------------- */

/* Line-Widhts for grid-box (in POINTS):       */
/* None, Hairline, .5, 1, 2, 4, 6, 8, 10 or 12 */

LINE_WIDTH        = "Hairline"
BOX_LINE_WIDTH    = "Hairline"

/* Should the table have round corners? */
/* Set to FALSE to get normal corners   */

ROUND_BOX_CORNERS = FALSE


/* --------------------------------------------------------------- */
/* --- b) General Table-Layout Settings: ------------------------- */
/* --------------------------------------------------------------- */

/* Example:
         Col1    Col2   Col3   Col4   Col5
       -------------------------------------
Line1  |      ||      |      |      |      |
       ===================================== <-- [DblHLineOffset]
Line2  |      ||      |      |      |      |
       -------------------------------------
Line3  |      ||      |      |      |      |
       -------------------------------------
               ^
               |
        [DblVLineOffset]
*/

/* Space inbetween Double Lines that separate               */
/* horizontal/vertical Table-Header from Table-Body.        */
/* You'll be requested, if you really WANT them on startup  */
/* If set to 0, no line doubling and no REQUEST appears     */

DblHLineOffset = 0.1
DblVLineOffset = 0.1


/* DEFAULTS for startup-requesters                 */
/* (These settings may be overridden on startup):  */
/* EQ_LSPACING: Force same Height for ALL lines?   */
/* EQ_CSPACING: Force same Width for ALL columns?  */
/* (FALSE means individual auto-spacing)           */

EQ_LSPACING = FALSE
EQ_CSPACING = FALSE


/* Minimal distance between Text and Vertical Lines */
/* Example: ...|--->Text<---|--->Text<---|...       */

COL_SPACING  = 0.3

/* Minimal distance between Text and Horizontal Lines */

LINE_SPACING = 0.3


/* --------------------------------------------------------------- */
/* --- c) Text-Placement Settings: ------------------------------- */
/* --------------------------------------------------------------- */

/* Title-Examples:

         ABOVE/CENTERED         BELOW/LEFT

            <Title>
TITLE_OFFSET---{               +--+--+--+--+
         +--+--+--+--+         |__|__|__|__|
         |__|__|__|__|         |  |  |  |  |
         |  |  |  |  |         +--+--+--+--+
         +--+--+--+--+           }-----TITLE_OFFSET
                               <Title>
 */

/* Title-Options:                                                   */
/* TITLE:          Should the table have a title? (FALSE = No Req.) */
/* TITLE_CENTERED: Should the title be centered or left-justified?  */
/* TITLE_BELOW:    Should the title be above or below the table?    */
/* TITLE_OFFSET:   Distance between Title-Text and Table-Borders    */

TITLE           = TRUE
TITLE_CENTERED  = FALSE
TITLE_BELOW     = TRUE
TITLE_OFFSET    = .3


/* Default settings for Justification-Requester:       */
/* Justification method for texts WITHIN the table     */
/* Shall the text-lines be centered or left-justified? */
/* Examples:
       CENTERED                LEFT-JUSTIFIED
   ----------------- ...     ----------------- ...
   |   xxx   |     |         | xxx     |     |
   |  xxxxx  | xxx |         | xxxxx   | xxx |
   | xxxxxxx |  x  |         | xxxxxxx | x   |
   |    x    |     |         | x       |     |
   ----------------- ...     ----------------- ...
   | xxxxxxx |  x  |         | xxxxxxx | x   |
   |   xxx   | xxx |         | xxx     | xxx |
   ----------------- ...     ----------------- ...
 */

TEXT_CENTERED = TRUE


/* Choose method for text-flow OUTSIDE of table   */
/* Note: This does not include table-title, sorry */
/* Options: None, LeftVert, LeftCont, RightVert,  */
/*          RightCont                             */

TEXT_FLOW       = "RightVert"

/* Flow-Distance between table-box and surrounding text */

FLOW_DIST       = 1.0


/* --------------------------------------------------------------- */
/* --- d) Expert-User Settings: ---------------------------------. */
/* --------------------------------------------------------------- */

/* Character to be used as a seperator between */
/* multiple lines in a single matrix-cell      */

SEP_CHAR = '#'

/* Bracket-Chars to surround a textstyle-definition */

LBRACKET = '{'
RBRACKET = '}'

/* This enables a BUGFIX for FW4's TextObject-      */
/* handling (The TOP-Coordinate is in fact          */
/* the Baseline-Coordinate [no kin with BOTTOM!])   */

FW4_BUGFIX = TRUE

/* This enables the DEBUG-Mode   */
/* Better let it be FALSE! ;)    */

DEBUG = FALSE


/* =============================================================== */
/* =========== USER-DEFINABLE PART ends here ===================== */
/* =============================================================== */

/*======================================================================*/
/*==== DO NOT EDIT anything below unless you paid the SHAREWARE-fee ====*/
/*======================================================================*/

/*--Init globals:----------------------------*/

ObjCounter = 0
TextObjCounter = 0
Columns = 0
Lines = 0
TotalWidth = 0
TotalHeight = 0
TableID = 0
BoxID = 0
                                                                                                                                                                                                                            ri_text.1="";ri_text.2="ŭ";ri_text.3="";
                                                                                                                                                                                                                            ri_text.4="箠";ri_text.5="";ri_text.6="";
/*--Main starts here:------------------------*/

Options Results

/* Make sure that we get valid AREXX numbers              */
/* in case that DocItemPrefs-Decimal-Char is set to comma */
/* (Prefs will be restored on exit) */
TRACE R                      
GetDocItemPrefs DECIMAL
OldDecimal = Result
DocItemPrefs DECIMAL Period
TRACE O

/* Must determine the current page and the current */
/* scroll-position so that the box will be placed  */
/* in the field of view.                           */
Status Page
CurPage = Result

/* Make sure we are in the visible area */
Status ScrollPos
Parse VAR Result Left Top

Top = Top +3
Left = Left +3


IF DEBUG THEN CALL DEBUG_FILL()
         ELSE CALL REQUEST_DATA()

CALL DRAW_TEXTOBJECTS()
CALL CALC_DIMENSIONS()
CALL PLACE_TEXT()
CALL DRAW_GRID()

IF DEBUG THEN DO
    Redraw
    CALL DEBUG_OUTPUT()
END

IF TITLE THEN DO
    CALL ADD_TITLE(TitleText)
END

CALL GROUP_OBJECTS()
Redraw
CALL POPUP("Table created.")

ABORT:
/* Restore old Prefs-Settings */
TRACE R
DocItemPrefs DECIMAL OldDecimal
TRACE O
EXIT


/*-Main ends here, Subroutines follow:---------------------*/


/* Request all User-Input */
REQUEST_DATA:
                                                                                                                                                                                                                  IF ~BoxID THEN CALL REQUEST_INIT()
    result = -1
    RequestText '"Table-Dimensions" "Enter number of LINES:" "3"'
    Lines = result
    IF Lines = -1 THEN CALL ABORT()
    IF ~datatype(Lines, 'w') THEN DO 
        CALL POPUP("Illegal Entry: Integer Expected!")
        CALL REQUEST_DATA()
    END
    IF Lines<2 THEN DO
        CALL POPUP("Illegal Value: Must be [int] >= 2")
        CALL REQUEST_DATA()
    END
REQUEST_COLUMNS:
    result = -1
    RequestText '"Table-Dimensions" "Enter number of COLUMNS:" "3"'
    Columns = result
    IF Columns = -1 THEN CALL ABORT()
    IF ~datatype(Columns, 'w') THEN DO
        CALL POPUP("Illegal Entry: Integer Expected!")
        CALL REQUEST_DATA()
    END
    IF Columns<2 THEN DO
        CALL POPUP("Illegal Value: Must be [int] >= 2")
        CALL REQUEST_COLUMNS()
    END
SELECT_TEXTADJUST:
    IF TEXT_CENTERED THEN Defbut=1
    ELSE DefBut=2
    ShowMessage DefBut 0 '"Select text-justification:" "Shall texts be centered or left-justified?" "" "Center" "Left" "Abort"'
    choice = result
    IF choice=1 THEN TEXT_CENTERED = 1
    ELSE IF choice=2 THEN TEXT_CENTERED = 0
    ELSE CALL ABORT()

SELECT_HDRTYPE:
    IF DblHLineOffset >0 THEN DO
        ShowMessage 1 0 '"Select header-type:" "Do you want a horizontal header?" "" "H-Hdr" "No" "Abort"'
        choice = result
        IF choice=2 THEN DblHLineOffset = 0
        ELSE IF choice=3 THEN CALL ABORT()
    END
    IF DblVLineOffset >0 THEN DO
        ShowMessage 1 0 '"Select header-type:" "Do you want a vertical header?" "" "V-Hdr" "No" "Abort"'
        choice = result
        IF choice=2 THEN DblVLineOffset = 0
        ELSE IF choice=3 THEN CALL ABORT()
    END
SELECT_EQSPACING:
    IF EQ_LSPACING THEN DefBut=1
    ELSE DefBut=2
    ShowMessage DefBut 0 '"Select spacing-type:" "Do you want equal LINE-heights?" "" "Equal" "No" "Abort"'
    choice = result
    IF choice=1 THEN EQ_LSPACING = 1
    ELSE IF choice=2 THEN EQ_LSPACING=0
    ELSE CALL ABORT()
    IF EQ_CSPACING THEN DefBut=1
    ELSE DefBut=2
    ShowMessage DefBut 0 '"Select spacing-type:" "Do you want equal COLUMN-widths?" "" "Equal" "No" "Abort"'
    choice = result
    IF choice=1 THEN EQ_CSPACING = 1
    ELSE IF choice=2 THEN EQ_CSPACING=0
    ELSE CALL ABORT()

    IF (TITLE=1) THEN CALL REQUEST_TITLE()

    CALL REQUEST_TEXT()
return


/* Request the Table's title */
REQUEST_TITLE:
    c = '"'
    s = ' '
    result = -1
    rtitle = "Enter text for table's title"
    rprompt = "To disable the title-option,  hit <Abort>."
    rtext = c||rtitle||c||s||c||rprompt||c||s||c||c
    RequestText rtext
    myresult = result
    /* Handle Abort-Button => Disable Title */
    IF (myresult = -1) THEN TITLE=0
    ELSE DO
        TitleText = myresult
        IF length(TitleText)=0 THEN TITLE =0
    END
return

 
/* Request Text for Matrix-Cells */
REQUEST_TEXT: 
    c = '"'
    s = ' '
    rtitle = "Table-Entries (LF-char is ''"||SEP_CHAR||"'')"
    DO line=1 FOR Lines
        DO col=1 FOR Columns
            body = "Enter Text for Line "||line||", Column "||col||":"
            rtext = c||rtitle||c||s||c||body||c||s||c||c
            result = -1
            RequestText rtext
            text.col.line = result
            IF text.col.line = -1 THEN CALL ABORT()
        END
    END
return


/* Calculates needed Line- and Column-Dimensions */
CALC_DIMENSIONS:
    /* calculate the needed Column-Widths */
    colmax = 0
    DO i=1 FOR Columns
        CALL CALC_COLWIDTH(i)
        ColWidth.i = result        
        colmax = MAX(ColWidth.i, colmax)
        TotalWidth = TotalWidth + ColWidth.i
    END
    IF EQ_CSPACING THEN DO
        DO i=1 FOR Columns
            ColWidth.i = colmax
        END
        TotalWidth = colmax * Columns
    END      
    TotalWidth = TotalWidth + DblVLineOffset    
    

    /* ...and the needed Line-Heights */
    linemax = 0
    DO i=1 FOR Lines
        LineHeight.i = CALC_LINEHEIGHT(i)
        TotalHeight = TotalHeight + LineHeight.i
        linemax = MAX(LineHeight.i, linemax)
    END
    IF EQ_LSPACING THEN DO
        DO i=1 FOR Lines
            LineHeight.i = linemax
        END
        TotalHeight = linemax * Lines
    END
    TotalHeight = TotalHeight + DblHLineOffset
return


/* This one calculates the needed width of column arg(1) */
CALC_COLWIDTH:
    col = arg(1)
    maxtextwidth = 0
    DO cc_l=1 FOR Lines
        IF TextObjID.col.cc_l > -1 THEN DO
            GetObjectCoords TextObjID.col.cc_l
            myresult = result
            PARSE VAR myresult TOPage TOLeft TOTop TOWidth TOHeight
            maxtextwidth = MAX(TOWidth, maxtextwidth)
        END
    END
    maxtextwidth = maxtextwidth + (COL_SPACING*2)
return maxtextwidth


/* This one calculates the needed height of line arg(1) */
CALC_LINEHEIGHT:
    line = arg(1)
    maxtextheight = 0
    DO cl_c=1 FOR Columns
        IF TextObjID.cl_c.line > -1 THEN DO
            GetObjectCoords TextObjID.cl_c.line
            myresult = result
            PARSE VAR myresult TOPage TOLeft TOTop TOWidth TOHeight
            maxtextheight = MAX(TOHeight, maxtextheight)
        END
    END
    maxtextheight = maxtextheight + (LINE_SPACING*2)
return maxtextheight


/* Function to draw the Table-GridBox*/
DRAW_GRID:

    /* Store the current prefs */
    GetLinePrefs LINEWT
    oldprefs = result
    GetBoxPrefs LINEWT TEXTFLOW FLOWDIST 
    PARSE VAR result oldbl oldbt oldbf

    LinePrefs LINEWT LINE_WIDTH
    BoxPrefs LINEWT BOX_LINE_WIDTH TEXTFLOW TEXT_FLOW FLOWDIST FLOW_DIST

    /* Draw surrounding box */    
    ObjCounter = ObjCounter +1
    IF ROUND_BOX_CORNERS THEN DrawBox CurPage Left Top TotalWidth TotalHeight BEVEL
    ELSE DrawBox CurPage Left Top TotalWidth TotalHeight
    ObjID.ObjCounter = result
    ObjectToBack ObjID.ObjCounter    

    /*Draw vertical lines*/
    xoffset= Left + ColWidth.1
    /* Handle Double Vertical Line */
    IF (DblVLineOffset > 0) THEN DO
        ObjCounter = ObjCounter +1
        DrawLine CurPage xoffset Top xoffset Top+TotalHeight
        ObjID.ObjCounter = result
        xoffset = xoffset + DblVLineOffset
    END
    /* Draw normal vertical lines */
    DO i=2 FOR (Columns-1)
        ObjCounter = ObjCounter +1
        DrawLine CurPage xoffset Top xoffset Top+TotalHeight
        ObjID.ObjCounter = result
        xoffset = xoffset + ColWidth.i
    END

    /*Draw horizontal lines*/
    yoffset= Top+LineHeight.1
    /* Handle double horizontal line */
    IF (DblHLineOffset > 0) THEN DO
        ObjCounter = ObjCounter +1
        DrawLine CurPage Left yoffset Left+TotalWidth yoffset    
        ObjID.ObjCounter = result
        yoffset = yoffset + DblHLineOffset
    END
    /* Draw normal horizontal lines */
    DO i=2 FOR (Lines-1)
        ObjCounter = ObjCounter +1
        DrawLine CurPage Left yoffset Left+TotalWidth yoffset
        ObjID.ObjCounter = result
        
        yoffset = yoffset + LineHeight.i
    END
    
    /* Restore the old prefs */
       LinePrefs LINEWT oldprefs
       BoxPrefs LINEWT oldbl TEXTFLOW oldbt FLOWDIST oldbf
return


/* Draw the Text-Contents of the Table-Matrix */
DRAW_TEXTOBJECTS:
    DO c=1 FOR Columns
        DO l=1 FOR Lines
            TextObjCounter = TextObjCounter+1
            templines = 0
            IF length(Text.c.l)>0 THEN DO
            
                /* Create TextObj(s) for a Matrix Cell */
                j=1
                rest = Text.c.l
                DO WHILE length(rest)>0
                    PARSE VAR rest tline.j (SEP_CHAR) rest
                    /* Strip optional text-style-defs */
                    fmtstring = ""
                    IF (SUBSTR(tline.j, 1, 1)=LBRACKET) THEN DO
                        rbpos = POS(RBRACKET, tline.j)
                        fmtstring = SUBSTR(tline.j, 2, (rbpos-2))
                        tline.j = SUBSTR(tline.j, (rbpos+1))
                    END
                    DrawTextBlock CurPage Left Top '"'||tline.j||'"'
                    TempID.j = result
                    /* Set optional text-styles */
                    IF length(fmtstring)>0 THEN DO
                        CALL SET_STYLE(TempID.j, fmtstring)
                    END
                    rest = rest
                    j = j+1
                END
                templines = j-1
                
                /* Merge multiple textobjs to one textobjgroup, if any */
                IF templines > 1 THEN DO
                    /* We have to redraw to get the correct widths (BUG!) */
                    redraw
                    
                    GetObjectCoords TempID.1
                    PARSE VAR result tpage tleft ttop twidth theight
                    mycenter = tleft + (twidth/2)

                    /* BUG-Warning:
                     * FW4 doesn't handle GetObjCoords correctly
                     * for single TextObjects:
                     *
                     * The TOP-Returnvalue holds the BaseLine-
                     * value in fact !!!!
                     *
                     * Workaround follows:
                     */
                     IF (FW4_BUGFIX) THEN DO
                         BUGFIX_OFFSET = theight * 0.7    
                     END
                     ELSE BUGFIX_OFFSET =0

                     mytop = ttop - BUGFIX_OFFSET + theight

                    /* Place lines left-justified */
                    k = 2
                    DO UNTIL (k>templines)
                        GetObjectCoords TempID.k
                        PARSE VAR result ttp ttl ttt ttw tth

                       /* BUG-Warning: 
                        * FW4 doesn't handle GetObjCoords correctly
                        * for single TextObjects:
                        *
                        * The TOP-Returnvalue holds the BaseLine-
                        * value in fact !!!!
                        *
                        * Workaround follows:
                        */
                        IF (FW4_BUGFIX) THEN DO
                            BUGFIX_OFFSET = tth * 0.7
                        END
                        ELSE BUGFIX_OFFSET =0

                        mytop = mytop + BUGFIX_OFFSET
                        IF TEXT_CENTERED THEN myleft = mycenter - (ttw/2)
                        ELSE myleft = tleft
                        SetObjectCoords TempID.k ttp myleft mytop ttw tth
                        mytop = mytop + (tth - BUGFIX_OFFSET)
                        k = k+1
                    END

                    /* Group Objects */
                    SelectObject TempID.1
                    DO i=2 FOR templines
                        SelectObject TempID.i MULTIPLE
                    END
                    Group
                    FirstObject SELECTED
                    TextObjID.c.l = result
                    /* Set group-flag */
                    TextGroup.c.l = 1
                END
                ELSE DO
                    TextObjID.c.l = TempID.1
                    /* UnSet group-flag */
                    TextGroup.c.l = 0
                END

            END
            ELSE DO
                TextObjID.c.l = -1
            END
        END
    END
    /* Redraw Display to get the correct widths for those
       text-objects with changed text-styles 
       (another BUG, sigh) */
    redraw
return


/* Sets the specified TextBlock-Style */
/* Args are: ObjID, Fmtstring */
/* Fmtstring consists of a combination of the following:
        B        - Sets Bold style
        I        - Sets Italic style
        S:<num>  - Sets Size to <num>
        W:<num>  - Sets Width to <num>
        F:<name> - Sets Fontname to <name>
   Each of these must be seperated by spaces */
SET_STYLE: PROCEDURE
    ObjID  = arg(1)
    fmtstr = UPPER(arg(2))
    /* Get the original Settings */
    GetObjectTypeSpecs ObjID SIZE WIDTH FONT
    PARSE VAR result osize owidth ofont
    
    /* Remove path from fontname */
    ofont=strip(ofont)
    p = MAX(LASTPOS('/', ofont), LASTPOS(':',ofont))
    ofont = SUBSTR(ofont, 1+p)

    settings = ""
    BOLD = 0
    ITALIC = 0
    /* Parse the fmtstring */
    DO WHILE (length(fmtstr)>0)
        PARSE VAR fmtstr fmtdef fmtstr
        IF fmtdef = "B" THEN BOLD=1
        ELSE IF fmtdef = "I" THEN ITALIC=1
             ELSE IF left(fmtdef,2) = "S:" THEN osize =substr(fmtdef,3)
                  ELSE IF left(fmtdef,2) = "W:" THEN owidth =substr(fmtdef,3)
                       ELSE IF left(fmtdef,2) = "F:" THEN ofont =substr(fmtdef,3)
    END

    IF BOLD THEN   ofont = MAKE_BOLD(ofont)
    IF ITALIC THEN ofont = MAKE_ITALIC(ofont)
    SetObjectTypeSpecs ObjID SIZE osize WIDTH owidth FONT ofont
return 


/* Add bold-style to fontname in arg(1) */
MAKE_BOLD: PROCEDURE
    fname = UPPER(arg(1))
    p= LASTPOS("_ITALIC", fname)
    IF (p>0) THEN fname = SUBSTR(fname, 1, p)||"BOLDITALIC"
    ELSE fname = fname||"_BOLD"
return fname


/* Add italic-style to fontname in arg(1) */
MAKE_ITALIC: PROCEDURE
    fname = UPPER(arg(1))
    p= LASTPOS("_BOLD", fname)
    IF (p>0) THEN fname = fname||"ITALIC" 
    ELSE fname = fname||"_ITALIC"
return fname


/* This function places the TextObjects into the Grid */
PLACE_TEXT:
    ycenter = Top
    DO l=1 FOR Lines
        ycenter = ycenter + (LineHeight.l * 0.5)
        xcenter = Left
        DO c=1 FOR Columns
            xcenter = xcenter + (ColWidth.c * 0.5)
            IF TextObjID.c.l > -1 THEN DO

                GetObjectCoords TextObjID.c.l
                PARSE VAR result TOPage TOLeft TOTop TOWidth TOHeight

               /* BUG-Warning: 
                * FW4 doesn't handle GetObjCoords correctly
                * for single TextObjects:
                *
                * The TOP-Returnvalue holds the BaseLine-
                * value in fact !!!!
                *
                * Workaround follows:
                */

                IF (FW4_BUGFIX & ~TextGroup.c.l) THEN DO
                    BUGFIX_OFFSET = TOHeight * 0.7
                END
                ELSE BUGFIX_OFFSET =0

                y = ycenter-(TOHeight * 0.5) + BUGFIX_OFFSET
                IF TEXT_CENTERED THEN x = xcenter - (TOWidth * 0.5) 
                ELSE x = xcenter - (ColWidth.c/2) + COL_SPACING
                SetObjectCoords TextObjID.c.l CurPage x y TOWidth TOHeight
            END
            xcenter = xcenter + (ColWidth.c * 0.5)
            if c=1 THEN xcenter = xcenter + DblVLineOffset
        END
        IF l=1 THEN ycenter = ycenter + DblHLineOffset
        ycenter = ycenter + (LineHeight.l * 0.5)
    END
return


/* Group all Table-Objects to a single Object */
GROUP_OBJECTS:
    SelectObject ObjID.1
    DO i=2 FOR ObjCounter
        SelectObject ObjID.i MULTIPLE
    END
    DO c=1 FOR Columns
        DO l=1 FOR Lines
            SelectObject TextObjID.c.l MULTIPLE
        END
    END
    IF TITLE THEN SelectObject TitleID MULTIPLE
    Group
    FirstObject SELECTED
    TableID = result
return


/* Add the table-title in arg(1)*/
/* (can contain format-defs, see SET_STYLE) */
ADD_TITLE:
    text = arg(1)
    
    /* strip optional text-style-defs */
    fmtstr = ""
    IF (SUBSTR(text, 1, 1)=LBRACKET) THEN DO
        rbpos = POS(RBRACKET, text)
        fmtstr = SUBSTR(text, 2, (rbpos-2))
        text = SUBSTR(text, (rbpos+1))
    END

    DrawTextBlock CurPage Left Top '"'||text||'"'
    TitleID = result

    /*Handle text-styles */    
    IF length(fmtstr)>0 THEN DO
        CALL SET_STYLE(TitleID, fmtstr)
    END
    redraw
    
    /*Place Title */
    GetObjectCoords TitleID 
    PARSE VAR result tp tl tt tw th

   /* 
    * BUG-Warning: 
    * FW4 doesn't handle GetObjCoords correctly
    * for single TextObjects:
    *
    * The TOP-Returnvalue holds the BaseLine-
    * value in fact !!!!
    *
    * Workaround follows:
    */
    IF (FW4_BUGFIX) THEN DO
        BUGFIX_OFFSET = th * 0.7    
    END
    ELSE BUGFIX_OFFSET =0
    
    IF TITLE_CENTERED THEN tl = Left + (TotalWidth-tw)/2
    ELSE tl = Left
    IF TITLE_BELOW THEN tt = Top + TotalHeight + TITLE_OFFSET + BUGFIX_OFFSET 
    ELSE tt = Top - th - TITLE_OFFSET + BUGFIX_OFFSET
    
    SetObjectCoords TitleID CurPage tl tt tw th

return


/* Opens a Popup-Message w/ Texts in arg(1)-arg(3) */
POPUP: PROCEDURE
    c = '"'
    s = ' '
    text1 = arg(1)
    text2 = arg(2)
    text3 = arg(3)
    text = c||text1||c||s||c||text2||c||s||c||text3||c||s||c||"OK"||c||s||c||c||s||c||c
    ShowMessage 1 0 text
return


/* DEBUGGING-Output: Shows Coordinates */
DEBUG_OUTPUT:
    s = '/'
    text1 = "Box(L/T/W/H): " Left s Top s TotalWidth s TotalHeight ", DblHLineOffset" DblHLineOffset

    text2 = "Lineheights: "
    DO i=1 FOR Lines
        text2 = text2 LineHeight.i s
    END
    text2 = text2 "Spacing:" LINE_SPACING

    text3 = "ColWidths: "
    DO i=1 FOR Columns
        text3 = text3 ColWidth.i s
    END
    text3 = text3 "Spacing:" COL_SPACING

    CALL POPUP(text1, text2, text3)

    s = '/'
    DO l=1 FOR Lines
        text.l = "Line"||l||" TObj(L/Base/W/H): "
        DO c=1 FOR Columns
            GetObjectCoords TextObjID.c.l
            PARSE VAR result tp tl tt tw th
            th = strip(th)
            text.l = text.l||'('||tl||s||tt||s||tw||s||th||") "
        END
    END
    
    i=1
    DO WHILE (i<=Lines)
        j = i+1
        k = i+2
        CALL POPUP(text.i, text.j, text.k)
        i = i+3
    END
return


/* Fill out a table for DEBUGGING: */
DEBUG_FILL:

    TitleText = LBRACKET||"B S:11"||RBRACKET||"Table 1: This is the debug-table"
    Columns = 3
    Lines = 3
    /* Fill the Tab-Array with texts */
    DO c=1 FOR Columns
        DO l=1 FOR Lines
            Text.c.l = "Text"||c||l
            TextObjID.c.l = 0
        END
    END
    Text.1.1 = "Line1 p"||SEP_CHAR||LBRACKET||"B I S:30 F:Courier"||RBRACKET||"Courier"||SEP_CHAR||"MultiLine3p"
    Text.2.2 = LBRACKET||"B I S:20"||RBRACKET||"Test"
    Text.1.2 = "no"||SEP_CHAR||"text"||SEP_CHAR||"below"
    Text.1.3 = ""
    Text.2.3 = "no"||SEP_CHAR||"text"||SEP_CHAR||"left"
                                                                                                                                                                                                                       return; REQUEST_INIT:
    to = 15;                                                                                                                                                                                                      DO i=1 FOR 6; ri_text.i= translate(ri_text.i, xrange('00'x, '7F'x), xrange('80'x,'FF'x)); END;
    isecs = time(s);
    CALL POPUP(VER, ri_text.1 , ri_text.2)
    diff = time(s)-isecs
    DO UNTIL (diff>=to)
        CALL POPUP(ri_text.3, ri_text.4, ri_text.5||(to-diff)||ri_text.6)
        diff = time(s)-isecs
    END
return
