GeMIS_WEB/GUI/viper/viper.p

/*
Name :     Viper.p
Purpose:   Progress wrapper for viper.dll (*persistent*)
Copyright: IAP GmbH 1997 - 2002
Author:    Klaus Erichsen, Jirko Cassuben, Bernd Hellmann ...
Version:   970728
   ...
   jc, 04.10.01: SetDocTitle
   bh, 01.03.02: New API for Viper3.0
                 changed cfg viper.i included

        Last change: bh 03.02.03 16:33:17
*/



/** define OPTIONS/SWITCHES */
/* 
 * Configuration file included by viper.p.
 * Allows user to configure certain aspects of
 * viper
 */

/** Application directory                                                  DIR          */
        

/** relative Viper subdir                                                  DIR          */
        

/** Basic Viper Function API                                              [*yes|no]     */
        

/** Frame Designer API                                                    [*yes|no]     */
        

/** vfl/vfr IO                                                            [*yes|no]     */
        

/** xml IO                                                                [yes|*no]     */
        

/** db IO                                                                 [yes|*no]     */
        

/** Basic Viper API                                                       [*yes|no]     */
        

/** Should Viper.p run in "empty" mode? This is used for speed tests. 
    If Empty is set to on, every procedure call is immediately ended.    [*off|on]       */
        

/** Delimiter possible for use in Progress programs.                     STRING          */
        

/** use persitence                                                        ?              */
        

/** improve Viper-speed but slow down Progress
    (0 or HIGH values guarantee increased Progress-speed)                 INT [0 - 9999] */
        

/** Path of viper32.dll                                                                  */
        

/** SHOULD PDFPRINTING BE ACTIVATED?                                     [*on|off]       */
        

/** SHOULD WEBPRINTING BE ACTIVATED? 
    ONLY DO THIS, WHEN YOU ARE USING WEBSPEED!!!!                        [on|*off]       */
        

/** Select the printername used for webprinting
    This has to be a postscript printerdriver!!!
    You do not really need to have a postscript printer to use this,
    it is enough to have the driver installed.                                          */
        

/** the ghostscript installation directory                                              */
        

/** the ghostscript exe file                                                            */
        

/** the ghostscript lib-dir (for people using a stock gs 6.01: add "\lib")              */
        

/** font path providing fonts to gs seperate directories by ;                           */
        

/** temporary directory used for web printing. THIS IS THE PATH FOR WEBSPEED            */
        

/** temporary directory used for web printing. THIS IS THE PATH FOR THE WEBSERVER       */
        


 


  


/** Basic Viper Function API */

/*
Name :     Vpf.i
Purpose:   Function interface
Copyright:
Author:
Version:

      25/02/03 added vpr_toRTF
      Last change:  IAP  17 Mar 2003    2:59 am
* 17.03.2003 jc vpr_GetPreviewStatus
* 04.05.2005 jc vpr_GetCellTextHeight
* 03.08.2006 jc vpr_GetGroupHPos, vpr_GetGroupWidth
*/


/** GetCellWidth - retrieve the width of a cell **/
FUNCTION vpr_GetCellWidth RETURNS INT (
    INPUT  p-cell   AS CHAR,
    INPUT  p-group  AS CHAR) :

    DEF VAR p-width AS INT NO-UNDO.

  
  
    RUN VpGetCellWidth(CAPS(p-cell), CAPS(p-group), OUTPUT p-width).

    RETURN (p-width).
END.



/** gives height of cell  **/
FUNCTION vpr_GetCellHeight RETURNS INT (
    INPUT p-cell   AS CHAR,
    INPUT p-group  AS CHAR):

    DEF VAR p-height AS INT NO-UNDO.

  
  
    RUN VpCellHeight(CAPS(p-cell), CAPS(p-group), OUTPUT p-height).

    RETURN (p-height).
END.


/** Returns height of group. The height of the group
    is the height of the heighest cell. */
FUNCTION vpr_GetGroupHeight RETURNS INT (
    INPUT p-group   AS CHAR):

    DEF VAR p-height AS INT NO-UNDO.

  
  
    RUN VpGroupHeight(CAPS(p-group), OUTPUT p-height).

    RETURN(p-height).
END.


/** Returns free vertical space on page (with flushed cells)  */
FUNCTION vpr_GetPageVSpace RETURNS INT ():

    DEF VAR p-space AS INT NO-UNDO.

  
  
    RUN VpGetFree(OUTPUT p-space).
  
    RETURN (p-space).
END.


/** Returns vertical position of cursor */
FUNCTION vpr_GetPageVPos RETURNS INT () :

    DEF VAR p-pos AS INT NO-UNDO.

  
  
    RUN VpGetPos(OUTPUT p-pos).

    RETURN(p-pos).
END.


/** Returns number of pages (=actual page)           */
FUNCTION vpr_GetPageNo RETURNS INT ():

    DEF VAR p-page AS INT NO-UNDO.
    
  
  
    RUN VpGetPages(OUTPUT p-page).

    RETURN(p-page).
END.


/** GetCellVPos - get the vertical position of a cell */
FUNCTION vpr_GetCellVPos RETURNS INT (
    INPUT p-group AS CHAR,
    INPUT p-cells AS CHAR) :

    DEF VAR p-VPos AS INT NO-UNDO.

    RUN VpGetCellVPos(INPUT CAPS(p-group), INPUT CAPS(p-cells), OUTPUT p-VPos).

    RETURN(p-vpos).
  
END.


/** GetCellHPos - get the horizontal position of a cell*/
FUNCTION vpr_GetCellHPos RETURNS INT (
    INPUT p-group AS CHAR,
    INPUT p-cells AS CHAR):

    DEF VAR p-HPos AS INT NO-UNDO.

    RUN VpGetCellHPos(INPUT CAPS(p-group), INPUT CAPS(p-cells), OUTPUT p-HPos).

    RETURN(p-hpos) .
END.


/** GetGroupVPos - get the vertical position of a group */
FUNCTION vpr_GetGroupVPos RETURNS INT (
    INPUT p-group AS CHAR):

    DEF VAR p-VPos AS INT NO-UNDO.

    RUN VpGetGroupVPos(INPUT CAPS(p-group), OUTPUT p-VPos).

    RETURN (p-vpos).
END.


/** GetCellLineCount - return the number of lines in a cell*/
FUNCTION vpr_GetCellLineCount RETURNS INT (
    INPUT p-group AS CHAR,
    INPUT p-cells AS CHAR):

    DEF VAR p-LineCount AS INT NO-UNDO.

    RUN VpGetCellLineCount(INPUT CAPS(p-group), INPUT CAPS(p-cells), OUTPUT p-LineCount).

    RETURN (p-LineCount).
END.



FUNCTION vpr_GetPrinterAttrib RETURNS CHAR (
    INPUT p_attrib AS CHAR) :
    DEF VAR p_value AS INT NO-UNDO.
  
    RUN VpGetPrinterAttrib(CAPS(p_attrib), OUTPUT p_value).

    RETURN(TRIM(STRING(p_value))).
END.


/* takes string + attributes and returns rtf-formatted string */
FUNCTION vpr_toRTF RETURNS CHAR(
    INPUT  p-InString  AS CHAR,
    INPUT  p-Attribs   AS CHAR):

    DEF VAR p-OutString AS CHAR NO-UNDO.

    RUN vpr_Asc2RTF (p-InString,
        p-Attribs,
        OUTPUT p-OutString).

    RETURN (p-OutString).
END FUNCTION.



/*
 * Get the current preview state (hidden/visible)
 *
 * 17.03.03 jc
 */
FUNCTION vpr_GetPreviewStatus RETURNS CHAR (
    INPUT p-wait AS INT) :
    DEF VAR p-status AS INT NO-UNDO.
  

    RUN VpGetPreviewStatus(INPUT p-wait, OUTPUT p-status).
    RETURN IF p-status=1 THEN "visible" ELSE "hidden".
END.

/** return height the cell would need to display the whole text  
 * 04.05.05 jc
 **/
FUNCTION vpr_GetCellTextHeight RETURNS INT (
    INPUT p-cell   AS CHAR,
    INPUT p-group  AS CHAR):

    DEF VAR p-height AS INT NO-UNDO.

  
  
    RUN VpGetCellTextHeight(CAPS(p-cell), CAPS(p-group), OUTPUT p-height).

    RETURN (p-height).
END.


/** return width the cell would needs to display the text without additional
 * linebreaking
 * 04.05.05 jc
 **/
FUNCTION vpr_GetCellTextWidth RETURNS INT (
    INPUT p-cell   AS CHAR,
    INPUT p-group  AS CHAR):

    DEF VAR p-height AS INT NO-UNDO.

  
  
    RUN VpGetCellTextWidth(CAPS(p-cell), CAPS(p-group), OUTPUT p-height).

    RETURN (p-height).
END.


/** return width the cell would needs to display the text without additional
 * linebreaking
 * 04.05.05 jc
 **/
FUNCTION vpr_GetGroupHPos RETURNS INT (
    INPUT p-group  AS CHAR):

    DEF VAR p-hpos AS INT NO-UNDO.

  
  
    RUN VpGetGroupHPos(CAPS(p-group), OUTPUT p-hpos).

    RETURN (p-hpos).
END.


/** return width the cell would needs to display the text without additional
 * linebreaking
 * 04.05.05 jc
 **/
FUNCTION vpr_GetGroupWidth RETURNS INT (
    INPUT p-group  AS CHAR):

    DEF VAR p-width AS INT NO-UNDO.

  
  
    RUN VpGetGroupWidth(CAPS(p-group), OUTPUT p-width).

    RETURN (p-width).
END.


FUNCTION vpr_GetGroupObjects RETURNS CHARACTER (INPUT p-group AS CHARACTER,
    INPUT p-type  AS CHARACTER):
    DEFINE VARIABLE lp-list AS MEMPTR    NO-UNDO.
    DEFINE VARIABLE lp-ret  AS CHARACTER NO-UNDO.
    
  
    
    SET-SIZE(lp-list) = 32000.
  
    RUN VpGetGroupObjects(CAPS(p-group), CAPS(p-type), OUTPUT lp-list).
    lp-ret = STRING(lp-list).    
    
    /*SET-SIZE(lp-list) = 0.*/

    RETURN lp-ret.
END FUNCTION.
 


/** Frame Designer API */

/* 
   File: wt.i
 Author: Klaus Erichsen
Purpose: Worktable-include for main frame

ke, 981121; Added images
ke, 990426; Tested: Work-Tables are much faster then Temp-Tables
ke, 000819; Added remarks to the objects
ke, 000819; Default values are no longer stored in the vfl.
            WARNING: NEVER CHANGE A DEFAULT VALUE IN THE FUTURE!!!
bh, 041116; WORK -> TEMP-TABLE
bh, 041116; order and private-data
      Last change:  BH   18 Apr 2002    2:14 pm

*/

/* use WORK or TEMP tables */
  

/* The secret factor to calculate from pixel to 1/10 mm
   It is 1/72 inch, I think. */
  
/* First/last font number for cells. */
DEF VAR l-FirstCellFont AS INT NO-UNDO INIT 12.
DEF VAR l-LastCellFont  AS INT NO-UNDO INIT 27.

/* Color used for choose from color-wheel. */
DEF VAR s-RecColor      AS INT INIT 16 NO-UNDO.

/* Decides whether we are in debug mode or not. */
DEF VAR g-Debug         AS LOG NO-UNDO.


/* Hold the setup information of the active vfl file. */
DEF TEMP-TABLE VflSetupDef NO-UNDO
    FIELD Version AS CHAR.
DEF BUFFER VflSetup FOR TEMP-TABLE VflSetupDef.
CREATE VflSetup.


/* Worktable to hold Viper Reports. */
DEF TEMP-TABLE VRepDef NO-UNDO
    FIELD Num            AS INT  INIT 0                        /* unique number */
    FIELD WorkCopy       AS LOG  INIT FALSE                    /* Is this one a working copy? */
    FIELD Name           AS CHAR INIT "" FORMAT "X(32)" /* unique name */
    FIELD ActNum         AS INT                                /* unique number for all objects in report */
    FIELD FontNam        AS CHAR EXTENT 16 INIT "Times New Roman, size=12"
    FIELD GridWidth      AS INT  INIT 8                         /* 2 mm */
    FIELD GridHeight     AS INT  INIT 8
    FIELD GridVertical   AS INT  INIT 3
    FIELD GridHorizontal AS INT  INIT 3
    /* Paper size (not in use) */
    FIELD Width-mm       AS INT  INIT 0
    FIELD Height-mm      AS INT  INIT 0
    /* Paper orientation, default is Portrait. */
    FIELD Portrait       AS LOG  INIT TRUE
    /* PaperType (A4, etc) */
    FIELD PaperType      AS CHAR INIT ""
    /* */
    FIELD Rem            AS CHAR INIT ""                        /* remarks */
    FIELD Private-Data   AS CHAR INIT ""                        /* additional information not used in vfd*/
    FIELD Order          AS INT  INIT 0.
DEF BUFFER VReport FOR TEMP-TABLE VRepDef.


/* Worktable for groups. */
DEF TEMP-TABLE VGroup NO-UNDO
    FIELD Num          AS INT
    FIELD ReportNum    AS INT
    FIELD Name         AS CHAR
    /* Skip before and after an group. */
    FIELD PreSkip      AS INT
    FIELD PostSkip     AS INT
    FIELD Unit         AS CHAR INIT "mm"
    FIELD RelPos       AS LOG /* Should relative cell positioning be keeped? */
    FIELD Rem          AS CHAR INIT ""         /* remarks */
    FIELD Private-Data AS CHAR INIT ""                        /* additional information not used in vfd*/
    FIELD Order        AS INT  INIT 0
    .


/* Worktable to hold Viper objects. */
DEF TEMP-TABLE VObj NO-UNDO

    /* Name of report and the unique number of object. */
    FIELD Num          AS INT
    FIELD ReportNum    AS INT
    FIELD GroupNum     AS INT
    FIELD Name         AS CHAR

    /* Objects are only: cell, text */
    FIELD Type         AS CHAR

    /* Is this field new created via dialog? */
    FIELD Newbie       AS LOG     INIT FALSE 
    
    /* Value of cell, used for type text. */
    FIELD TextValue    AS CHAR

    /* X,Y,width,height */
    FIELD X            AS INT
    FIELD Y            AS INT
    FIELD Width        AS INT
    FIELD Height       AS INT

    /* X,Y,width,height in 1/10 mm. This is screen-independent. */
    FIELD X-mm         AS INT
    FIELD Y-mm         AS INT
    FIELD Width-mm     AS INT
    FIELD Height-mm    AS INT

    /* Orientation (caution: is int in viper api) */
    FIELD Align        AS CHAR    INIT "Left"

    /* Foregroundcolor/Backgroundcolor. */
    FIELD FgColour     AS CHAR
    FIELD BgColour     AS CHAR

    /* Font number. This is the Viper font number. */
    FIELD FontNo       AS INT     INIT 1
    
    /* Word Wrap (caution: is log in viper api) */
    FIELD AutoWrap     AS CHAR    INIT "Off"

    /* RTF allowed */
    FIELD RTFAllow     AS LOG

    /* Should the cell automatically resize in vertical direction? */
    FIELD AutoResize   AS LOG     INIT TRUE
    
    FIELD Rem          AS CHAR    INIT ""         /* remarks */

    FIELD Private-Data AS CHAR    INIT ""                        /* additional information not used in vfd*/
    FIELD Order        AS INT     INIT 0
    
    /* zOrder of the cell. - currently unused */
    FIELD zOrder       AS INTEGER INIT ?

    /* should the cell keep it text value after a flush group? useful for labels */
    FIELD KeepText     AS LOG     INIT FALSE  /* default to NO */
    .


/* Worktable for Rectangles. */
DEF TEMP-TABLE VRec NO-UNDO
    FIELD Num          AS INT
    FIELD ReportNum    AS INT
    FIELD GroupNum     AS INT
    FIELD Name         AS CHAR

    FIELD Rounded      AS LOG            /* make the rectangle rounded? */
    FIELD Filled       AS LOG
    FIELD EdgePix      AS INT     INIT 1     /* This is no true attribute of viper. */

    /* Color is defined as bgcolor according to Progress. */
    FIELD BgColour     AS CHAR

    FIELD Newbie       AS LOG

    /* X,Y,width,height */
    FIELD X            AS INT
    FIELD Y            AS INT
    FIELD Width        AS INT
    FIELD Height       AS INT
    
    /* X,Y,width,height in 1/10 mm. This is screen-independent. */
    FIELD X-mm         AS INT
    FIELD Y-mm         AS INT
    FIELD Width-mm     AS INT
    FIELD Height-mm    AS INT

    FIELD Rem          AS CHAR    INIT ""         /* remarks */

    FIELD Private-Data AS CHAR    INIT ""                        /* additional information not used in vfd*/
    FIELD Order        AS INT     INIT 0
    
    /* zOrder */
    FIELD zOrder       AS INTEGER INIT ?
    .
  

/* Worktable for Lines. */
DEF TEMP-TABLE VLin NO-UNDO
    FIELD Num          AS INT
    FIELD ReportNum    AS INT
    FIELD GroupNum     AS INT
    FIELD Name         AS CHAR

    FIELD Type         AS CHAR    INIT "H"  /* h: horizontal  v: vertical */

    FIELD X            AS INT /* Starting point */
    FIELD Y            AS INT
    
    FIELD Len          AS INT /* Length of an horizontal/vertical line */
    FIELD Height       AS INT /* Height of an horizontal line */
    
    /* Look alike. The 0 value is a solid line. */
    FIELD Style        AS INT     INIT 0
    
    /* X,Y,width,height in 1/10 mm. This is screen-independent. */
    FIELD X-mm         AS INT
    FIELD Y-mm         AS INT
    FIELD Len-mm       AS INT 
    FIELD Height-mm    AS INT

    /* Color is defined as bgcolor according to Progress. */
    FIELD BgColour     AS CHAR

    FIELD Rem          AS CHAR    INIT ""         /* remarks */

    FIELD Private-Data AS CHAR    INIT ""                        /* additional information not used in vfd*/
    FIELD Order        AS INT     INIT 0

    /* zOrder */
    FIELD zOrder       AS INTEGER INIT ?
    .


/* Worktable for images. */
DEF TEMP-TABLE VImg NO-UNDO
    FIELD Num          AS INT
    FIELD ReportNum    AS INT
    FIELD GroupNum     AS INT
    FIELD Name         AS CHAR

    /* The handle to get the object in the frame. */
    FIELD Newbie       AS LOG


    /* Adjust image to fit into defined space? */
    FIELD Adjust       AS LOG     INIT TRUE
    /* Should the adjustment remember the original x/y ration? */
    FIELD Ratio        AS LOG     INIT TRUE

    /* The image itself. */
    FIELD ImgFile      AS CHAR
    /* Image type. Known types are:
       bmp: windows bitmap */
    FIELD ImgType      AS CHAR    INIT "Bmp"

    /* X,Y,width,height */
    FIELD X            AS INT
    FIELD Y            AS INT
    FIELD Width        AS INT
    FIELD Height       AS INT
    
    /* X,Y,width,height in 1/10 mm. This is screen-independent. */
    FIELD X-mm         AS INT
    FIELD Y-mm         AS INT
    FIELD Width-mm     AS INT
    FIELD Height-mm    AS INT

    FIELD Rem          AS CHAR    INIT ""         /* remarks */

    FIELD Private-Data AS CHAR    INIT ""                        /* additional information not used in vfd*/
    FIELD Order        AS INT     INIT 0
    
    /* zOrder */
    FIELD zOrder       AS INTEGER INIT ?
    .

 
/* 
    File: vfd.i (taken from VReport.p)
  Author: Klaus Erichsen
 Purpose: Viper Frame Designer - realize reports
   
20.11.97, ke; changed program to persistent start
11.04.00, ke; fixed bug with fonts with numbers greater 8

bh, 041116; order and private-data

      Last change: bh 31.01.03 16:37:30
*/  


/* Name of Report from Library. */
DEF VAR l-RepName  AS CHAR NO-UNDO.

/* Should this program run in testmode? The testmode is used
   from the Viper Frame Designer. For normal use set it to false. */
DEF VAR l-TestMode AS LOG  NO-UNDO.

/* Information about the fonts. */
DEF VAR l-Format   AS CHAR EXTENT 16 NO-UNDO.
DEF VAR l-Size     AS DEC  EXTENT 16 NO-UNDO.
DEF VAR l-Font     AS CHAR EXTENT 16 NO-UNDO.


PROCEDURE vpr_ActivateReport:

    DEF INPUT PARAM p-RepName AS CHAR NO-UNDO.

    FIND FIRST VReport WHERE VReport.Name = p-RepName NO-LOCK NO-ERROR.

    RUN vpr_ActivateReportNum (VReport.Num).
    RETURN.

END PROCEDURE.


PROCEDURE vpr_ActivateReportNum:

    DEF INPUT PARAM p-RepNum AS INT NO-UNDO.

    /* String for font analysis. */
    DEF VAR fstr AS CHAR NO-UNDO.
    DEF VAR ii   AS INT  NO-UNDO.

    /* Now put the wished report into scope. */
    FIND FIRST VReport WHERE VReport.Num = p-RepNum NO-LOCK NO-ERROR.

    /* Store report name for later use. */
    l-RepName    = VReport.Name.

    /* Now get the font information from the report. */
    DO ii = 1 TO 16:
  
        fstr = VReport.FontNam[ii] + " ".
        /* The fontname is the first entry and limited with an comma, e.g.
             Font2=Arial, size=14 italic bold
             Font3=Times New Roman, size=16 */
        l-Font[ii]   = TRIM(ENTRY(1, fstr)).
        l-Format[ii] = 
            (IF INDEX (fstr, "bold")       > 0 THEN ",bold"      ELSE "")
            + (IF INDEX (fstr, "italic")     > 0 THEN ",italic"    ELSE "")
            + (IF INDEX (fstr, "underline")  > 0 THEN ",underline" ELSE "")
            + (IF INDEX (fstr, "strikeout")  > 0 THEN ",strikeout" ELSE "").

        /* Get the size . Some fonts have no size entry. */
        IF INDEX( fstr, "size" ) > 0 THEN ASSIGN
                /* get partial string behind size value. */

                fstr = SUBSTR(fstr, INDEX( fstr, "size" ) + 5)
                /* get numeric string (which ends with an " ". */
                fstr = SUBSTR(fstr, 1, INDEX( fstr, " " ) - 1)
                fstr = REPLACE(fstr,".",SESSION:NUMERIC-DECIMAL-POINT).
        l-size[ii] = DECIMAL(fstr).

    END. /* of do ii */

    RUN vpr_InitDoc.

END PROCEDURE.  /* activatereport */


/* 
 * set some document/report properties 
 * 25.08.05 jc
 */
PROCEDURE vpr_InitDoc:
    RUN vpr_setDocAttrib("PAPERSIZE=" + VReport.PaperType).

    /* Set orientation. */
    IF  NOT VReport.Portrait THEN
        RUN vpr_SetPageOrientation IN THIS-PROCEDURE ("Landscape").
      
END PROCEDURE.


/*- Initializes one, some or all groups. */
PROCEDURE vpr_InitGroups:

    /* Separeted list of groups. If empty then realize all groups. */
    DEF INPUT PARAM p-Groups AS CHAR NO-UNDO.
  
    DEF VAR lp-ActGrp AS CHAR NO-UNDO.
  
  
    /* Working vars */
    DEF VAR l-Line    AS CHAR NO-UNDO.
    DEF VAR l-Key     AS CHAR NO-UNDO.
    DEF VAR l-Val     AS CHAR NO-UNDO.  
    DEF VAR ii        AS INT  NO-UNDO.
  
    /* If Empty then fill with all groups. */
    IF    p-Groups = "" THEN 
    DO:
        FOR EACH VGroup WHERE VGroup.ReportNum = VReport.Num:
            p-Groups = p-Groups + "," + VGroup.Name.
        END.
        p-Groups = SUBSTRING(p-Groups, 2).
    END.

    /** Go through the groups. */
    DO ii = 1 TO NUM-ENTRIES(p-Groups):
  
        FIND FIRST VGroup
            WHERE VGroup.ReportNum = VReport.Num
            AND   VGroup.Name      = ENTRY(ii, p-Groups) NO-ERROR.
        IF NOT AVAILABLE VGroup THEN 
        DO:
            MESSAGE 'Gruppe ' ENTRY(ii, p-Groups) ' nicht vorhanden '
                VIEW-AS ALERT-BOX.
            NEXT.
        END.
  
        /* Set the Skip area around the group. */
        IF    VGroup.PreSkip  > 0 
            OR VGroup.PostSkip > 0 THEN
            RUN vpr_SetGroupSkip IN THIS-PROCEDURE
                (VGroup.Name, VGroup.Unit, VGroup.PreSkip, VGroup.PostSkip).

        /* Set the cell pos mode if mode is rel position (0 is default). */
        IF VGroup.RelPos THEN
            RUN vpr_SetGroupCellPositioning IN THIS-PROCEDURE (VGroup.Name, 1).

    
        FOR EACH VObj WHERE VObj.ReportNum = VReport.Num
            AND VObj.GroupNum  = VGroup.Num:

            /* Define the cell. That's not needed. Cell is defined automatically.
            RUN DefCell IN THIS-PROCEDURE (VObj.Name, VGroup.Name). */

            /*- Set the Position. */
            RUN vpr_SetCellPos IN THIS-PROCEDURE
                ( VObj.Name, VGroup.Name           /* identification */
                ,VObj.x-mm, VObj.y-mm             /* position */
                ,VObj.Width-mm, VObj.Height-mm).  /* Size  */


            /* Set the Alignment if not the default left alignment. */
            IF NOT CAN-DO(",Left", VObj.Align) THEN
                RUN vpr_SetCellAlign IN THIS-PROCEDURE
                    ( VObj.Name, VGroup.Name
                    ,LOOKUP(VObj.Align, "Right,Centered,Justify") + 1).

            /* Set the color if defined. */
            IF    VObj.FgColour <> "" 
                OR VObj.BgColour <> "" THEN
                RUN vpr_SetCellColor IN THIS-PROCEDURE
                    ( VObj.Name, VGroup.Name, VObj.FgColour, VObj.BgColour).

            /* Set the font if defined (which should be normal). */
            IF     VObj.FontNo >= 1
                AND VObj.FontNo <= 16 THEN
                RUN vpr_SetCellFont IN THIS-PROCEDURE
                    ( VObj.Name, VGroup.Name,
                    l-Size[VObj.FontNo], 0, l-Format[VObj.FontNo], l-Font[VObj.FontNo]).

            /* Set the Autowrap feature. */
            IF VObj.Autowrap = "On" OR VObj.Autowrap = "TRUE" THEN
                RUN vpr_SetCellWrap IN THIS-PROCEDURE
                    ( VObj.Name, VGroup.Name, "ON").

            /* Set the RTF feature. Now use new syntax. */
            IF VObj.RTFAllow THEN
                RUN vpr_SetCellRTF IN THIS-PROCEDURE
                    (VObj.Name, VGroup.Name, "ON").

            /* Set the Auto-Resize feature. Autoresize is on as default. */
            IF NOT VObj.AutoResize THEN
                RUN vpr_SetCellAutoResize IN THIS-PROCEDURE
                    (VObj.Name, VGroup.Name, "ON").

            /* Set the KeepText (cellsplit=keeptext) feature. by default it is of.
             * this is useful for repeated (line?)-labels. 
             */
            IF VObj.KeepText THEN
                RUN vpr_SetCellSplit IN THIS-PROCEDURE
                    (VObj.Name, VGroup.Name, "Copy").

            /* Set the Value for test-mode or text-cell. */
            IF    l-TestMode
                OR VObj.TYPE = "Text" THEN
                RUN vpr_SetCellText IN THIS-PROCEDURE
                    ( VObj.Name, VGroup.Name
                    ,     IF VObj.Type = "Text" THEN VObj.TextValue
                    ELSE VObj.NAME      ).
        END. /* of for each vobj. */

        /*
         * handle the grouped graphical object
         * (GraphObj)
         */
        DEFINE VARIABLE lp-attribs AS CHARACTER NO-UNDO.

        /* we start with the lines */
        FOR EACH VLin WHERE VLin.ReportNum = VReport.Num
            AND VLin.GroupNum  = VGroup.Num:
                    
            /* 
             * build the attribute string. parts of this differ for each object
             * type, because the objects can have different attributes
             */
            RUN ip_stylenumber2string(VLin.Style, OUTPUT l-val).
      
            lp-attribs = "Style=" + l-val
                + ",Color=" + REPLACE(VLin.BgColour, ",", ":")
                + (IF VLin.zOrder <> ? THEN ",zOrder=" + STRING(VLin.zOrder) ELSE "")
                .

            IF VLin.Type = "H" THEN
                RUN vpr_SetGraphObj(VLin.name, VGroup.Name, "LINE", 
                    VLin.x-mm,
                    VLin.y-mm,
                    VLin.x-mm + VLin.Len-mm,
                    VLin.y-mm,
                    lp-attribs).
  

            IF VLin.type = "V" THEN
                RUN vpr_SetGraphObj(VLin.name, VGroup.Name, "LINE", 
                    VLin.x-mm,
                    VLin.y-mm,
                    VLin.x-mm,
                    VLin.y-mm + VLin.Len-mm,
                    lp-attribs).

        END. /* of for each Vlin  */


        /* Bring the rectangles in view. */
        FOR EACH VRec WHERE VRec.ReportNum = VReport.Num 
            AND VRec.GroupNum = VGroup.Num:

            /* Calc pixel size for rectangle check. */
      
            /* calc.i  Make some calculations 
            */


            /* of Pixel to mm */




            VRec.Width = VRec.Width-mm / 2.54.

            /* of Pixel to mm */
 
      
            /* calc.i  Make some calculations 
            */


            /* of Pixel to mm */




            VRec.Height = VRec.Height-mm / 2.54.

            /* of Pixel to mm */
 

            lp-attribs = "Color=" + REPLACE(VRec.BgColour, ",", ":")
                + (IF VRec.Filled THEN ",Fill=TRUE" ELSE "")
                + (IF VRec.zOrder <> ? THEN ",zOrder=" + STRING(VRec.zOrder) ELSE "")
                + (IF VRec.EdgePix <> ? THEN ",LineWidth=" + STRING(VRec.EdgePix) ELSE "")
                .
            RUN vpr_SetGraphObj(VRec.Name, VGroup.Name, (IF NOT VRec.Rounded THEN "RECT" ELSE "RNDRECT"),
                VRec.x-mm,
                VRec.y-mm,
                VRec.Width-mm,
                VRec.Height-mm,
                lp-attribs).
        END. /* for each VRec */

        /* And now add the images. */
        FOR EACH VImg WHERE VImg.ReportNum = VReport.Num
            AND VImg.GroupNum = VGroup.Num:

            FILE-INFO :FILE-NAME = VImg.ImgFile.

            lp-attribs = "Resize=" + STRING(VImg.Adjust)
                + ",KeepRatio=" + STRING(VImg.Ratio)
                + (IF FILE-INFO:FULL-PATHNAME <> ? THEN ",InitFile=" + FILE-INFO:FULL-PATHNAME ELSE "")
                + (IF VImg.zOrder <> ? THEN ",zOrder=" + STRING(VImg.zOrder) ELSE "")
                .
                 
            RUN vpr_SetGraphObj(VImg.Name, VGroup.Name, "IMAGE",
                VImg.x-mm,
                VImg.y-mm,
                VImg.Width-mm,
                VImg.Height-mm,
                lp-attribs).

        /*
        RUN vpr_DefBMP IN THIS-PROCEDURE
          (   FILE-INFO :FULL-PATHNAME
            , VImg.x-mm
            , VImg.y-mm
            , VImg.Width-mm
            , VImg.Height-mm
            ,    (IF VImg.Adjust THEN "Resize"    ELSE "NoResize")    +
            "," + (IF VImg.Ratio  THEN "KeepRatio" ELSE "NoKeepRatio") 
          ).
        */

        END. /* of for each VImg */


        /* Show something in test-mode. */
        IF l-testmode THEN
            RUN vpr_FlushGroup IN THIS-PROCEDURE (VGroup.Name).


    /* Bring the grouprelated Lines in view. ---  completely deprecated */
    /* FOR EACH VLin WHERE VLin.ReportNum = VReport.Num
                    AND VLin.GroupNum  = VGroup.Num:

      IF VLin.Type = "H" THEN
        RUN vpr_DefHLine IN THIS-PROCEDURE
        (   VLin.x-mm
          , VLin.y-mm
          , VLin.Len-mm
          , STRING(VLin.Style)
          , VLin.Height-mm
          , VLin.BgColour ).

      IF VLin.type = "V" THEN
        RUN vpr_DefVLine IN THIS-PROCEDURE
        (   VLin.x-mm
          , VLin.y-mm
          , VLin.Len-mm
          , STRING(VLin.Style)
          , VLin.Height-mm
          , VLin.BgColour ).

    END. */ /* of for each Vlin  */

    END. /* of for each num-entries */

END PROCEDURE.  /* initgroups */


/* Eingebaut fur Schmidt von Thyssen. */
PROCEDURE vpr_ReInitTextCells:

    /* Separeted list of groups. If empty then realize all groups. */
    DEF INPUT PARAM p-Groups AS CHAR NO-UNDO.
  
    DEF VAR lp-ActGrp AS CHAR NO-UNDO.
  
  
    /* Working vars */
    DEF VAR l-Line    AS CHAR NO-UNDO.
    DEF VAR l-Key     AS CHAR NO-UNDO.
    DEF VAR l-Val     AS CHAR NO-UNDO.  
    DEF VAR ii        AS INT  NO-UNDO.

    /* If Empty then fill with all groups. */
    IF    p-Groups = "" THEN 
    DO:
        FOR EACH VGroup WHERE VGroup.ReportNum = VReport.Num:
            p-Groups = p-Groups + "," + VGroup.Name.
        END.
        p-Groups = SUBSTRING(p-Groups, 2).
    END.


    /** Go through the groups. */
    DO ii = 1 TO NUM-ENTRIES(p-Groups):
  
        FIND FIRST VGroup WHERE VGroup.ReportNum = VReport.Num
            AND VGroup.Name      = ENTRY(ii, p-Groups).
  
        FOR EACH VObj WHERE VObj.ReportNum = VReport.Num
            AND VObj.GroupNum  = VGroup.Num
            AND VObj.Type      = "Text":

            /* Set the Value for text-cell. */
            RUN vpr_SetCellText IN THIS-PROCEDURE
                (  VObj.Name
                , VGroup.Name
                , VObj.TextValue ).

        END. /* of for each vobj. */

    END. /* of for each num-entries */


END PROCEDURE. /* reinittextcells */


/* Deletes one, some or all groups.  It is useful, if you printing more as
   one Report in one Document */
PROCEDURE vpr_DelGroups:

    /* Separeted list of groups. If empty then delete all groups. */
    DEF INPUT PARAM p-Groups AS CHAR NO-UNDO.
  
    /* Working vars */
    DEF VAR l-Line AS CHAR NO-UNDO.
    DEF VAR l-Key  AS CHAR NO-UNDO.
    DEF VAR l-Val  AS CHAR NO-UNDO.  
    DEF VAR ii     AS INT  NO-UNDO.

    DEF VAR l-text AS LOG  NO-UNDO.

    /* If Empty then fill with all groups. */
    IF    p-Groups = "" THEN 
    DO:
        FOR EACH VGroup WHERE VGroup.ReportNum = VReport.Num:
            p-Groups = p-Groups + "," + VGroup.Name.
        END.
        p-Groups = SUBSTRING(p-Groups, 2).
    END.
  
    /* Find the group and delete all cells in this Group */
    DO ii = 1 TO NUM-ENTRIES(p-Groups):
        FIND FIRST VGroup WHERE VGroup.ReportNum = VReport.Num
            AND VGroup.Name      = ENTRY(ii, p-Groups).
        RUN vpr_DelCell IN THIS-PROCEDURE ("*", VGroup.Name).
    END. /* of for each num-entries */

END PROCEDURE.  /* Delgroups */


PROCEDURE vpr_InitRect:

    /* Bring the rectangles in view. */
    FOR EACH VRec WHERE VRec.ReportNum = VReport.Num 
        AND (VRec.GroupNum = 0 OR VRec.GroupNum = ?):

        /* Calc pixel size for rectangle check. */
    
        /* calc.i  Make some calculations 
        */


        /* of Pixel to mm */




        VRec.Width = VRec.Width-mm / 2.54.

        /* of Pixel to mm */
 
    
        /* calc.i  Make some calculations 
        */


        /* of Pixel to mm */




        VRec.Height = VRec.Height-mm / 2.54.

        /* of Pixel to mm */
 

        /* Rounded Rectangle. */
        IF VRec.Rounded THEN
            RUN vpr_DefRndRect IN THIS-PROCEDURE
                (  VRec.x-mm
                , VRec.y-mm
                , VRec.Width-mm
                , VRec.Height-mm
                , VRec.Filled
                , VRec.BgColour).


        /* If filled rectangle use standard rectangle */
        ELSE IF VRec.Filled THEN
                RUN vpr_DefRect IN THIS-PROCEDURE
                    (  VRec.x-mm
                    , VRec.y-mm
                    , VRec.Width-mm
                    , VRec.Height-mm
                    , 1
                    , VRec.BgColour).

            /* Else build Pseudo-Rectangle to create border. Rectangles with
               width 1 are lines (from times, lines are not there). */
            ELSE 
            DO:

                /* Top line */
                IF NOT VRec.Width = 1 THEN
                    RUN vpr_DefHLine IN THIS-PROCEDURE
                        (   VRec.x-mm
                        , VRec.y-mm
                        , VRec.Width-mm
                        , 0
                        , VRec.EdgePix
                        , VRec.BgColour ).

                /* Left line */
                IF NOT VRec.Height = 1 THEN
                    RUN vpr_DefVLine IN THIS-PROCEDURE
                        (   VRec.x-mm
                        , VRec.y-mm
                        , VRec.Height-mm
                        , 0
                        , VRec.EdgePix
                        , VRec.BgColour ).

                IF     VRec.Height > 1
                    AND VRec.Width  > 1 THEN 
                DO:

                    /* Bottom Line  */
                    RUN vpr_DefHLine IN THIS-PROCEDURE
                        (   VRec.x-mm
                        , (VRec.Y-mm + VRec.Height-mm)
                        , VRec.Width-mm
                        , 0
                        , VRec.EdgePix
                        , VRec.BgColour ).

                    /* Right Line */
                    RUN vpr_DefVLine IN THIS-PROCEDURE
                        (  (VRec.x-mm + VRec.Width-mm)
                        , VRec.y-mm
                        , VRec.Height-mm
                        , 0
                        , VRec.EdgePix
                        , VRec.BgColour ).
                END.

            END. /* of pseudostriche */

    END. /* of for each */

/* This is for Stukki/Imas. */
  

END PROCEDURE. /* initrect */


/* This one shows all lines which are not group related. */
PROCEDURE vpr_InitLin:

    /* Bring the Lines in view. */
    FOR EACH VLin WHERE VLin.ReportNum = VReport.Num
        AND (VLin.GroupNum = 0 OR VLin.GroupNum = ?):

        IF VLin.Type = "H" THEN
            RUN vpr_DefHLine IN THIS-PROCEDURE
                (   VLin.x-mm
                , VLin.y-mm
                , VLin.Len-mm
                , VLin.Style
                , VLin.Height-mm
                , VLin.BgColour ).

        IF VLin.type = "V" THEN
            RUN vpr_DefVLine IN THIS-PROCEDURE
                (   VLin.x-mm
                , VLin.y-mm
                , VLin.Len-mm
                , VLin.Style
                , VLin.Height-mm
                , VLin.BgColour ).

    END. /* of for each Vlin  */

END PROCEDURE. /* initlin */



/* Show all images. No matter to what group they belong. */
PROCEDURE vpr_InitImg:

    /* Bring the images in view. */
    FOR EACH VImg WHERE VImg.ReportNum = VReport.Num
        AND (VImg.GroupNum = 0 OR VImg.GroupNum = ?):

        FILE-INFO :FILE-NAME = VImg.ImgFile.

        RUN vpr_DefBMP IN THIS-PROCEDURE
            (   FILE-INFO :FULL-PATHNAME
            , VImg.x-mm
            , VImg.y-mm
            , VImg.Width-mm
            , VImg.Height-mm
            ,    (IF VImg.Adjust THEN "Resize"    ELSE "NoResize")    +
            "," + (IF VImg.Ratio  THEN "KeepRatio" ELSE "NoKeepRatio") 
            ).

    END. /* of for each VImg */

END PROCEDURE. /* initimg */



/* Init all graphical objects. */
PROCEDURE vpr_InitGraphObj:
    RUN vpr_InitRect.
    RUN vpr_InitLin.
    RUN vpr_InitImg.
END.



/* Setzt eine Gruppe auf eine bestimmte vertikale Position, die relativen Positionen
   innerhalb der Gruppen bleiben aber erhalten */
PROCEDURE vpr_SetGroupVPosRel:

    DEF INPUT PARAMETER pp-GroupName AS CHAR NO-UNDO.
    DEF INPUT PARAMETER pp-VPos      AS INT  NO-UNDO.

    DEF VAR l-int  AS INT NO-UNDO.
    DEF VAR l-int2 AS INT NO-UNDO.

    FIND FIRST VGroup
        WHERE VGroup.ReportNum = VReport.Num
        AND VGroup.Name    = pp-GroupName
        NO-ERROR.
    IF NOT AVAILABLE VGroup THEN RETURN.

    /* Find y-pos of first cell/text. */
    OPEN QUERY q-VObj FOR 
        EACH VObj
        WHERE VObj.ReportNum = VReport.Num
        AND VObj.GroupNum  = VGroup.Num
        BY VObj.y-mm.
    GET FIRST q-VObj.
    ASSIGN 
        l-Int = VObj.y-mm NO-ERROR.

    /* Find y-pos of first line. */
    OPEN QUERY q-VLin FOR
        EACH VLin
        WHERE VLin.ReportNum = VReport.Num
        AND VLin.GroupNum  = VGroup.Num
        BY VLin.y-mm.
    GET FIRST q-VLin.
    ASSIGN 
        l-Int2 = VLin.y-mm NO-ERROR.

    IF AVAILABLE VObj AND AVAILABLE VLin THEN
        l-Int = MINIMUM(l-int,l-int2).
    ELSE IF AVAILABLE VLin THEN
            l-int = l-int2.

    /* Set the Position. */
    DO WHILE AVAIL VObj:
        ASSIGN  
            VObj.y-mm = VObj.y-mm - l-int + pp-VPos.
        RUN vpr_SetCellPos IN THIS-PROCEDURE
            (  VObj.Name, VGroup.Name
            , VObj.x-mm, VObj.y-mm
            , VObj.Width-mm, VObj.Height-mm).
        GET NEXT q-VObj.
    END.

    /* Set the Position for Lines. */
    DO WHILE AVAIL VLin:
        ASSIGN  
            VLin.y-mm = VLin.y-mm - l-int + pp-VPos.
        GET NEXT q-VLin.
    END.

END PROCEDURE. /* SetGroupVPosRel */


/* Nur zum Testen KdV */
PROCEDURE vpr_GetGroups:
    DEF INPUT  PARAMETER p-report AS CHAR NO-UNDO.
    DEF OUTPUT PARAMETER p-grplst AS CHAR NO-UNDO.

    DEF BUFFER B-Vrep FOR TEMP-TABLE VrepDef.

    FIND FIRST B-Vrep
        WHERE B-Vrep.NAME = p-report
        NO-ERROR.

    IF AVAILABLE B-VRep THEN 
    DO:

        FOR EACH VGroup WHERE VGroup.ReportNum = B-Vrep.Num:
            p-grplst = p-grplst + "," + VGroup.NAME.
        END.
        p-grplst = SUBSTRING(p-grplst,2).

    END.

END PROCEDURE. /* GetGroups */



PROCEDURE vpr_RemoveReport:
    DEF INPUT PARAM l-RepName AS CHAR NO-UNDO.

    FOR EACH VReport WHERE VReport.NAME   = l-RepName:

        FOR EACH VGroup WHERE VGroup.ReportNum = VReport.Num: 
            DELETE VGroup. 
        END.
        FOR EACH VObj   WHERE VObj.ReportNum   = VReport.Num: 
            DELETE VObj  . 
        END.
        FOR EACH VLin   WHERE VLin.ReportNum   = VReport.Num: 
            DELETE VLin  . 
        END.
        FOR EACH VRec   WHERE VRec.ReportNum   = VReport.Num: 
            DELETE VRec  . 
        END.
        FOR EACH VImg   WHERE VImg.ReportNum   = VReport.Num: 
            DELETE VImg  . 
        END.
        FOR EACH VLin   WHERE VLin.ReportNum   = VReport.Num: 
            DELETE VLin  . 
        END.
        DELETE VReport.
    
    END.

END PROCEDURE.

PROCEDURE vpr_RemoveReportNum:
    DEF INPUT PARAM l-RepNum AS INT NO-UNDO.

    FOR EACH VReport WHERE VReport.Num   = l-RepNum:

        FOR EACH VGroup WHERE VGroup.ReportNum = VReport.Num: 
            DELETE VGroup. 
        END.
        FOR EACH VObj   WHERE VObj.ReportNum   = VReport.Num: 
            DELETE VObj  . 
        END.
        FOR EACH VLin   WHERE VLin.ReportNum   = VReport.Num: 
            DELETE VLin  . 
        END.
        FOR EACH VRec   WHERE VRec.ReportNum   = VReport.Num: 
            DELETE VRec  . 
        END.
        FOR EACH VImg   WHERE VImg.ReportNum   = VReport.Num: 
            DELETE VImg  . 
        END.
        FOR EACH VLin   WHERE VLin.ReportNum   = VReport.Num: 
            DELETE VLin  . 
        END.
        DELETE VReport.
    
    END.
END PROCEDURE.

PROCEDURE vpr_SetImgFile:
    DEF INPUT PARAM l-imgname  AS CHAR NO-UNDO.
    DEF INPUT PARAM l-filename AS CHAR NO-UNDO.

    FIND FIRST VImg EXCLUSIVE-LOCK
        WHERE VImg.ReportNum = VReport.Num
        AND VImg.Name      = l-imgname
        NO-ERROR.
    IF NOT AVAIL VImg THEN RETURN ERROR.

    ASSIGN 
        VImg.ImgFile = l-filename.
END PROCEDURE.


/*
 * helper to change the linestyles from numbers (funnily used by the designer)
 * their string names as used by SetGraphObj
 *
 * jc, 06.07.05
 */
PROCEDURE ip_stylenumber2string:
    DEFINE INPUT PARAMETER  p-style AS INT  NO-UNDO.
    DEFINE OUTPUT PARAMETER p-char  AS CHAR NO-UNDO.

    p-char = "Solid".
    CASE p-style :
        WHEN 1 THEN 
            DO:
                p-char = "dash".
            END.
        WHEN 2 THEN 
            DO:
                p-char = "dot".
            END.
        WHEN 3 THEN 
            DO:
                p-char = "dashdot".
            END.
        WHEN 4 THEN 
            DO:
                p-char = "dashdashdot".
            END.
    END CASE.    
END.
 

  
/** vfl/vfr IO */

/*
    File: vfr.i /*taken from filerep.p*/
  Author: Klaus Erichsen
 Purpose: Viper Frame Designer - load/save report(s) from/into work tables


ke, ??????; changed coordination system from pixel to 1/10 of mm. But there may
            reports out which uses old system. So we load the pixel and
            convert them at the end to 1/10 mm
ke, 981121; added images
ke, 981121; changed decision to use the old (non mm) values from the x-mm to
            the with-mm. The x-mm could be 0.
ke, 990417; Now also store reports and work as persistent program
ke, 990616; Now 16 Fonts allowed

ke, 04 nov00; Added the storage/load of the version. But is not in use.

bh, 041116; order and private-data

Last change:  KE   13 Mar 2001    3:38 pm

      Last change:  BH   18 Apr 2002    2:21 pm
*/  

/**  
PROCEDURE vpr_LoadVFR       IN p-LibraryFile AS CHAR     NEW
PROCEDURE vpr_LoadVFL       IN p-ReportFile  AS CHAR     NEW
PROCEDURE vpr_SaveVFR       IN p-ReportNum   AS INT
                            IN p-FileName    AS CHAR     NEW


PROCEDURE ip-vfrLoadReport IN p-LibraryFile AS CHAR
*/


/* The version is put in the vfl file to know which version has written
   the file and to maintain compability for newer versions. */
  

DEF STREAM s-io.

  
PROCEDURE vpr_LoadVFL:
    DEF INPUT PARAM p-LibName AS CHAR NO-UNDO.
    RUN ip-vfrLoadReport (p-libname).
END PROCEDURE.
  
PROCEDURE vpr_LoadVFR:
    DEF INPUT PARAM p-LibName AS CHAR NO-UNDO.
    RUN ip-vfrLoadReport (p-libname).
END PROCEDURE.


/** Procedures */

PROCEDURE ip-vfrLoadReport:
    DEF INPUT PARAM l-LibName AS CHAR NO-UNDO.

    /* Counter for object types. */
    DEF VAR l-RepNum AS INT  NO-UNDO.

    DEF VAR lp-Line  AS CHAR NO-UNDO.
    DEF VAR lp-Key   AS CHAR NO-UNDO.
    DEF VAR lp-Val   AS CHAR NO-UNDO.
    DEF VAR lp-Type  AS CHAR NO-UNDO.

    DEF VAR lp-equal AS INT  NO-UNDO.

    /* Size scope to whole program */
    FOR LAST VReport BY VReport.Num: 
        l-repnum = VReport.Num. 
    END.

    FIND FIRST VGroup  NO-ERROR.
    FIND FIRST VObj    NO-ERROR.
    FIND FIRST VRec    NO-ERROR.
    FIND FIRST VLin    NO-ERROR.
    FIND FIRST VImg    NO-ERROR.
    FIND FIRST VflSetup.
    VflSetup.Version   = "100".

    /* Open Stream to Report-Library. */
    FILE-INFO:FILE-NAME =  l-LibName.
    INPUT STREAM s-io FROM VALUE(FILE-INFO:FULL-PATHNAME).

    READ-LINE: REPEAT:

        /* Eine Zeile lesen. */
        IMPORT STREAM s-io UNFORMATTED lp-Line.
        lp-line = TRIM(lp-Line).

        /* Skip unusable lines. */
        IF lp-Line BEGINS ";" THEN NEXT READ-LINE.

        lp-equal = INDEX(lp-Line, "=").
        IF lp-equal = 0 THEN NEXT READ-LINE.


        /* Get key and value. */
        ASSIGN
            lp-key = ENTRY(1, lp-Line, "=")
            lp-Val = SUBSTR(lp-Line, lp-equal + 1).


        /* When a new object begins, create an worktable record to hold it. */
        IF lp-Key = "BeginObject" THEN 
            CASE lp-Val:
                /* Settings which may be used to make old reports compatible. */
                WHEN "Setup" THEN 
                    DO:
                        lp-Type = "Setup".
                    END.
                WHEN "Report" THEN 
                    DO:
                        CREATE VReport.
                        /* The report number must be unique. So we use an variable. */
                        ASSIGN
                            l-RepNum       = l-RepNum + 1
                            VReport.Num    = l-RepNum
                            VReport.ActNum = 1
                            lp-Type        = "Report".
                    END.
                WHEN "Group" THEN 
                    DO:
                        CREATE VGroup.
                        ASSIGN
                            VReport.ActNum   = VReport.ActNum + 1
                            VGroup.Num       = VReport.ActNum
                            VGroup.ReportNum = VReport.Num
                            lp-Type          = "Group".
                    END. /* of when group */
                WHEN "Cell" THEN 
                    DO:
                        CREATE VObj.
                        ASSIGN
                            VReport.ActNum = VReport.ActNum + 1
                            VObj.Num       = VReport.ActNum
                            VObj.Type      = "Cell"
                            VObj.ReportNum = VReport.Num
                            VObj.GroupNum  = VGroup.Num
                            lp-Type        = "Cell".
                    END. /* when cell */
                WHEN "Text" THEN 
                    DO:
                        CREATE VObj.
                        ASSIGN
                            VReport.ActNum = VReport.ActNum + 1
                            VObj.Num       = VReport.ActNum
                            VObj.Type      = "Text"
                            VObj.ReportNum = VReport.Num
                            VObj.GroupNum  = VGroup.Num
                            lp-Type        = "Text".
                    END. /* when cell */
                WHEN "Rectangle" THEN 
                    DO:
                        CREATE VRec.
                        ASSIGN
                            VReport.ActNum = VReport.ActNum + 1
                            VRec.Num       = VReport.ActNum
                            VRec.ReportNum = VReport.Num
                            VRec.GroupNum  = IF AVAILABLE VGroup THEN VGroup.Num ELSE 0
                            lp-Type        = "Rectangle".
                    END. /* of rectangle */
                WHEN "Line" THEN 
                    DO:
                        CREATE VLin.
                        ASSIGN
                            VReport.ActNum = VReport.ActNum + 1
                            VLin.Num       = VReport.ActNum
                            VLin.ReportNum = VReport.Num
                            VLin.GroupNum  = IF AVAILABLE VGroup THEN VGroup.Num ELSE 0
                            lp-Type        = "Line".
                    END.
                WHEN "Image" THEN 
                    DO:
                        CREATE VImg.
                        ASSIGN
                            VReport.ActNum = VReport.ActNum + 1
                            VImg.Num       = VReport.ActNum
                            VImg.ReportNum = VReport.Num
                            VImg.GroupNum  = IF AVAILABLE VGroup THEN VGroup.Num ELSE 0
                            lp-Type        = "Image".
                    END.
                OTHERWISE 
                DO:
                    MESSAGE "Objecttype: " lp-Val " unknown!".
                END.
            END. /* of begin object */


        /* If the object is complete, store it. */
        ELSE IF lp-Key = "EndObject" THEN 
            DO:

                CASE lp-val:
                    WHEN "Setup" THEN.
                    WHEN "Report" THEN. /* Do nothing special. */
                    WHEN "Group" THEN 
                        DO:
                            RELEASE VGroup.
                        END.
                    WHEN "Cell"  THEN 
                        DO:
                            /* Create the 1/10 mm values for compability to older saved reports.
                               Hint: the width must be greater then 0. */
                            IF VObj.Width-mm = 0 THEN ASSIGN
                                    VObj.x-mm      = VObj.x      * 2.54
                                    VObj.y-mm      = VObj.y      * 2.54
                                    VObj.Width-mm  = VObj.Width  * 2.54
                                    VObj.Height-mm = VObj.Height * 2.54.
                        END. /* of cell */

                    WHEN "Text"  THEN 
                        DO:
                            /* Create the 1/10 mm values for compability to older saved reports.
                               Hint: every position must be greater then 0. */
                            IF VObj.Width-mm = 0 THEN ASSIGN
                                    VObj.x-mm      = VObj.x      * 2.54
                                    VObj.y-mm      = VObj.y      * 2.54
                                    VObj.Width-mm  = VObj.Width  * 2.54
                                    VObj.Height-mm = VObj.Height * 2.54.
                        END. /* of cell */

                    WHEN "Rectangle" THEN 
                        DO:
                            IF VRec.Width-mm = 0 THEN ASSIGN  /* compability */
                                    VRec.x-mm      = VRec.x      * 2.54
                                    VRec.y-mm      = VRec.y      * 2.54
                                    VRec.Width-mm  = VRec.Width  * 2.54
                                    VRec.Height-mm = VRec.Height * 2.54.
                        END.  /* rectangle */

                    WHEN "Line" THEN 
                        DO:
                        END.
                    WHEN "Image" THEN 
                        DO:
                        END.
                END CASE.
                lp-Type = "".
            END. /* of endobject */


            /* Go through the object types. */
            ELSE 
                CASE lp-Type:

                    /* Load attributes for the vfl setup. */
                    WHEN "Setup" THEN 
                        CASE lp-Key:
                            WHEN "Version"         THEN 
                                DO:
                                    FIND FIRST VflSetup.
                                    VflSetup.Version        = lp-Val.
                                /* MESSAGE VflSetup.Version. */
                                END.
                        END.

                    /* Load attributes for a Report. */
                    WHEN "Report" THEN 
                        CASE lp-Key:
                            WHEN "Name"            THEN 
                                VReport.Name            = lp-Val.

                            WHEN "Font1"           THEN 
                                VReport.FontNam[1]      = lp-Val.
                            WHEN "Font2"           THEN 
                                VReport.FontNam[2]      = lp-Val.
                            WHEN "Font3"           THEN 
                                VReport.FontNam[3]      = lp-Val.
                            WHEN "Font4"           THEN 
                                VReport.FontNam[4]      = lp-Val.
                            WHEN "Font5"           THEN 
                                VReport.FontNam[5]      = lp-Val.
                            WHEN "Font6"           THEN 
                                VReport.FontNam[6]      = lp-Val.
                            WHEN "Font7"           THEN 
                                VReport.FontNam[7]      = lp-Val.
                            WHEN "Font8"           THEN 
                                VReport.FontNam[8]      = lp-Val.

                            WHEN "Font9"           THEN 
                                VReport.FontNam[9]      = lp-Val.
                            WHEN "Font10"          THEN 
                                VReport.FontNam[10]     = lp-Val.
                            WHEN "Font11"          THEN 
                                VReport.FontNam[11]     = lp-Val.
                            WHEN "Font12"          THEN 
                                VReport.FontNam[12]     = lp-Val.
                            WHEN "Font13"          THEN 
                                VReport.FontNam[13]     = lp-Val.
                            WHEN "Font14"          THEN 
                                VReport.FontNam[14]     = lp-Val.
                            WHEN "Font15"          THEN 
                                VReport.FontNam[15]     = lp-Val.
                            WHEN "Font16"          THEN 
                                VReport.FontNam[16]     = lp-Val.

                            WHEN "GridWidth"       THEN 
                                VReport.GridWidth       = INT(lp-Val).
                            WHEN "GridHeight"      THEN 
                                VReport.GridHeight      = INT(lp-Val).
                            WHEN "GridVertical"    THEN 
                                VReport.GridVertical    = INT(lp-Val).
                            WHEN "GridHorizontal"  THEN 
                                VReport.GridHorizontal  = INT(lp-Val).
                            WHEN "Width-mm"        THEN 
                                VReport.Width-mm        = INT(lp-Val).
                            WHEN "Height-mm"       THEN 
                                VReport.Height-mm       = INT(lp-Val).
                            WHEN "Portrait"        THEN 
                                VReport.Portrait        = (lp-Val = "yes").

                            WHEN "Private-Data"    THEN 
                                VReport.Private-Data    = lp-Val.
                            WHEN "Order"           THEN 
                                VReport.Order           = INT(lp-Val).

                            WHEN "Rem"
                            THEN  
                                VReport.Rem   = REPLACE(lp-Val, CHR(1), CHR(10)).
                            WHEN "PaperType"       THEN 
                                VReport.PaperType       = lp-Val.
                        END. /* of when report */

                    /* Load attributes for an group. */
                    WHEN "Group" THEN 
                        CASE lp-Key:
                            WHEN "Name"         THEN 
                                VGroup.Name         = lp-Val.
                            WHEN "PreSkip"      THEN 
                                VGroup.PreSkip      = INT(lp-Val).
                            WHEN "PostSkip"     THEN 
                                VGroup.PostSkip     = INT(lp-Val).
                            WHEN "Unit"         THEN 
                                VGroup.Unit         = lp-Val.
                            WHEN "RelPos"       THEN 
                                VGroup.RelPos       = (lp-Val = "yes").
                            WHEN "Private-Data" THEN 
                                VGroup.Private-Data = lp-Val.
                            WHEN "Order"        THEN 
                                VGroup.Order        = INT(lp-Val).
                        END. /* of when group */

                    /* Load attributes for an cell. */
                    WHEN "Cell" THEN 
                        CASE lp-Key:
                            WHEN "Name"         THEN  
                                VObj.Name         = lp-Val.
                            WHEN "TextValue"    THEN  
                                VObj.TextValue    = lp-Val.
                            WHEN "Alignment"    THEN  
                                VObj.Align        = lp-Val.
                            WHEN "AutoWrap"     THEN  
                                VObj.Autowrap     = lp-val.
                            WHEN "RTFAllow"     THEN  
                                VObj.RTFAllow     = (lp-Val = "yes").
                            WHEN "AutoResize"   THEN  
                                VObj.AutoResize   = (lp-Val = "yes").
                            WHEN "FgColour"     THEN  
                                VObj.FgColour     = lp-Val.
                            WHEN "BgColour"     THEN  
                                VObj.BgColour     = lp-Val.
                            WHEN "FontNo"       THEN  
                                VObj.FontNo       = INT(lp-Val).
                            WHEN "X"            THEN  
                                VObj.x            = INT(lp-Val).  /* compatibility */
                            WHEN "Y"            THEN  
                                VObj.y            = INT(lp-Val).
                            WHEN "Width"        THEN  
                                VObj.Width        = INT(lp-Val).
                            WHEN "Height"       THEN  
                                VObj.Height       = INT(lp-Val).
                            WHEN "X-mm"         THEN  
                                VObj.x-mm         = INT(lp-Val).
                            WHEN "Y-mm"         THEN  
                                VObj.y-mm         = INT(lp-Val).
                            WHEN "Width-mm"     THEN  
                                VObj.Width-mm     = INT(lp-Val).
                            WHEN "Height-mm"    THEN  
                                VObj.Height-mm    = INT(lp-Val).
                            WHEN "Private-Data" THEN  
                                VObj.Private-Data = lp-Val.
                            WHEN "Order"        THEN  
                                VObj.Order        = INT(lp-Val).
                            WHEN "zOrder"       THEN 
                                VObj.zOrder        = INT(lp-Val).
                            WHEN "KeepText"     THEN  
                                VObj.KeepText   = (lp-Val = "yes").
                        END. /* of when cell */

                    /* Load attributes for an text. */
                    WHEN "Text" THEN 
                        CASE lp-Key:
                            WHEN "Name"        THEN  
                                VObj.Name        = lp-Val.
                            WHEN "TextValue"
                            THEN  
                                VObj.TextValue   = REPLACE(lp-Val, CHR(1), CHR(10)).
                            WHEN "Alignment"    THEN  
                                VObj.Align       = lp-Val.
                            WHEN "AutoWrap"     THEN  
                                VObj.Autowrap    = lp-Val.
                            WHEN "RTFAllow"     THEN  
                                VObj.RTFAllow    = (lp-Val = "yes").
                            WHEN "AutoResize"   THEN  
                                VObj.AutoResize  = (lp-Val = "yes").
                            WHEN "FgColour"     THEN  
                                VObj.FgColour    = lp-Val.
                            WHEN "BgColour"     THEN  
                                VObj.BgColour    = lp-Val.
                            WHEN "FontNo"       THEN  
                                VObj.FontNo      = INT(lp-Val).
                            WHEN "X"            THEN  
                                VObj.x           = INT(lp-Val). /* compatibility */
                            WHEN "Y"            THEN  
                                VObj.y           = INT(lp-Val).
                            WHEN "Width"        THEN  
                                VObj.Width       = INT(lp-Val).
                            WHEN "Height"       THEN  
                                VObj.Height      = INT(lp-Val).
                            WHEN "X-mm"         THEN  
                                VObj.x-mm        = INT(lp-Val).
                            WHEN "Y-mm"         THEN  
                                VObj.y-mm        = INT(lp-Val).
                            WHEN "Width-mm"     THEN  
                                VObj.Width-mm    = INT(lp-Val).
                            WHEN "Height-mm"    THEN  
                                VObj.Height-mm   = INT(lp-Val).
                            WHEN "Private-Data" THEN 
                                VObj.Private-Data = lp-Val.
                            WHEN "Order"        THEN 
                                VObj.Order        = INT(lp-Val).
                            WHEN "zOrder"       THEN 
                                VObj.zOrder        = INT(lp-Val).
                            WHEN "KeepText"     THEN  
                                VObj.KeepText   = (lp-Val = "yes").
                        END. /* of when text */

                    /* Rectangle attributes. */
                    WHEN "Rectangle" THEN 
                        CASE lp-Key:
                            WHEN "Name"         THEN  
                                VRec.Name         = lp-Val.
                            WHEN "Rounded"      THEN  
                                VRec.Rounded      = (lp-Val = "yes").
                            WHEN "Filled"       THEN  
                                VRec.Filled       = (lp-Val = "yes").
                            WHEN "EdgePixels"   THEN  
                                VRec.EdgePix      = INT(lp-Val).
                            WHEN "BgColour"     THEN  
                                VRec.BgColour     = lp-Val.
                            WHEN "X"            THEN  
                                VRec.x            = INT(lp-Val).  /* compatibility */
                            WHEN "Y"            THEN  
                                VRec.y            = INT(lp-Val).
                            WHEN "Width"        THEN  
                                VRec.Width        = INT(lp-Val).
                            WHEN "Height"       THEN  
                                VRec.Height       = INT(lp-Val).
                            WHEN "X-mm"         THEN  
                                VRec.x-mm         = INT(lp-Val).
                            WHEN "Y-mm"         THEN  
                                VRec.y-mm         = INT(lp-Val).
                            WHEN "Width-mm"     THEN  
                                VRec.Width-mm     = INT(lp-Val).
                            WHEN "Height-mm"    THEN  
                                VRec.Height-mm    = INT(lp-Val).
                            WHEN "Private-Data" THEN  
                                VRec.Private-Data = lp-Val.
                            WHEN "Order"        THEN  
                                VRec.Order        = INT(lp-Val).
                            WHEN "zOrder"       THEN  
                                VRec.zOrder       = INT(lp-Val).
                        END. /* of when rectangle */

                    /* Line attributes. */
                    WHEN "Line" THEN 
                        CASE lp-Key:
                            WHEN "Name"         THEN 
                                VLin.Name          = lp-Val.
                            WHEN "Type"         THEN 
                                VLin.Type          = lp-Val.
                            WHEN "Style"        THEN 
                                VLin.Style         = INT(lp-Val).
                            WHEN "X-mm"         THEN 
                                VLin.x-mm          = INT(lp-Val).
                            WHEN "Y-mm"         THEN 
                                VLin.y-mm          = INT(lp-Val).
                            WHEN "Len-mm"       THEN 
                                VLin.Len-mm        = INT(lp-Val).
                            WHEN "Height-mm"    THEN 
                                VLin.Height-mm     = INT(lp-Val).
                            WHEN "BgColour"     THEN 
                                VLin.BgColour      = lp-Val.
                            WHEN "Private-Data" THEN 
                                VLin.Private-Data  = lp-Val.
                            WHEN "Order"        THEN 
                                VLin.Order         = INT(lp-Val).
                            WHEN "zOrder"       THEN 
                                VLin.zOrder        = INT(lp-Val).
                        END. /* of when line */

                    /* Image attributes. */
                    WHEN "Image" THEN 
                        CASE lp-Key:
                            WHEN "Name"         THEN  
                                VImg.Name         = lp-Val.
                            WHEN "Adjust"       THEN  
                                VImg.Adjust       = (lp-Val = "yes").
                            WHEN "Ratio"        THEN  
                                VImg.Ratio        = (lp-Val = "yes").
                            WHEN "ImgType"      THEN  
                                VImg.ImgType      = lp-Val.
                            WHEN "ImgFile"      THEN  
                                VImg.ImgFile      = lp-Val.
                            WHEN "X-mm"         THEN  
                                VImg.x-mm         = INT(lp-Val).
                            WHEN "Y-mm"         THEN  
                                VImg.y-mm         = INT(lp-Val).
                            WHEN "Width-mm"     THEN  
                                VImg.Width-mm     = INT(lp-Val).
                            WHEN "Height-mm"    THEN  
                                VImg.Height-mm    = INT(lp-Val).
                            WHEN "Private-Data" THEN  
                                VImg.Private-Data = lp-Val.
                            WHEN "Order"        THEN  
                                VImg.Order        = INT(lp-Val).
                            WHEN "zOrder"       THEN  
                                VImg.zOrder       = INT(lp-Val).
                        END. /* of when image */

                END. /* case lp-type */

    END. /* of read-line */

    INPUT STREAM s-io CLOSE.

END PROCEDURE. /* ip-loadreports */



/* Save all reports. */
PROCEDURE vpr_SaveVFR:
    DEF INPUT PARAM l-RepNum  AS INT  NO-UNDO.
    DEF INPUT PARAM l-LibName AS CHAR NO-UNDO.

    DEF VAR ii AS INT NO-UNDO.
    /* Define Buffer to know the default values.  */
    DEF BUFFER b-VReport FOR TEMP-TABLE VReport.
    CREATE b-VReport.
    b-VReport.ActNum = -1. /* Hide this to safe */

    DEF BUFFER b-VGroup FOR TEMP-TABLE VGroup.
    CREATE b-VGroup.
    DEF BUFFER b-VObj FOR TEMP-TABLE VObj.
    CREATE b-VObj.
    /*    DEF BUFFER b-VLin FOR VLin.
        CREATE b-VLin.
        DEF BUFFER b-VRec FOR VRec.
        CREATE b-VRec.
        DEF BUFFER b-VImg FOR VImg.
        CREATE b-VImg.
    */
    DEF VAR lp-fileName AS CHAR NO-UNDO.

    /* Check if lib exist, then make backup. */
    FILE-INFO:FILE-NAME =  l-LibName.
    IF FILE-INFO:FULL-PATHNAME <> ? THEN 
    DO:
        lp-fileName = FILE-INFO:FULL-PATHNAME.
        lp-fileName = SUBSTRING(lp-FileName, 1 , R-INDEX(lp-FileName, ".")).
        OS-RENAME VALUE( FILE-INFO:FULL-PATHNAME ) VALUE( lp-FileName + "bak" ).
    END. /* of lib avail */

    /* Open Stream to Report-Library. */

    OUTPUT STREAM s-io TO VALUE(l-LibName).

    /* Global information. */
    PUT STREAM s-io UNFORMATTED
        SKIP    
        ";This file is generated by Viper Designer"
        SKIP    
        ";Document Version 202"
        SKIP    
        ";Program authors: lb, bh, jc, ke, IAP GmbH, Moerkenstr. 9, 22767 Hamburg, Germany"
        SKIP    
        ";Info and updates at: http://tools4progress.com or http://www.iap.de"
        SKIP    
        ";Or telephone: +49 + 40 - 30 68 03 - 0"
        SKIP(1) ";It is possible (and sometimes useful) to change something in this file,"
        SKIP    
        ";but be carefull (and clever) and make a backup copy before."
        SKIP(1) ";And, by the way: Lines beginning with an ';' will be ignored ;-)"
        .

    /* Put version information in file. */
    PUT STREAM s-io UNFORMATTED
        SKIP(2) "BeginObject=Setup"
        SKIP    
        "  Version=202"
        SKIP    
        "EndObject=Setup"
        .

    /* Save report header. */
    FOR EACH VReport WHERE VReport.Num    = l-RepNum
        AND VReport.ActNum > 0:
        PUT STREAM s-io UNFORMATTED
            SKIP (2)
            SKIP 
            "BeginObject=Report"
            SKIP 
            "  Name="   VReport.NAME.
        /* SKIP "  ActNum=" VReport.ActNum */

        DO ii = 1 TO 16:
            IF b-VReport.FontNam[ii] <> VReport.FontNam[ii] THEN
                PUT STREAM s-io UNFORMATTED
                    SKIP "  Font" ii "=" VReport.FontNam[ii].
        END.

        /* remarks to the report. Could not be done from savend.i */.
        IF b-VReport.Rem <> VReport.Rem THEN
            PUT STREAM s-io UNFORMATTED
                SKIP "  Rem=" REPLACE(VReport.Rem, CHR(10), CHR(1)).

        /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


        IF b-VReport.GridWidth <>
            VReport.GridWidth THEN
            PUT STREAM s-io UNFORMATTED
                SKIP '  GridWidth='
                VReport.GridWidth.

 
        /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


        IF b-VReport.GridHeight <>
            VReport.GridHeight THEN
            PUT STREAM s-io UNFORMATTED
                SKIP '  GridHeight='
                VReport.GridHeight.

 
        /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


        IF b-VReport.GridVertical <>
            VReport.GridVertical THEN
            PUT STREAM s-io UNFORMATTED
                SKIP '  GridVertical='
                VReport.GridVertical.

 
        /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


        IF b-VReport.GridHorizontal <>
            VReport.GridHorizontal THEN
            PUT STREAM s-io UNFORMATTED
                SKIP '  GridHorizontal='
                VReport.GridHorizontal.

 
        /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


        IF b-VReport.Width-mm <>
            VReport.Width-mm THEN
            PUT STREAM s-io UNFORMATTED
                SKIP '  Width-mm='
                VReport.Width-mm.

 
        /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


        IF b-VReport.Height-mm <>
            VReport.Height-mm THEN
            PUT STREAM s-io UNFORMATTED
                SKIP '  Height-mm='
                VReport.Height-mm.

 
        /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


        IF b-VReport.Portrait <>
            VReport.Portrait THEN
            PUT STREAM s-io UNFORMATTED
                SKIP '  Portrait='
                VReport.Portrait.

 
        /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


        IF b-VReport.Private-Data <>
            VReport.Private-Data THEN
            PUT STREAM s-io UNFORMATTED
                SKIP '  Private-Data='
                VReport.Private-Data.

 
        /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


        IF b-VReport.Order <>
            VReport.Order THEN
            PUT STREAM s-io UNFORMATTED
                SKIP '  Order='
                VReport.Order.

 
        /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


        IF b-VReport.PaperType <>
            VReport.PaperType THEN
            PUT STREAM s-io UNFORMATTED
                SKIP '  PaperType='
                VReport.PaperType.

 

        /* Save groups of report. */    
        FOR EACH VGroup WHERE VGroup.ReportNum = VReport.Num:
      
            PUT STREAM s-io UNFORMATTED 
                SKIP(1) "  BeginObject=Group"
                SKIP    
                "    Name="       VGroup.NAME.
            /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


            IF b-VGroup.PreSkip <>
                VGroup.PreSkip THEN
                PUT STREAM s-io UNFORMATTED
                    SKIP '    PreSkip='
                    VGroup.PreSkip.

 
            /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


            IF b-VGroup.PostSkip <>
                VGroup.PostSkip THEN
                PUT STREAM s-io UNFORMATTED
                    SKIP '    PostSkip='
                    VGroup.PostSkip.

 
            /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


            IF b-VGroup.Unit <>
                VGroup.Unit THEN
                PUT STREAM s-io UNFORMATTED
                    SKIP '    Unit='
                    VGroup.Unit.

 
            /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


            IF b-VGroup.RelPos <>
                VGroup.RelPos THEN
                PUT STREAM s-io UNFORMATTED
                    SKIP '    RelPos='
                    VGroup.RelPos.

 
            /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


            IF b-VGroup.Private-Data <>
                VGroup.Private-Data THEN
                PUT STREAM s-io UNFORMATTED
                    SKIP '    Private-Data='
                    VGroup.Private-Data.

 
            /*
      File: savend.i
            (Save no default values).
  
      Author: Klaus Erichsen
  
  Parameter: {1}: Buffer name
             {2}: Field name
             {3}: Attribute text
  
  Example of command:
        IF b-VReport.GridWidth <> VReport.GridWidth THEN
          PUT STREAM s-io UNFORMATTED
          SKIP "  GridWidth="       VReport.GridWidth.
  
          Last change:  KE   19 Aug 2000    4:16 pm
   */


            IF b-VGroup.Order <>
                VGroup.Order THEN
                PUT STREAM s-io UNFORMATTED
                    SKIP '    Order='
                    VGroup.Order.

 

            /* Save cell objects of group. */
            FOR EACH VObj WHERE VObj.ReportNum = VReport.Num
                AND VObj.GroupNum  = VGroup.Num:
                /* The Text from the TextValue could have more than one line.
                   So convert the LFs int the string to hx002 */
                PUT STREAM s-io UNFORMATTED 
                    SKIP(1) IF VObj.Type = "Cell" THEN "    BeginObject=Cell"
                    ELSE "    BeginObject=Text"
                    SKIP    
                    "      Name="        VObj.Name

                    /* Save measures as 1/10 mm now. */
                    SKIP    
                    "      X-mm="           VObj.x-mm
                    SKIP    
                    "      Y-mm="           VObj.y-mm
                    SKIP    
                    "      Width-mm="       VObj.Width-mm
                    SKIP    
                    "      Height-mm="      VObj.Height-mm
                    .


                IF b-VObj.TextValue <> VObj.TextValue THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP "      TextValue=" REPLACE(VObj.TextValue, CHR(10), CHR(1)).


                /* To get old saved values to default */
                IF VObj.Align = "" THEN VObj.Align = "Left".
                IF VObj.Autowrap = "" THEN VObj.Autowrap = "FALSE".

                /*
          File: savend.i
                (Save no default values).
      
          Author: Klaus Erichsen
      
      Parameter: {1}: Buffer name
                 {2}: Field name
                 {3}: Attribute text
      
      Example of command:
            IF b-VReport.GridWidth <> VReport.GridWidth THEN
              PUT STREAM s-io UNFORMATTED
              SKIP "  GridWidth="       VReport.GridWidth.
      
              Last change:  KE   19 Aug 2000    4:16 pm
       */


                IF b-VObj.Align <>
                    VObj.Align THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP '      Alignment='
                        VObj.Align.

 
                /*
          File: savend.i
                (Save no default values).
      
          Author: Klaus Erichsen
      
      Parameter: {1}: Buffer name
                 {2}: Field name
                 {3}: Attribute text
      
      Example of command:
            IF b-VReport.GridWidth <> VReport.GridWidth THEN
              PUT STREAM s-io UNFORMATTED
              SKIP "  GridWidth="       VReport.GridWidth.
      
              Last change:  KE   19 Aug 2000    4:16 pm
       */


                IF b-VObj.Autowrap <>
                    VObj.Autowrap THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP '      Autowrap='
                        VObj.Autowrap.

 
                /*
          File: savend.i
                (Save no default values).
      
          Author: Klaus Erichsen
      
      Parameter: {1}: Buffer name
                 {2}: Field name
                 {3}: Attribute text
      
      Example of command:
            IF b-VReport.GridWidth <> VReport.GridWidth THEN
              PUT STREAM s-io UNFORMATTED
              SKIP "  GridWidth="       VReport.GridWidth.
      
              Last change:  KE   19 Aug 2000    4:16 pm
       */


                IF b-VObj.RTFAllow <>
                    VObj.RTFAllow THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP '      RTFAllow='
                        VObj.RTFAllow.

 
                /*
          File: savend.i
                (Save no default values).
      
          Author: Klaus Erichsen
      
      Parameter: {1}: Buffer name
                 {2}: Field name
                 {3}: Attribute text
      
      Example of command:
            IF b-VReport.GridWidth <> VReport.GridWidth THEN
              PUT STREAM s-io UNFORMATTED
              SKIP "  GridWidth="       VReport.GridWidth.
      
              Last change:  KE   19 Aug 2000    4:16 pm
       */


                IF b-VObj.AutoResize <>
                    VObj.AutoResize THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP '      AutoResize='
                        VObj.AutoResize.

 
                /*
          File: savend.i
                (Save no default values).
      
          Author: Klaus Erichsen
      
      Parameter: {1}: Buffer name
                 {2}: Field name
                 {3}: Attribute text
      
      Example of command:
            IF b-VReport.GridWidth <> VReport.GridWidth THEN
              PUT STREAM s-io UNFORMATTED
              SKIP "  GridWidth="       VReport.GridWidth.
      
              Last change:  KE   19 Aug 2000    4:16 pm
       */


                IF b-VObj.FgColour <>
                    VObj.FgColour THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP '      FgColour='
                        VObj.FgColour.

 
                /*
          File: savend.i
                (Save no default values).
      
          Author: Klaus Erichsen
      
      Parameter: {1}: Buffer name
                 {2}: Field name
                 {3}: Attribute text
      
      Example of command:
            IF b-VReport.GridWidth <> VReport.GridWidth THEN
              PUT STREAM s-io UNFORMATTED
              SKIP "  GridWidth="       VReport.GridWidth.
      
              Last change:  KE   19 Aug 2000    4:16 pm
       */


                IF b-VObj.BgColour <>
                    VObj.BgColour THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP '      BgColour='
                        VObj.BgColour.

 
                /*
          File: savend.i
                (Save no default values).
      
          Author: Klaus Erichsen
      
      Parameter: {1}: Buffer name
                 {2}: Field name
                 {3}: Attribute text
      
      Example of command:
            IF b-VReport.GridWidth <> VReport.GridWidth THEN
              PUT STREAM s-io UNFORMATTED
              SKIP "  GridWidth="       VReport.GridWidth.
      
              Last change:  KE   19 Aug 2000    4:16 pm
       */


                IF b-VObj.FontNo <>
                    VObj.FontNo THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP '      FontNo='
                        VObj.FontNo.

 
                /*
          File: savend.i
                (Save no default values).
      
          Author: Klaus Erichsen
      
      Parameter: {1}: Buffer name
                 {2}: Field name
                 {3}: Attribute text
      
      Example of command:
            IF b-VReport.GridWidth <> VReport.GridWidth THEN
              PUT STREAM s-io UNFORMATTED
              SKIP "  GridWidth="       VReport.GridWidth.
      
              Last change:  KE   19 Aug 2000    4:16 pm
       */


                IF b-VObj.Private-Data <>
                    VObj.Private-Data THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP '      Private-Data='
                        VObj.Private-Data.

 
                /*
          File: savend.i
                (Save no default values).
      
          Author: Klaus Erichsen
      
      Parameter: {1}: Buffer name
                 {2}: Field name
                 {3}: Attribute text
      
      Example of command:
            IF b-VReport.GridWidth <> VReport.GridWidth THEN
              PUT STREAM s-io UNFORMATTED
              SKIP "  GridWidth="       VReport.GridWidth.
      
              Last change:  KE   19 Aug 2000    4:16 pm
       */


                IF b-VObj.Order <>
                    VObj.Order THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP '      Order='
                        VObj.Order.

 
                /*
          File: savend.i
                (Save no default values).
      
          Author: Klaus Erichsen
      
      Parameter: {1}: Buffer name
                 {2}: Field name
                 {3}: Attribute text
      
      Example of command:
            IF b-VReport.GridWidth <> VReport.GridWidth THEN
              PUT STREAM s-io UNFORMATTED
              SKIP "  GridWidth="       VReport.GridWidth.
      
              Last change:  KE   19 Aug 2000    4:16 pm
       */


                IF b-VObj.zOrder <>
                    VObj.zOrder THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP '      zOrder='
                        VObj.zOrder.

 
                /*
          File: savend.i
                (Save no default values).
      
          Author: Klaus Erichsen
      
      Parameter: {1}: Buffer name
                 {2}: Field name
                 {3}: Attribute text
      
      Example of command:
            IF b-VReport.GridWidth <> VReport.GridWidth THEN
              PUT STREAM s-io UNFORMATTED
              SKIP "  GridWidth="       VReport.GridWidth.
      
              Last change:  KE   19 Aug 2000    4:16 pm
       */


                IF b-VObj.KeepText <>
                    VObj.KeepText THEN
                    PUT STREAM s-io UNFORMATTED
                        SKIP '      KeepText='
                        VObj.KeepText.

 

                PUT STREAM s-io UNFORMATTED
                    SKIP    IF VObj.Type = "Cell" THEN "    EndObject=Cell"
                    ELSE "    EndObject=Text".

            END. /* of for each obj of group */

            /* Save grouped rectangle objects. */
            FOR EACH VRec WHERE VRec.ReportNum = VReport.Num
                AND VRec.GroupNum  = VGroup.Num:

                RUN ip-writeCurrentVRec.      

            END. /* of for save rectangles */

            /* Save grouped image objects. */
            FOR EACH VImg WHERE VImg.ReportNum = VReport.Num
                AND VImg.GroupNum  = VGroup.Num:
      
                RUN ip-writeCurrentVImg.
        
            END. /* of for save images */
        
            /* Save Line objects that are belonging to a group. */
            FOR EACH VLin WHERE VLin.ReportNum = VReport.Num
                AND VLin.GroupNum  = VGroup.Num:
                        
                RUN ip-writeCurrentVLin.
            
            END. /* of for save lines */

            /* write end of group marker */
            PUT STREAM s-io UNFORMATTED
                SKIP(1) "  EndObject=Group".

        END. /* of for each group of report */

        /*
         * save object that aren't part of a group
         */
        /* Save Rectangle objects. */
        FOR EACH VRec WHERE VRec.ReportNum = VReport.Num
            AND VRec.GroupNum  = 0:

            RUN ip-writeCurrentVRec.      

        END. /* of for save rectangles */

        /* Save Image objects. */
        FOR EACH VImg WHERE VImg.ReportNum = VReport.Num
            AND VImg.GroupNum  = 0:
      
            RUN ip-writeCurrentVImg.
        
        END. /* of for save images */

        /* Save Line objects. */
        FOR EACH VLin WHERE VLin.ReportNum = VReport.Num
            AND VLin.GroupNum  = 0:
                         
            RUN ip-writeCurrentVLin.
        
        END. /* of for save lines */

        PUT STREAM s-io UNFORMATTED
            SKIP(1) "EndObject=Report".
        
    END. /* of for each report. */

    PUT STREAM s-io UNFORMATTED SKIP(1).

    OUTPUT STREAM s-io CLOSE.

    /* Delete buffer for default values */
    DELETE b-VReport.
    DELETE b-VGroup.
    DELETE b-VObj.
/*    DELETE b-VLin.
    DELETE b-VRec.
    DELETE b-VImg.*/

END PROCEDURE . /* ip-savereports */


PROCEDURE ip-writeCurrentVImg:
    DEF BUFFER b-VImg FOR TEMP-TABLE VImg.
    CREATE b-VImg.

    PUT STREAM s-io UNFORMATTED
        SKIP(1) "  BeginObject=Image"
        SKIP    
        "    Name="           VImg.Name
        SKIP    
        "    ImgFile="        VImg.ImgFile

        /* Save measures as 1/10 mm now. */
        SKIP    
        "    X-mm="           VImg.x-mm
        SKIP    
        "    Y-mm="           VImg.y-mm
        SKIP    
        "    Width-mm="       VImg.Width-mm
        SKIP    
        "    Height-mm="      VImg.Height-mm
        .

    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VImg.Adjust <>
        VImg.Adjust THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Adjust='
            VImg.Adjust.

 
    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VImg.Ratio <>
        VImg.Ratio THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Ratio='
            VImg.Ratio.

 
    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VImg.ImgType <>
        VImg.ImgType THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    ImgType='
            VImg.ImgType.

 
    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VImg.Private-Data <>
        VImg.Private-Data THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Private-Data='
            VImg.Private-Data.

 
    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VImg.Order <>
        VImg.Order THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Order='
            VImg.Order.

 
    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VImg.zOrder <>
        VImg.zOrder THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    zOrder='
            VImg.zOrder.

 

    PUT STREAM s-io UNFORMATTED
        SKIP    
        "  EndObject=Image".

    DELETE b-VImg.
END PROCEDURE.


PROCEDURE ip-writeCurrentVRec:
    DEF BUFFER b-VRec FOR TEMP-TABLE VRec.
    CREATE b-VRec.

    PUT STREAM s-io UNFORMATTED
        SKIP(1) "  BeginObject=Rectangle"
        SKIP    
        "    Name="        VRec.Name

        /* Save measures as 1/10 mm now. */
        SKIP    
        "    X-mm="           VRec.x-mm
        SKIP    
        "    Y-mm="           VRec.y-mm
        SKIP    
        "    Width-mm="       VRec.Width-mm
        SKIP    
        "    Height-mm="      VRec.Height-mm
        .

    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VRec.Rounded <>
        VRec.Rounded THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Rounded='
            VRec.Rounded.

 
    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VRec.Filled <>
        VRec.Filled THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Filled='
            VRec.Filled.

 
    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VRec.EdgePix <>
        VRec.EdgePix THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    EdgePixels='
            VRec.EdgePix.

 
    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VRec.BgColour <>
        VRec.BgColour THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    BgColour='
            VRec.BgColour.

 
    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VRec.Private-Data <>
        VRec.Private-Data THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Private-Data='
            VRec.Private-Data.

 
    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VRec.Order <>
        VRec.Order THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Order='
            VRec.Order.

 
    /*
File: savend.i
      (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
       {2}: Field name
       {3}: Attribute text

Example of command:
  IF b-VReport.GridWidth <> VReport.GridWidth THEN
    PUT STREAM s-io UNFORMATTED
    SKIP "  GridWidth="       VReport.GridWidth.

    Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VRec.zOrder <>
        VRec.zOrder THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    zOrder='
            VRec.zOrder.

 

    PUT STREAM s-io UNFORMATTED
        SKIP    
        "  EndObject=Rectangle".
          
    DELETE b-VRec.
END PROCEDURE.


PROCEDURE ip-writeCurrentVLin:
    DEF BUFFER b-VLin FOR TEMP-TABLE VLin.
    CREATE b-VLin.

    PUT STREAM s-io UNFORMATTED
        SKIP(1) "  BeginObject=Line"
        SKIP    
        "    Name="           VLin.Name
        SKIP    
        "    X-mm="           VLin.x-mm
        SKIP    
        "    Y-mm="           VLin.y-mm
        SKIP    
        "    Len-mm="         VLin.Len-mm
        SKIP    
        "    Height-mm="      VLin.Height-mm
        .

    /*
File: savend.i
    (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
     {2}: Field name
     {3}: Attribute text

Example of command:
IF b-VReport.GridWidth <> VReport.GridWidth THEN
  PUT STREAM s-io UNFORMATTED
  SKIP "  GridWidth="       VReport.GridWidth.

  Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VLin.BgColour <>
        VLin.BgColour THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    BgColour='
            VLin.BgColour.

 
    /*
File: savend.i
    (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
     {2}: Field name
     {3}: Attribute text

Example of command:
IF b-VReport.GridWidth <> VReport.GridWidth THEN
  PUT STREAM s-io UNFORMATTED
  SKIP "  GridWidth="       VReport.GridWidth.

  Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VLin.Type <>
        VLin.Type THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Type='
            VLin.Type.

 
    /*
File: savend.i
    (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
     {2}: Field name
     {3}: Attribute text

Example of command:
IF b-VReport.GridWidth <> VReport.GridWidth THEN
  PUT STREAM s-io UNFORMATTED
  SKIP "  GridWidth="       VReport.GridWidth.

  Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VLin.Style <>
        VLin.Style THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Style='
            VLin.Style.

 
    /*
File: savend.i
    (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
     {2}: Field name
     {3}: Attribute text

Example of command:
IF b-VReport.GridWidth <> VReport.GridWidth THEN
  PUT STREAM s-io UNFORMATTED
  SKIP "  GridWidth="       VReport.GridWidth.

  Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VLin.Private-Data <>
        VLin.Private-Data THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Private-Data='
            VLin.Private-Data.

 
    /*
File: savend.i
    (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
     {2}: Field name
     {3}: Attribute text

Example of command:
IF b-VReport.GridWidth <> VReport.GridWidth THEN
  PUT STREAM s-io UNFORMATTED
  SKIP "  GridWidth="       VReport.GridWidth.

  Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VLin.Order <>
        VLin.Order THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    Order='
            VLin.Order.

 
    /*
File: savend.i
    (Save no default values).

Author: Klaus Erichsen

Parameter: {1}: Buffer name
     {2}: Field name
     {3}: Attribute text

Example of command:
IF b-VReport.GridWidth <> VReport.GridWidth THEN
  PUT STREAM s-io UNFORMATTED
  SKIP "  GridWidth="       VReport.GridWidth.

  Last change:  KE   19 Aug 2000    4:16 pm
*/


    IF b-VLin.zOrder <>
        VLin.zOrder THEN
        PUT STREAM s-io UNFORMATTED
            SKIP '    zOrder='
            VLin.zOrder.

 

    PUT STREAM s-io UNFORMATTED
        SKIP    
        "  EndObject=Line".
          
    DELETE b-VLin.
END PROCEDURE.
  
/**  
  [
PROCEDURE ip-SetAttribut    IN p-Attrib AS CHAR 
                            IN p-Value  AS CHAR         old
PROCEDURE ip-GetAttribut:   IN p-Attrib AS CHAR
                           OUT p-Value  AS CHAR         old
]                           

*/
  
  
/* Set/Get attributes. */
PROCEDURE ip-SetAttribut:
    DEF INPUT PARAM pp-Attrib AS CHAR NO-UNDO.
    DEF INPUT PARAM pp-Value  AS CHAR NO-UNDO.

    CASE pp-Attrib:
        /*      WHEN "LibName"    THEN l-LibName  = pp-Value.*/
        WHEN "ReportName" THEN 
            l-RepName  = pp-Value.
        WHEN "TestMode"   THEN 
            l-testmode = TRUE.
        OTHERWISE 
        MESSAGE "Unknown Attribute: " pp-Attrib.
    END CASE.

END PROCEDURE. /* ip-setreport */


PROCEDURE ip-GetAttribut:
    DEF INPUT  PARAM pp-Attrib AS CHAR NO-UNDO.
    DEF OUTPUT PARAM pp-Value  AS CHAR NO-UNDO.

    CASE pp-Attrib:
        WHEN "Nothing" THEN
            pp-Value = "Nothing".
        OTHERWISE 
        MESSAGE "Unknown Attribute: " pp-Attrib.
    END CASE.
    
END PROCEDURE. /* ip-GetAttribut */

  

 

  
/** xml IO */


/** dump/load IO */


/** dirext DB IO */


/** Basic Viper API */

/*
* Name : Viper.i
* System: MS-Windows 3.x
* Copyright: IAP 1997
* Author: nj, ke, jc
* Purpose: This librara is included in viper.p, it declares the external
*          procedures which are in the dll.
*
* ke, 15.05.97; added vpprintmode, vpsetcellwrap
* jc, 20.08.97; added VpShowPreview,VpHidePreview,VpSetCellColor
* jc, 28.08.97; error handling
* jc, late 20th century: i guess a lot of stuff has happened in the
* meantime, may or may not be seen in viper.p. :)
* jc, 19.01.98: added VpEndDoc, VpSet/GetGroupVPos,VpGetCellH/VPos
* jc, 04.02.98: added VpSetCellRTF
* jc, 07.04.98: VpSetPrinterAttrib
* jc, 27.04.98: VpDebug
* jc, 29.04.98: VpOpenDoc, VpSaveDoc
* jc, 29.05.98: VpGetPrinterAttrib
* jc, 24.06.98: VpSaveClipboardToFile
* jc, 26.06.98: VpSaveWindowToFile
* jc, 13.11.98: VpSetCellSplit
* jc, 23.11.98: VpGetCellLineCount, VpShowDLLVersion
* jc, 10.12.98: VpSetCellBuffer, VpAddToCellBuffer, VpSubmitCellBuffer, VpDeleteCellBuffer
* jc, 11.02.99: VpSetWindowPos
* jc, xx.xx.99 and xx.xx.00: Some more stuff, see the function headers for details...
* jc, 10.07.2000: VpSetCellLineSpacing, GetCellWidth
* jc, 17.08.2000: VpPS2PDF
* jc, 15.02.2001: VpGetCellHeight
* jc, 03.07.2001: VpSetPaperSize
* jc, 04.10.2001: VpSetDocTitle
      Last change:  BH   26 Mar 2002    5:56 pm
* jc, 23.08.2002:  VpExportDoc
* jc,bh, 27.02.2003:  VpShowDoc
* jc 15.03.2003: VpGetPreviewStatus
* jc 12.06.03 _VpGetDefaultPrinter
* bh 06.10.04 OUTPUT changed to INPUT-OUTPUT due to 10.B 4GL Issue with DLL calls
* jc 21.02.05 VpDebugDumpDocument
* jc 25.04.05 VpSetPageVPos
* jc 03.05.05 VpSetDocAttrib
* jc 13.05.05 VpSetGraphObj
* jc 26.05.05 VpSetGroupAttr
* jc 27.05.05 VpSetGraphObjAttr
*/

/* Preprocessor-defines */

/* needs {&VDLL} , e.g. SCOPED-DEFINE VDLL "viper01.dll" */


/* Now define the Internal procedures to wrap the dll-calls. */






PROCEDURE VpSetCell EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-cell     AS CHAR   NO-UNDO. /* always case-sensitive                   */
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO. /* dito                                    */
    DEF INPUT         PARAM p-action   AS CHAR   NO-UNDO. /* "Create" | "Destroy" (not case-sens.)   */

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


PROCEDURE VpText EXTERNAL "viper32.dll"  CDECL :
    DEF INPUT         PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT         PARAM p-text     AS CHAR   NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpSetDelimiter EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-del AS CHAR  NO-UNDO.
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpSetGroupText EXTERNAL "viper32.dll"  CDECL :
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-cells    AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-texts    AS CHAR   NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpSetRect EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT         PARAM p-x        AS SHORT  NO-UNDO.
    DEF INPUT         PARAM p-y        AS SHORT  NO-UNDO.
    DEF INPUT         PARAM p-width    AS SHORT  NO-UNDO.
    DEF INPUT         PARAM p-height   AS SHORT  NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpSetFont EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-height   AS SHORT  NO-UNDO.
    DEF INPUT         PARAM p-width    AS SHORT  NO-UNDO.
    DEF INPUT         PARAM p-format   AS SHORT  NO-UNDO. /* 1=italic,2=underline,4=strikeout,8=bold */
    DEF INPUT         PARAM p-family   AS SHORT  NO-UNDO. /* font-family (0 if no altern.)           */
    DEF INPUT         PARAM p-fontName AS CHAR   NO-UNDO. /* e.g. "Arial", "TimesNewRoman",...       */

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpSetResize EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-cell    AS CHAR    NO-UNDO.
    DEF INPUT         PARAM p-group   AS CHAR    NO-UNDO.
    DEF INPUT         PARAM p-dynamic AS SHORT   NO-UNDO. /* 0 = static / 1 = dynamic cell */

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpSetCellWrap EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-cell  AS CHAR  NO-UNDO. /* always case-sensitive */
    DEF INPUT PARAM p-group AS CHAR  NO-UNDO. /* dito                  */
    DEF INPUT PARAM p-Mode  AS SHORT NO-UNDO. /* 0 = noWrap  1 = Wrap  */

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


PROCEDURE VpSetGroupSkip EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-group AS CHAR  NO-UNDO. /*                       */
    DEF INPUT PARAM p-pre   AS SHORT NO-UNDO. /* SKIP vor der group    */
    DEF INPUT PARAM p-post  AS SHORT NO-UNDO. /* SKIP nach der group   */
    DEF INPUT PARAM p-point AS SHORT NO-UNDO. /* 0 = 0,1mm 1 = POINTS  */

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


PROCEDURE VpFlushGroup EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-group   AS CHAR    NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpNewPage EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

/* prints (view) from page to page                  */
PROCEDURE VpPrint EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM   p-from AS SHORT NO-UNDO.
    DEF INPUT PARAM   p-to   AS SHORT NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpSetJustify EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM  p-cell  AS CHAR  NO-UNDO.
    DEF INPUT PARAM  p-group AS CHAR  NO-UNDO.
    DEF INPUT PARAM  p-type  AS SHORT NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpDeleteAll EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM p-dummy AS SHORT NO-UNDO.
END.

/********************************************** gfx-support ***/

PROCEDURE VpFreeLine EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-x         AS SHORT NO-UNDO.
    DEF INPUT PARAM p-y         AS SHORT NO-UNDO.
    DEF INPUT PARAM p-width     AS SHORT NO-UNDO.
    DEF INPUT PARAM p-height    AS SHORT NO-UNDO.
    DEF INPUT PARAM p-style     AS SHORT NO-UNDO.
    DEF INPUT PARAM p-bwidth    AS SHORT NO-UNDO.
    DEF INPUT PARAM p-col       AS LONG  NO-UNDO. /* col is RGB (bitfield) */

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpRectangle  EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-x         AS SHORT NO-UNDO.
    DEF INPUT PARAM p-y         AS SHORT NO-UNDO.
    DEF INPUT PARAM p-width     AS SHORT NO-UNDO.
    DEF INPUT PARAM p-height    AS SHORT NO-UNDO.
    DEF INPUT PARAM p-filled    AS SHORT NO-UNDO.
    DEF INPUT PARAM p-col       AS LONG  NO-UNDO.    

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpRoundRect  EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-x         AS SHORT NO-UNDO.
    DEF INPUT PARAM p-y         AS SHORT NO-UNDO.
    DEF INPUT PARAM p-width     AS SHORT NO-UNDO.
    DEF INPUT PARAM p-height    AS SHORT NO-UNDO.
    DEF INPUT PARAM p-filled    AS SHORT NO-UNDO.
    DEF INPUT PARAM p-col       AS LONG  NO-UNDO.        

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpHLine  EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-x     AS SHORT NO-UNDO.
    DEF INPUT PARAM p-y     AS SHORT NO-UNDO.
    DEF INPUT PARAM p-len   AS SHORT NO-UNDO.
    DEF INPUT PARAM p-style AS SHORT NO-UNDO.
    DEF INPUT PARAM p-width AS SHORT NO-UNDO.
    DEF INPUT PARAM p-col   AS LONG  NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpVLine EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-x     AS SHORT NO-UNDO.
    DEF INPUT PARAM p-y     AS SHORT NO-UNDO.
    DEF INPUT PARAM p-len   AS SHORT NO-UNDO.
    DEF INPUT PARAM p-style AS SHORT NO-UNDO.
    DEF INPUT PARAM p-width AS SHORT NO-UNDO.
    DEF INPUT PARAM p-col   AS LONG  NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpHSep EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-len       AS SHORT NO-UNDO.
    DEF INPUT PARAM p-justify   AS SHORT NO-UNDO.
    DEF INPUT PARAM p-style     AS SHORT NO-UNDO.
    DEF INPUT PARAM p-width     AS SHORT NO-UNDO.
    DEF INPUT PARAM p-col       AS LONG  NO-UNDO.    

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

/************************************************* end of gfx-support ***/

/************************************************ get property-values ***/

PROCEDURE VpCellHeight EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM   p-cell   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM   p-group  AS CHAR  NO-UNDO.
    DEF RETURN PARAM   p-height AS SHORT NO-UNDO.

/*    DEF RETURN PARAM p-err AS SHORT NO-UNDO. */
END.

PROCEDURE VpGroupHeight EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-group  AS CHAR  NO-UNDO.
    DEF RETURN PARAM p-height AS SHORT NO-UNDO.

/*    DEF RETURN PARAM p-err AS SHORT NO-UNDO. */
END.

PROCEDURE VpGetFree EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM   p-space AS SHORT NO-UNDO.
END.

PROCEDURE VpGetPages EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM   p-pages AS SHORT NO-UNDO.
END.

PROCEDURE VpGetPos EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM p-pos AS SHORT NO-UNDO.
END.

PROCEDURE VpBitmap EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM   p-Name   AS CHAR   NO-UNDO.
    DEF INPUT PARAM   p-x      AS SHORT  NO-UNDO.
    DEF INPUT PARAM   p-y      AS SHORT  NO-UNDO.
    DEF INPUT PARAM   p-width  AS SHORT  NO-UNDO.
    DEF INPUT PARAM   p-height AS SHORT  NO-UNDO.
    DEF INPUT PARAM   p-adjust AS SHORT  NO-UNDO.
    DEF INPUT PARAM   p-ratio  AS SHORT  NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/**********************************************\
|*  Printer Auswahl Sachen (PAS)              *|
|*  first: select printer by name             *|
|*  second: printer dialog box                *|
\**********************************************/

PROCEDURE VpSelectPrinter EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM   p-Name   AS CHAR   NO-UNDO.
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


PROCEDURE VpPrinterSetup EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


PROCEDURE VpPrinterDialog EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM p-Button AS SHORT NO-UNDO.
END.


/****** Show and hide the preview window  ***/

PROCEDURE VpShowPreview EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpHidePreview EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

/**** End of showing and hiding the window. */


PROCEDURE VpSetCellColor EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM   p-cell   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM   p-group  AS CHAR  NO-UNDO.
    DEF INPUT  PARAM   p-textc  AS long  NO-UNDO.
    DEF INPUT  PARAM   p-backc  AS long  NO-UNDO.
    DEF INPUT  PARAM   p-bkmode AS short  NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.





/****** Some setups for printing  ***/

PROCEDURE VpPrintOptions EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-Mode  AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-i1    AS SHORT NO-UNDO.
    DEF INPUT PARAM p-i2    AS SHORT NO-UNDO.
    DEF INPUT PARAM p-i3    AS SHORT NO-UNDO.
    DEF INPUT PARAM p-c1    AS CHAR  NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

/**** End of setups for printing. */



/************************************** end of get-properties ***/

PROCEDURE ReadErrors EXTERNAL "viper32.dll" CDECL :
    DEF INPUT-OUTPUT  PARAM p-lasterr AS SHORT   NO-UNDO. /* last error-no.                          */

    DEF RETURN        PARAM p-err     AS SHORT   NO-UNDO. /* number of errors occured                */
END.

/************************************ internal (private) ***/

/* start viper.exe                  */
PROCEDURE StartViper EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM loaded AS SHORT NO-UNDO.
END.

/* reset data of DLL                */
PROCEDURE ClearDLL EXTERNAL "viper32.dll" CDECL :
END.

/* close viper.exe                  */
/* clean-up */
PROCEDURE CloseViper EXTERNAL "viper32.dll" CDECL :
END.



/* 19.01.98 */

/* VpSetGroupVPos - set vertical group position
   19.01.98 jpc
*/
PROCEDURE VpSetGroupVPos EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-VPos AS SHORT NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

/* VpGetCellVPos - get vertical cell position
   19.01.98 jpc
*/
PROCEDURE VpGetCellVPos EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-cells AS CHAR NO-UNDO.
    DEF RETURN PARAM p-VPos AS SHORT NO-UNDO.
END.

/* VpGetCellHPos - get vertical cell position
   19.01.98 jpc
*/
PROCEDURE VpGetCellHPos EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-cells AS CHAR NO-UNDO.
    DEF RETURN PARAM p-HPos AS SHORT NO-UNDO.
END.

/* VpGetGroupVPos - get vertical group position
   19.01.98 jpc
*/
PROCEDURE VpGetGroupVPos EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF RETURN PARAM p-VPos AS SHORT NO-UNDO.
END.

/* VpEndDoc - tell viper that it's over...
   19.01.98 jpc
*/
PROCEDURE VpEndDoc EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM p-err     AS SHORT   NO-UNDO.
END.


/* 04.02.98 */

/* VpSetCellRTF - set a cell to RTF mode
   04.02.98 jpc
*/
PROCEDURE VpSetCellRTF EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-cells AS CHAR NO-UNDO.
    DEF INPUT PARAM p-rtf AS SHORT NO-UNDO.
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.



/* 07.04.98 */
/* VpSetPrinterAttrib - sets a couple of printerattributes
   07.04.98 jpc
*/
PROCEDURE VpSetPrinterAttrib EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-PrinterAttrib AS MEMPTR.
    DEF INPUT PARAM p-duplex AS SHORT NO-UNDO.
END.


/* 27.04.98 */
/* VpDebug - call some debug helpers
   27.04.98 jpc
*/
PROCEDURE VpDEBUG EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-command AS CHAR NO-UNDO.
    DEF INPUT PARAM p-parameter AS CHAR NO-UNDO.
  
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.



/* 29.04.98 */
/* VpSaveDoc - save a viper document
   29.04.98 jpc
*/
PROCEDURE VpSaveDoc EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-sFileName AS CHAR NO-UNDO.
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/* VpOpenDoc - load a viper document
   29.04.98 jpc
*/
PROCEDURE VpOpenDoc EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-sFileName AS CHAR NO-UNDO.
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/* VpGetPrinterAttrib - Get a given printer attrib
   28.05.98 jpc
*/
PROCEDURE VpGetPrinterAttrib EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-attrib AS CHAR NO-UNDO.
    DEF RETURN PARAM p-value AS SHORT NO-UNDO.
END.


/* VpSaveClipboardToFile -
   24.06.98 jpc
*/
PROCEDURE VpSaveClipboardToFile EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM DataType AS SHORT NO-UNDO.
    DEF INPUT PARAM FileNameIn AS CHAR NO-UNDO.
    /* bug in 10.0B */
    DEF INPUT-OUTPUT PARAM FileNameOut AS CHAR NO-UNDO.
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/* VpSaveWindowToFile -
   26.06.98 jpc
*/
PROCEDURE VpSaveWindowToFile EXTERNAL "viper32.dll" CDECL :

    DEF INPUT PARAM wind AS LONG NO-UNDO.

    DEF INPUT PARAM AreaType AS SHORT NO-UNDO.
    DEF INPUT PARAM FileNameIn AS CHAR NO-UNDO.
    /* bug in 10.0B */
    DEF INPUT-OUTPUT PARAM FileNameOut AS CHAR NO-UNDO.
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

/* VpSetGroupCellPositioning - at FlushGroup:
                               OneLine=0 (default - like previous viper)
                               Relative=1 (retains the relative positions of the
                                    cells in a group)
   24.09.98 jpc
*/
PROCEDURE VpSetGroupCellPositioning EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-Style AS SHORT NO-UNDO.
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/* VpSetCellSplit - Set if the Cell should split the cells' text between several
                    "instances" of a cell (i.e. allow cell to support "page break"
                    text
   13.11.98 jpc
*/
PROCEDURE VpSetCellSplit EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-cell AS CHAR NO-UNDO.
    DEF INPUT PARAM p-split AS SHORT NO-UNDO.
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/* VpGetCellLineCount - Get number of linesin a cell
   23.11.98 jpc
*/
PROCEDURE VpGetCellLineCount EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-cells AS CHAR NO-UNDO.
    DEF RETURN PARAM p-LineCount AS SHORT NO-UNDO.
END.


/* VpShowDLLVersion - Show a messagebox w/ compile date & time
   23.11.98 jpc
*/
PROCEDURE VpShowDLLVersion EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM p-ver AS SHORT NO-UNDO.
END.


/* VpSetCellBuffer - Set text in a cells buffer
   10.12.98 jpc
*/
PROCEDURE VpSetCellBuffer EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT         PARAM p-text     AS CHAR   NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/* VpAddToCellBuffer - Add text to a cells buffer
   10.12.98 jpc
*/
PROCEDURE VpAddToCellBuffer EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT         PARAM p-text     AS CHAR   NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/* VpSubmitCellBuffer - Submit the buffer to the CellText
   i.e. Set the cells text to the text stored in the buffer
   10.12.98 jpc
*/
PROCEDURE VpSubmitCellBuffer EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO.    

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

/* VpDeleteCellBuffer - Empties the cells buffer
   10.12.98 jpc
*/
PROCEDURE VpDeleteCellBuffer EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO.    

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/* VpSetWindowPos - setPosition of Viper window
   11.02.99 jpc
*/
PROCEDURE VpSetWindowPos EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-left   AS SHORT NO-UNDO.
    DEF INPUT PARAM p-top    AS SHORT NO-UNDO.
    DEF INPUT PARAM p-width  AS SHORT NO-UNDO.
    DEF INPUT PARAM p-height AS SHORT NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

/* VpShowCellStatus - ShowStatus of a cell
   29.03.99 jpc
*/
/* PROCEDURE VpShowCellStatus EXTERNAL {&VDLL} CDECL {&PST}:
    DEF INPUT         PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO.    

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.
*/

/* VpSetCurrentPageProperties
   27.08.99 jpc
*/
PROCEDURE VpSetCurrentPageProperties EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-prop     AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-value    AS CHAR   NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/* VpSetWindowPosCCI
   02.09.1999 jpc
*/
PROCEDURE VpSetWindowPosCCI EXTERNAL "viper32.dll" CDECL :
    DEF INPUT   PARAM p-hwnd  AS LONG NO-UNDO.
    DEF INPUT   PARAM p-x     AS LONG NO-UNDO.
    DEF INPUT   PARAM p-y     AS LONG NO-UNDO.
    DEF INPUT   PARAM p-cx    AS LONG NO-UNDO.
    DEF INPUT   PARAM p-cy    AS LONG NO-UNDO.
    DEF INPUT   PARAM p-flags AS LONG NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.




/*
 * VpWebPrintDoc - printdoc to webpage
 * 07.01.2000 jc
 */
PROCEDURE VpWebPrintDoc EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-from AS SHORT NO-UNDO.
    DEF INPUT  PARAM p-to   AS SHORT NO-UNDO.
    DEF INPUT  PARAM p-prt  AS CHAR  NO-UNDO.
    /* bug in 10.0B */
    DEF INPUT-OUTPUT PARAM fOut   AS CHAR  NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT  NO-UNDO.
END.


/*
 * VpSetLandscapePS - set landscape flag in a PS file
 * 28.06.2000 jc
 */
PROCEDURE VpSetLandscapePS EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-filePS AS CHAR  NO-UNDO.
    DEF INPUT  PARAM p-force  AS SHORT NO-UNDO.
    DEF RETURN PARAM p-err    AS SHORT NO-UNDO.
END.



/*
 * VpSetCellLineSpacing - set the spacing between the lines of a cell
 * 10.07.2000 jc
 */
PROCEDURE VpSetCellLineSpacing EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-cell    AS CHAR  NO-UNDO.
    DEF INPUT  PARAM p-group   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM p-spass   AS DOUBLE NO-UNDO.
    DEF RETURN PARAM p-err     AS SHORT NO-UNDO.
END.


/*
 * VpGetCellWidth - get the width of a cell.
 * 10.07.2000 jc
 */
PROCEDURE VpGetCellWidth EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-cell    AS CHAR  NO-UNDO.
    DEF INPUT  PARAM p-group   AS CHAR  NO-UNDO.
    DEF RETURN PARAM p-err     AS SHORT NO-UNDO.
END.



/*
* VpPS2PDF - to avoid problems with the length of the commandline and
* the size of the environment we have to call ghostscript
* from the dll
* 17.8.2000 jc
*/
PROCEDURE VpPS2PDF EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-gsexe AS CHAR NO-UNDO.
    DEF INPUT PARAM p-gsdir AS CHAR NO-UNDO.
    DEF INPUT PARAM p-fontpath AS CHAR NO-UNDO.
    DEF INPUT PARAM p-options AS CHAR NO-UNDO.
    DEF INPUT PARAM p-options2 AS CHAR NO-UNDO.
    DEF INPUT PARAM p-device AS CHAR NO-UNDO.
    DEF INPUT PARAM p-infile AS CHAR NO-UNDO.
    DEF INPUT PARAM p-outfile AS CHAR NO-UNDO.
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/*
 * VpDumpCellReadable - a pure debugging function, that dumps  the 
 * parsed cell text in a readable format into a given file
 * pars:    cellname
 *          groupname
 *          filename
 *          filemode:   "w"=write, delete old file, "a"=append to exosting file
 *
 * 01.11.2000 jc
 */
PROCEDURE VpDumpCellReadable EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-cell    AS CHAR  NO-UNDO.
    DEF INPUT  PARAM p-group   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM p-fname   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM p-mode    AS CHAR  NO-UNDO.
    DEF RETURN PARAM p-err     AS SHORT NO-UNDO.
END.


/*
 * VpSetCellHeight - Set the height of a cell without touching its position
 *                   should have been done much earlier :-)
 * 
 * 15.02.2001 jc
 */
PROCEDURE VpSetCellHeight EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-cell    AS CHAR  NO-UNDO.
    DEF INPUT  PARAM p-group   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM p-height  AS LONG   NO-UNDO.
    DEF RETURN PARAM p-err     AS SHORT NO-UNDO.
END.

/*
 * VpSetPaperSize - Set the current paper size
 * 
 * 03.07.2001 jc
 */
PROCEDURE VpSetPaperSize EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-width   AS LONG  NO-UNDO.
    DEF INPUT  PARAM p-height  AS LONG   NO-UNDO.
    DEF RETURN PARAM p-err     AS SHORT NO-UNDO.
END.


/*
 * VpSetDocTitle - Set the current documents title
 * 
 * 04.10.2001 jc
 */
PROCEDURE VpSetDocTitle EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-title   AS CHAR  NO-UNDO.
    DEF RETURN PARAM p-err     AS SHORT NO-UNDO.
END.



/*
 * export xslfo
 *
 * 23.08.02 jc
 */
PROCEDURE VpExportDoc EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-from   AS LONG  NO-UNDO.
    DEF INPUT  PARAM p-to     AS LONG  NO-UNDO.
    DEF INPUT  PARAM p-fnam   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM p-type   AS CHAR  NO-UNDO.
    DEF RETURN PARAM p-err    AS SHORT NO-UNDO.
END.


/*
 * Create a persistent preview, that outlives the DLL/viper handle
 *
 * 27.02.03 jc
 */
PROCEDURE VpShowDoc EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAM p-err    AS SHORT NO-UNDO.
END.


/*
 * Return the current preview status (hidden/visible)
 *
 * 15.03.03 jc
 */
PROCEDURE VpGetPreviewStatus EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM p-wait    AS SHORT  NO-UNDO.
    DEF RETURN PARAM p-status  AS SHORT  NO-UNDO.
END.



/*
 * Get the current default printer
 *
 * this is no official part of the API
 * 12.06.03 jc
 */
PROCEDURE _VpGetDefaultPrinter EXTERNAL "viper32.dll" CDECL :
    DEF RETURN PARAMETER p-name AS MEMPTR NO-UNDO.
END.

/*
 * Set the default printer
 *
 * this is no official part of the API
 * 12.06.03 jc
 */
PROCEDURE _VpSetDefaultPrinter EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAMETER p-name AS CHAR.
    DEF RETURN PARAMETER p-ret AS LONG.
END.


/*
 * Set a codepage for the given cell
 * this is only preliminary
 * 12.11.04 jc
 */
PROCEDURE VpSetCellCodePage EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-cell     AS CHAR   NO-UNDO. /* always case-sensitive                   */
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO. /* dito                                    */
    DEF INPUT         PARAM p-CP       AS CHAR   NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/*
 * Dump the current contents of the document
 * currently this only dumps the cells (see OnePage::DebugDumpToFile)
 * 21.02.05 jc
 */
PROCEDURE VpDebugDumpDocument EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-fnam AS CHAR NO-UNDO.

    DEF RETURN PARAM p-err AS LONG NO-UNDO.
END.


/*
 * VpSetPageVPos: set the current position for the current page
 * 
 * 25.04.05 jc
 */
PROCEDURE VpSetPageVPos EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-pos AS LONG NO-UNDO.

    DEF RETURN PARAM p-err AS LONG NO-UNDO.
END.


/*
 * VpSetDocAttrib: set attributes for the document
 * e.g. CREATEMODE
 * 
 * 03.05.05 jc
 */
PROCEDURE VpSetDocAttrib EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-attriblist AS CHAR NO-UNDO.

    DEF RETURN PARAM p-err AS LONG NO-UNDO.
END.



/*
 * _VpSetGsParams
 * set ghostscript parameters. this is used for the 
 * printPDF button of the preview and should be called on
 * startup of viper
 * 03.05.05 jc
 */
PROCEDURE _VpSetGsParams EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-gsexe AS CHAR NO-UNDO.
    DEF INPUT PARAM p-gsdir AS CHAR NO-UNDO.
    DEF INPUT PARAM p-fontpath AS CHAR NO-UNDO.
    DEF INPUT PARAM p-options AS CHAR NO-UNDO.
    DEF INPUT PARAM p-options2 AS CHAR NO-UNDO.
    DEF INPUT PARAM p-device AS CHAR NO-UNDO.
    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.


/*
 * VpGetCellTextHeight
 * returns the height the whole text of the cell would need
 * to be displayed. this is identical to getcellheight for cell
 * that automatically resize
 * 04.05.05 jc
 */
PROCEDURE VpGetCellTextHeight EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM   p-cell   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM   p-group  AS CHAR  NO-UNDO.
    DEF RETURN PARAM   p-height AS SHORT NO-UNDO.
END.

/*
 * VpGetCellTextWidth
 * returns the width the cells' text needs to display
 * without more linebreaking, than currently used
 * 04.05.05 jc
 */
PROCEDURE VpGetCellTextWidth EXTERNAL "viper32.dll" CDECL :
    DEF INPUT  PARAM   p-cell   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM   p-group  AS CHAR  NO-UNDO.
    DEF RETURN PARAM   p-height AS SHORT NO-UNDO.
END.


/*
 * VpSetGraphObj
 * sets group based grahical objects: BMP, RECT, etc.
 * 13.05.05 jc
 */
PROCEDURE VpSetGraphObj EXTERNAL "viper32.dll" CDECL :
    DEF INPUT PARAM p-objnam    AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-group     AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-type      AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-x         AS LONG  NO-UNDO.
    DEF INPUT PARAM p-y         AS LONG  NO-UNDO.
    DEF INPUT PARAM p-w         AS LONG  NO-UNDO.
    DEF INPUT PARAM p-h         AS LONG  NO-UNDO.
    DEF INPUT PARAM p-attribs   AS CHAR  NO-UNDO.
    DEF RETURN PARAM p-err      AS LONG  NO-UNDO.
END PROCEDURE.


/*
 * VpSetGroupAttr
 * sets group attributes from a key/value list
 * 26.05.05 jc
 */
PROCEDURE VpSetGroupAttr EXTERNAL "viper32.dll" CDECL :
    DEFINE INPUT PARAM p-group  AS CHAR NO-UNDO.
    DEFINE INPUT PARAM p-attr   AS CHAR NO-UNDO.
    DEFINE RETURN PARAM p-err   AS LONG NO-UNDO.
END PROCEDURE. 

/*
 * VpSetGraphObjAttr
 * sets GraphObj attributes from a key/value list
 * 27.05.05 jc
 */
PROCEDURE VpSetGraphObjAttr EXTERNAL "viper32.dll" CDECL :
    DEFINE INPUT PARAM p-object AS CHAR NO-UNDO.
    DEFINE INPUT PARAM p-group  AS CHAR NO-UNDO.
    DEFINE INPUT PARAM p-attr   AS CHAR NO-UNDO.
    DEFINE RETURN PARAM p-err   AS LONG NO-UNDO.
END PROCEDURE. 

/*
 * VpGetGroupHPos
 * retrieves the horizontal position of the bounding rectangle of a group
 * 03.08.06 jc
 */
PROCEDURE VpGetGroupHPos EXTERNAL "viper32.dll" CDECL :
    DEFINE INPUT PARAM p-group  AS CHAR NO-UNDO.
    DEFINE RETURN PARAM p-err   AS LONG NO-UNDO.
END PROCEDURE. 

/*
 * VpGetGroupWidth
 * retrieves the width of the bounding rectangle of a group
 * 03.08.06 jc
 */
PROCEDURE VpGetGroupWidth EXTERNAL "viper32.dll" CDECL :
    DEFINE INPUT PARAM p-group  AS CHAR NO-UNDO.
    DEFINE RETURN PARAM p-err   AS LONG NO-UNDO.
END PROCEDURE. 



/*
 * VpGetGroupObjects
 * retrieve a comma separated list of the objects in the given group
 * 04.05.07 jc
 */
PROCEDURE VpGetGroupObjects EXTERNAL "viper32.dll" CDECL :
    DEFINE INPUT  PARAM p-group  AS CHAR   NO-UNDO.
    DEFINE INPUT  PARAM p-type   AS CHAR   NO-UNDO.
    DEFINE RETURN PARAM p-res    AS MEMPTR NO-UNDO.
END PROCEDURE.

/*
 * VpSetCellRotation
 * sets the rotation angle for the cell's text. 
 * counterclockwise
 * june/july 2011 jc
 */
PROCEDURE VpSetCellRotation EXTERNAL "viper32.dll" CDECL :
    DEFINE INPUT PARAM p-object AS CHAR NO-UNDO.
    DEFINE INPUT PARAM p-group  AS CHAR NO-UNDO.
    DEFINE INPUT PARAM p-angle  AS DOUBLE NO-UNDO.
    DEFINE RETURN PARAM p-err   AS LONG NO-UNDO.
END.



/*
 * VpSetCellFont
 * set the cell font. supersedes VpSetFont
 * Aug 15, 2011 jc
 */
PROCEDURE VpSetCellFont EXTERNAL "viper32.dll" CDECL :
    DEF INPUT         PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-group    AS CHAR   NO-UNDO.
    DEF INPUT         PARAM p-height   AS FLOAT  NO-UNDO.
    DEF INPUT         PARAM p-width    AS FLOAT  NO-UNDO.
    DEF INPUT         PARAM p-format   AS SHORT  NO-UNDO. /* 1=italic,2=underline,4=strikeout,8=bold */
    DEF INPUT         PARAM p-family   AS SHORT  NO-UNDO. /* font-family (0 if no altern.)           */
    DEF INPUT         PARAM p-fontName AS CHAR   NO-UNDO. /* e.g. "Arial", "TimesNewRoman",...       */

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.

PROCEDURE VpSetTempDir EXTERNAL "viper32.dll" CDECL :
    DEFINE INPUT  PARAMETER p-tmpdir AS CHARACTER NO-UNDO.

    DEF RETURN PARAM p-err AS SHORT NO-UNDO.
END.
 
/*
Name :     Vpb.i   (old viper.p)
Purpose:
Copyright:
Author:
Version:
changes:
* 24.02.03 multitasking intervall removed
* 06.10.04 OUTPUT changed to INPUT-OUTPUT due to 10.B 4GL Issue with DLL calls
* 25.04.05 jc: vpr_setPageVPos
* 03.05.05 jc: vpr_SetDocAttrib
* xx.05.05 jc: vpr_FetchCellTextWidth vpr_FetchCellTextHeight
* 13.05.05 jc:  vpr_SetGraphObj
* 26.05.05 jc: vpr_setGroupAttr
*/




/* The Delimiter. */
DEF            VAR l-Delimiter        AS CHAR NO-UNDO INIT "".

/* A flag indicating if we are in landscape mode */
DEF            VAR l-printorientation AS INT  NO-UNDO INIT 0.

/* Has/is viper succesfully loaded. */
DEF            VAR loaded             AS INT  NO-UNDO.

/* Pointer to viper dll. Used to kill dll. */
DEF            VAR h-dll              AS INT  NO-UNDO.

/*
 * variables with values from the viper.ini
 */
DEF NEW SHARED VAR gvp_gsdir          AS CHAR INIT "viper\gs"        	/*".\gs"             */ .
DEF NEW SHARED VAR gvp_gsexe          AS CHAR INIT "viper\gs\gswin32c.exe"        /*".\gs\gswin32c.exe */ .
DEF NEW SHARED VAR gvp_gslib          AS CHAR INIT "viper\gs"        	/*".\gs"             */ .
DEF NEW SHARED VAR gvp_gsfontpath     AS CHAR INIT ""   				/*".\gs"             */ .
DEF NEW SHARED VAR gvp_webprt         AS CHAR INIT "VIPER"       		/*"PS-Printer"       */ .
DEF NEW SHARED VAR gvp_WEBPRTACTIVE   AS CHAR INIT "OFF" 				/*"OFF"              */ .
DEF NEW SHARED VAR gvp_WEBTEMPDIR     AS CHAR INIT "vpwebtmp\"   		/*"vpwebtmp\"        */ .
DEF NEW SHARED VAR gvp_SRVTEMPDIR     AS CHAR INIT "/vpwebtmp/"   	/*"/vpwebtmp/"       */ .



/******* Trigger ********/
ON CLOSE OF THIS-PROCEDURE RUN vpr_ViperOff.


/******* Main Block **********/
IF THIS-PROCEDURE:PERSISTENT THEN RUN vpr_ViperOn.


/******* Viper-Wrapper ******************/

/* Set friendly multitasking, load library and   */
PROCEDURE vpr_ViperOn :

    FILE-INFO:FILE-NAME = "viper\viper32.dll".

    RUN LoadLibraryA(IF FILE-INFO:FULL-PATHNAME <> ? THEN FILE-INFO:FULL-PATHNAME ELSE "viper\viper32.dll", OUTPUT h-dll).

    /*
      RUN LoadLibraryA(IF SEARCH({&VDLL}) <> ? THEN SEARCH({&VDLL}) ELSE {&VDLL}, OUTPUT h-dll).
    */
    /* Startet die Exe-Datei. */
    RUN StartViper(OUTPUT loaded).
  
    /* Wurde Viper nicht ordentlich geladen, so wird eine 0 zurueckgegeben. */
    IF loaded = 0 THEN 
    DO:
        MESSAGE  "Viper could not be started successfully!"
            VIEW-AS ALERT-BOX.
        RUN FreeLibrary(h-dll).
        DELETE PROCEDURE THIS-PROCEDURE.
    END.

    RUN vpr_SetDelimiter(CHR(1)).

    RUN vpr_loadini.
    RUN vpr_ResetDoc.

    DEF VAR p-dummy AS INT NO-UNDO.
    RUN _VpSetGsParams(gvp_GSEXE,gvp_GSDIR,gvp_GSFONTPATH,
        "-dBATCH -dNOPAUSE -dQUIET", "", 
        "pdfwrite", OUTPUT p-dummy). 
/* we ignore errors returned by the dll (actually there are none, it always returns 0) */

END. /* of viperon */



/* Leave viper */
PROCEDURE vpr_ViperOff :
    RUN CloseViper.

    RUN FreeLibrary(h-dll).

    DELETE PROCEDURE THIS-PROCEDURE.
END.





/*********** read Viper INI *******************/

PROCEDURE vpr_loadini:
    DEF VAR lp-cfgfile AS CHAR NO-UNDO.
    DEF VAR lp-line    AS CHAR NO-UNDO.

    lp-cfgfile = SEARCH("viper.ini").
    IF lp-cfgfile = ? THEN lp-cfgfile = SEARCH("viper/viper.ini").
    IF lp-cfgfile <> ? THEN 
    DO:
        INPUT FROM VALUE(lp-cfgfile).
        REPEAT:
            IMPORT UNFORMATTED lp-line.
            IF TRIM(ENTRY(1,lp-line," ")) BEGINS ";" OR NUM-ENTRIES(lp-line,"=") <> 2 THEN NEXT.

            CASE TRIM(ENTRY(1,lp-line,"=")):
                WHEN "VP_GSDIR"        THEN 
                    gvp_gsdir        = TRIM(ENTRY(2,lp-line,"=")).
                WHEN "VP_GSEXE"        THEN 
                    gvp_gsexe        = REPLACE(TRIM(ENTRY(2,lp-line,"=")),"%VP_GSDIR%", gvp_gsdir).
                WHEN "VP_GSLIB"        THEN 
                    gvp_gslib        = REPLACE(TRIM(ENTRY(2,lp-line,"=")),"%VP_GSDIR%", gvp_gsdir).
                WHEN "VP_FONTPATH"     THEN 
                    gvp_gsfontpath   = REPLACE(TRIM(ENTRY(2,lp-line,"=")),"%VP_GSDIR%", gvp_gsdir).
                WHEN "WEBPRT"          THEN 
                    gvp_webprt       = REPLACE(TRIM(ENTRY(2,lp-line,"=")),'"','').
                WHEN "VP_WEBPRTACTIVE" THEN 
                    gvp_WEBPRTACTIVE = TRIM(ENTRY(2,lp-line,"=")).
                WHEN "VP_WEBTEMPDIR  " THEN 
                    gvp_WEBTEMPDIR   = TRIM(ENTRY(2,lp-line,"=")).
                WHEN "VP_SRVTEMPDIR  " THEN 
                    gvp_SRVTEMPDIR   = TRIM(ENTRY(2,lp-line,"=")).
            END CASE.
        END. /* repeat */
        IF NOT SESSION:BATCH-MODE THEN 
        DO:
            INPUT FROM TERMINAL.
        END.
        ELSE 
        DO:
            INPUT CLOSE.
        END.
    END. /* IF <> ? */


    /* dll does not know about PROPATH */
    FILE-INFO:FILE-NAME = gvp_gsdir.
    IF FILE-INFO:FULL-PATHNAME <> ? THEN gvp_gsdir      = FILE-INFO:FULL-PATHNAME.
    FILE-INFO:FILE-NAME = gvp_gsexe.
    IF FILE-INFO:FULL-PATHNAME <> ? THEN gvp_gsexe      = FILE-INFO:FULL-PATHNAME.
    FILE-INFO:FILE-NAME = gvp_gslib.
    IF FILE-INFO:FULL-PATHNAME <> ? THEN gvp_gslib      = FILE-INFO:FULL-PATHNAME.
    FILE-INFO:FILE-NAME = gvp_gsfontpath.
    IF FILE-INFO:FULL-PATHNAME <> ? THEN gvp_gsfontpath = FILE-INFO:FULL-PATHNAME.
    FILE-INFO:FILE-NAME = ".".
  
END PROCEDURE.

/***************************
 * RTF processing commands *
 ***************************/
/* the declarations needed for embedded
   formatting at this point ...
   06.02.98 jc
   24.09.98 jc: rtf agin! */




/* takes string + attributes and returns rtf-formatted string */
PROCEDURE vpr_Asc2RTF :
    DEF INPUT  PARAM p-InString  AS CHAR NO-UNDO.
    DEF INPUT  PARAM p-Attribs   AS CHAR NO-UNDO.
    DEF OUTPUT PARAM p-OutString AS CHAR NO-UNDO.
  
    DEF VAR lt-opt   AS CHAR NO-UNDO INIT "".
    DEF VAR lt-unopt AS CHAR NO-UNDO INIT "".
    DEF VAR lt-c     AS CHAR NO-UNDO INIT "".
    DEF VAR lt-i     AS INT  NO-UNDO INIT -1.

    /* not tricky, but it works */
    IF (LOOKUP("bold",p-Attribs)  > 0) THEN 
    DO:
        lt-opt = lt-opt  + "\b ".
        lt-unopt = lt-unopt + "\b0 ".
    END.
  
    IF (LOOKUP("italic",p-Attribs)  > 0) THEN 
    DO:
        lt-opt = lt-opt  + "\i ".
        lt-unopt = lt-unopt  + "\i0 ".
    END.
  
    IF (LOOKUP("underline",p-Attribs) > 0) THEN 
    DO:
        lt-opt = lt-opt  + "\ul ".
        lt-unopt = lt-unopt  + "\ul0 ".
    END.
  
    IF (LOOKUP("strike",p-Attribs) > 0) THEN 
    DO:
        lt-opt = lt-opt  + "\s ".
        lt-unopt = lt-unopt  + "\s0 ".
    END.
    
    /* keep this order, please */
    /* not needed/used currently... 6.2.98 (jc) */
    p-InString = REPLACE(p-InString,"\","\\").
    p-InString = REPLACE(p-InString,CHR(9),"\tab ").
    p-InString = REPLACE(p-InString,CHR(13) + CHR(10),"\par ").
    p-InString = REPLACE(p-InString,CHR(13),"\par ").
    p-InString = REPLACE(p-InString,CHR(10),"\par ").
    p-InString = REPLACE(p-InString,"~{","\~{").
    p-InString = REPLACE(p-InString,"~}","\~}").
  
    p-OutString = lt-opt + p-InString + lt-unopt. /* + {&RPlain}. */ /* options + text + 'reset' */
END.







/*********************************************
 * Creation and deletion of cells and groups *
 ********************************************/
/* create a cell in a group */
PROCEDURE vpr_DefCell:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSetCell (CAPS(p-cell), CAPS(p-group), "Create":U, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "DefCell: Error".
END.


/* Delete a cell */
PROCEDURE vpr_DelCell:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSetCell (CAPS(p-cell), CAPS(p-group), "Destroy", OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "DelCell: Error".
END.







/*************************************
 * Setting cell and group attributes *
 *************************************/

/* Set cell attributes */
PROCEDURE vpr_SetCellAttrib:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT PARAM p-attribs  AS CHAR   NO-UNDO.

    DEF VAR p-err   AS INT  NO-UNDO INIT 0.
    DEF VAR c_entry AS CHAR NO-UNDO.
  
    DEF VAR ii      AS INT  NO-UNDO.
    DEF VAR ij      AS INT  NO-UNDO.
  
    ij = NUM-ENTRIES(p-attribs).

  
  
    DO ii = 1 TO ij:
        c_entry = ENTRY(ii,p-attribs).
    
        IF TRIM(ENTRY(1,c_entry,"=")) = "RTF" THEN 
        DO:
            IF TRIM(ENTRY(2,c_entry,"=")) = "ON" THEN
                RUN VpSetCellRTF (CAPS(p-cell), CAPS(p-group), 1, OUTPUT p-err).
            ELSE
                RUN VpSetCellRTF (CAPS(p-cell), CAPS(p-group), 0, OUTPUT p-err).

        END.
    END.

    IF p-err <> 0 THEN RETURN ERROR "SetCellAttrib: Error".
END.  
    
  
/*
 * SetCellLineSpacing - Set the space between lines
 */
PROCEDURE vpr_SetCellLineSpacing:
    DEF INPUT PARAM p-cell    AS CHAR NO-UNDO.
    DEF INPUT PARAM p-group   AS CHAR NO-UNDO.
    DEF INPUT PARAM p-space   AS DEC  NO-UNDO.
  
    DEF VAR p-err AS INT NO-UNDO INIT 0.
    RUN VpSetCellLineSpacing (CAPS(p-cell), CAPS(p-group), p-space, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SetCellLineSpacing: Error".
END.


  
/* set RTF */
PROCEDURE vpr_SetCellRTF:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT PARAM p-attrib   AS CHAR   NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO INIT 0.

    p-attrib=TRIM(CAPS(p-attrib)).
    IF p-attrib = "ON" OR p-attrib = "TRUE" OR p-attrib = "YES" OR p-attrib = "RTF" THEN 
    DO:
        RUN VpSetCellRTF (CAPS(p-cell), CAPS(p-group), 1, OUTPUT p-err).
    END.
    ELSE 
    DO:
        RUN VpSetCellRTF (CAPS(p-cell), CAPS(p-group), 0, OUTPUT p-err).
    END.

    IF p-err <> 0 THEN RETURN ERROR "SetCellRTF: Error".
END.




/* Set the text value of a cell */
PROCEDURE vpr_SetCellText:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT PARAM p-text     AS CHAR   NO-UNDO. /* No-formatted text (s.t.c.)              */

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpText (CAPS(p-cell), CAPS(p-group), p-text, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SetCellText: Error".
END.

/* Set the text value of a cell */
PROCEDURE vpr_SetCellLongText:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT PARAM p-text     AS LONGCHAR   NO-UNDO. /* No-formatted text (s.t.c.)              */

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpText (CAPS(p-cell), CAPS(p-group), p-text, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SetCellLongText: Error".
END.



/* SetDelimiter: only here because of its close connexion to SetGroupText */
PROCEDURE vpr_SetDelimiter:
    DEF INPUT PARAM p-del AS CHAR NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSetDelimiter IN THIS-PROCEDURE (INPUT p-del, OUTPUT p-err) NO-ERROR.
    IF p-err <> 0 THEN RETURN ERROR "SetDelimiter: Error".
    /* xxx */
    l-Delimiter = p-Del.
  
END. /* of setdelimiter */


/* Set the text value of a cell */
PROCEDURE vpr_SetGroupText:
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-cells    AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-texts    AS CHAR   NO-UNDO. /* No-formatted text (s.t.c.)              */

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSetGroupText (CAPS(p-group), CAPS(p-cells), p-texts, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SetGroupText: Error".
END.


/* Position a cell (set size/place) (per 0.1 mm) */
PROCEDURE vpr_SetCellPos:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT PARAM p-x        AS INT    NO-UNDO.
    DEF INPUT PARAM p-y        AS INT    NO-UNDO.
    DEF INPUT PARAM p-width    AS INT    NO-UNDO.
    DEF INPUT PARAM p-height   AS INT    NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSetRect(CAPS(p-cell),CAPS(p-group),p-x,p-y,p-width,p-height, OUTPUT p-err).
    IF p-err <>0 THEN 
    DO:
        /*    DISPLAY "FEHLER: ".
            DISPLAY STRING(p-err).
        */
        RETURN ERROR "SetCellPos: Error".
    END.
END.


/* Set a cells height (per 0.1 mm) */
PROCEDURE vpr_SetCellHeight:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT PARAM p-height   AS INT    NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSetCellHeight(CAPS(p-cell),CAPS(p-group),p-height, OUTPUT p-err).
    IF p-err <>0 THEN 
    DO:
        RETURN ERROR "SetCellHeight: Error".
    END.
END.


/* set font in cell 
   ke, 18.04.97; No more font family. Set to 0. */
PROCEDURE vpr_SetCellFont_OLD:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-height   AS INT    NO-UNDO.
    DEF INPUT PARAM p-width    AS INT    NO-UNDO.
    /* use a list of italic,underline,strikeout,bold */  
    DEF INPUT PARAM p-format   AS CHAR    NO-UNDO. 
    /* e.g. "Arial", "TimesNewRoman",...       */
    DEF INPUT PARAM p-fontName AS CHAR   NO-UNDO. 

    DEF VAR p-err    AS INT NO-UNDO.
    DEF VAR l-Format AS INT NO-UNDO.

    RUN vpr_CalcFormat (p-Format, OUTPUT l-Format).
  
  
  
    RUN VpSetFont(CAPS(p-cell), CAPS(p-group),
        p-height, p-width, l-format,
        0, p-fontName, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SetCellFont: Error".
END.


/* set font in cell 
 * new version using decimals for height and width
 * Aug 15, 2011 jc
 */
PROCEDURE vpr_SetCellFont:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-height   AS DEC    NO-UNDO.
    DEF INPUT PARAM p-width    AS DEC    NO-UNDO.
    /* use a list of italic,underline,strikeout,bold */  
    DEF INPUT PARAM p-format   AS CHAR    NO-UNDO. 
    /* e.g. "Arial", "TimesNewRoman",...       */
    DEF INPUT PARAM p-fontName AS CHAR   NO-UNDO. 

    DEF VAR p-err    AS INT NO-UNDO.
    DEF VAR l-Format AS INT NO-UNDO.

    RUN vpr_CalcFormat (p-Format, OUTPUT l-Format).
  
  
  
    RUN VpSetCellFont(CAPS(p-cell), CAPS(p-group),
        p-height, p-width, l-format,
        0, p-fontName, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SetCellFont: Error".
END.


/*
 * set the codepage for the cell
 * jc 12.11.04
 */
PROCEDURE vpr_SetCellCodePage:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT PARAM p-CP       AS CHAR   NO-UNDO. /* No-formatted text (s.t.c.)              */

    DEF VAR p-res AS INT NO-UNDO.

    RUN VpSetCellCodePage(CAPS(p-cell), CAPS(p-group), CAPS(p-CP), OUTPUT p-res).
END.





/* Set the resize-flag of cell (increasing cell = yes)
   Parameter p-dynamic set to logical parameter. */
PROCEDURE vpr_SetCellAutoResize:
    DEF INPUT PARAM p-cell       AS CHAR    NO-UNDO.
    DEF INPUT PARAM p-group      AS CHAR    NO-UNDO.
    /* 0 = static / 1 = dynamic cell */
    DEF INPUT PARAM p-AutoRes    AS CHAR    NO-UNDO.

    DEFINE VARIABLE p-err      AS INT NO-UNDO.
    DEFINE VARIABLE lp-autores AS LOG NO-UNDO.
  
    CASE TRIM(p-AutoRes):
        WHEN "TRUE" THEN 
            DO:
                lp-AutoRes = TRUE.
            END.
    
        WHEN "YES" THEN 
            DO:
                lp-AutoRes = TRUE.
            END.
    
        WHEN "ON" THEN 
            DO:
                lp-AutoRes = TRUE.
            END.
    
        WHEN "1" THEN 
            DO:
                lp-AutoRes = TRUE.
            END.
    
        WHEN "resize" THEN 
            DO:
                lp-AutoRes = TRUE.
            END.
    
        OTHERWISE 
        DO:
            lp-AutoRes = FALSE.
        END.
    END.

  
  
    RUN VpSetResize(CAPS(p-cell), CAPS(p-group), IF lp-AutoRes THEN 1 ELSE 0, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SetCellAutoResize: Error".

END.


/* Set the wrap behavior of a cell. */
PROCEDURE vpr_SetCellWrap:
    DEF INPUT PARAM p-cell  AS CHAR NO-UNDO.
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.    
    DEF INPUT PARAM p-Wrap  AS CHAR NO-UNDO. /* wrap on/off, off is default */

    DEFINE VARIABLE p-err   AS INT NO-UNDO.
    DEFINE VARIABLE lp-wrap AS LOG NO-UNDO.

  
  
    lp-wrap = FALSE.
    CASE TRIM(p-wrap):
        WHEN "TRUE" THEN 
            DO:
                lp-wrap = TRUE.
            END.

        WHEN "WRAP" THEN 
            DO:
                lp-wrap = TRUE.
            END.

        WHEN "ON" THEN 
            DO:
                lp-wrap = TRUE.
            END.
    
    END.
  
    RUN VpSetCellWrap (CAPS(p-cell), CAPS(p-group), IF lp-Wrap THEN 1 ELSE 0, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SetCellWrap: Error".

END.


/* Set the Skip before and after a group.
   The skip area is an invisible place to get better looking printouts. */
PROCEDURE vpr_SetGroupSkip:
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-Point AS CHAR NO-UNDO.
    DEF INPUT PARAM p-pre   AS INT  NO-UNDO.
    DEF INPUT PARAM p-post  AS INT  NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSetGroupSkip (
        CAPS(p-group), 
        p-pre, 
        p-post, 
        IF CAN-DO("Points,Point,Pt", p-Point) THEN 1 ELSE 0 , OUTPUT p-err).

    IF p-err <> 0 THEN RETURN ERROR "SetGroupSkip: Error".
END.


/*
 * helper to change the "align" value from strings to the number encoding used internally
 * - SetCellAlign
 *
 * jc, 19.04.02
 */
PROCEDURE vpr_my_changealign:
    DEFINE INPUT PARAMETER  p-char  AS CHAR NO-UNDO.
    DEFINE OUTPUT PARAMETER p-style AS INT  NO-UNDO.
    
    /*
     * support old numbers...
     */
    p-style = INTEGER(p-char) NO-ERROR.
    IF NOT ERROR-STATUS:ERROR THEN RETURN.

    CASE TRIM(p-char):

        WHEN "left" THEN 
            DO:
                p-style = 1.
            END.

        WHEN "right" THEN 
            DO:
                p-style = 2.
            END.

        WHEN "center" THEN 
            DO:
                p-style = 3.
            END.

        WHEN "block" THEN 
            DO:
                p-style = 4.
            END.
        
        WHEN "justify" THEN 
            DO:
                p-style = 4.
            END.
        
        OTHERWISE 
        DO:
            p-style = 0.
        END.
    END.
END.




/* Justifies in cell; s.docu for possible values */
PROCEDURE vpr_SetCellAlign:
    DEF INPUT PARAM  p-cell  AS CHAR  NO-UNDO.
    DEF INPUT PARAM  p-group AS CHAR  NO-UNDO.
    /* 0, 1 = linksbuendig, 2 = rechtsbuendig, 3 = zentriert, 4 = blocksatz 
       (noch nicht implementiert) */
    DEF INPUT PARAM  p-type  AS CHAR   NO-UNDO.
  
    DEFINE VARIABLE p-err   AS INT NO-UNDO.
    DEFINE VARIABLE lp-type AS INT NO-UNDO.

    RUN vpr_my_changealign(p-type, OUTPUT lp-type).
  
  
  
    RUN VpSetJustify(CAPS(p-cell), CAPS(p-group), lp-type, OUTPUT p-err).

    IF p-err <> 0 THEN RETURN ERROR "SetCellAlign: Error".
END.


/* SetCellColor - sets the Colors and BkMode for Cells */
PROCEDURE vpr_SetCellColor:
    DEF INPUT PARAM p-cell    AS CHAR NO-UNDO.
    DEF INPUT PARAM p-group   AS CHAR NO-UNDO.
    DEF INPUT PARAM p-textc   AS CHAR NO-UNDO.
    DEF INPUT PARAM p-backc   AS CHAR NO-UNDO.
  
    DEF VAR i-textc AS INT NO-UNDO.
    DEF VAR i-backc AS INT NO-UNDO.
    DEF VAR p-err   AS INT NO-UNDO.

    IF    p-backC = ""
        OR p-BackC = ?          THEN 
    DO:
        RUN vpr_CalcCol (p-textc, OUTPUT i-textc).
    
        RUN VpSetCellColor (CAPS(p-cell), CAPS(p-group), i-textc, 0, 0, OUTPUT p-err).
    END.
    ELSE 
    DO:
        RUN vpr_CalcCol (p-textc, OUTPUT i-textc).
        RUN vpr_CalcCol (p-backc, OUTPUT i-backc).
    
        RUN VpSetCellColor (CAPS(p-cell), CAPS(p-group), i-textc, i-backc, 1, OUTPUT p-err).
    END.
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "SetCellColor: Error".
END.


/* 19.1.98 */

/* SetGroupVPos - set the groups vertical position
   19.01.98 jpc
*/
   
PROCEDURE vpr_SetGroupVPos:
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-VPos AS INT NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

    RUN VpSetGroupVPos(INPUT CAPS(p-group), INPUT p-VPos, OUTPUT p-err).
  
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "SetGroupVPos: Error".
END.


/* 24.09.98 */

/* SetGroupCellPositioning - sets how the cells are positioned on flushgroup
                             and setGroupVPos
   24.09.98 jpc
*/
   
PROCEDURE vpr_SetGroupCellPositioning:
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-Style AS INT NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

    RUN VpSetGroupCellPositioning(INPUT CAPS(p-group), INPUT p-Style, OUTPUT p-err).
  
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "SetGroupCellPositioning: Error".
END.


/* SetCellSplit - sets if the cell should be able to have multiple
      "instances", i.e. if a part of the cells text does not fit
      into it, keep some or all of the text for the next "incarnation"
   13.11.98 jpc
*/

PROCEDURE vpr_SetCellSplit:
    DEF INPUT PARAM p-Group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-Cell  AS CHAR NO-UNDO.
    DEF INPUT PARAM p-split AS CHAR NO-UNDO.
  
    DEF VAR p-err    AS INT NO-UNDO.
    DEF VAR lp-split AS INT NO-UNDO.
  
    lp-split = 0.
    p-split = CAPS(TRIM(p-split)).
    IF p-split = "COPY"   THEN lp-split=2.
    IF p-split = "SPLIT"  THEN lp-split=1.
    IF p-split = "ON"     THEN lp-split=1.

    RUN VpSetCellSplit(CAPS(p-group), CAPS(p-cell), lp-split, OUTPUT p-err).
  
    /* Error-Tracking */
    IF p-err <> 0 THEN RETURN ERROR "SetCellSplit: Error".
END.



/****************************
 * BUFFER STUFFA            *
 * 10.12.98 jc              *
 ****************************/

/* SetCellText: Set the buffer value of a cell 
                This overwrites the previous
                buffer contents
   10.12.98 jc
*/
PROCEDURE vpr_SetCellBuffer:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT PARAM p-text     AS CHAR   NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSetCellBuffer (CAPS(p-cell), CAPS(p-group), p-text, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SetCellBuffer: Error".
END.


/* AddToCellText: Append text to the buffer 
   10.12.98 jc
*/
PROCEDURE vpr_AddToCellBuffer:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.    
    DEF INPUT PARAM p-text     AS CHAR   NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpAddToCellBuffer (CAPS(p-cell), CAPS(p-group), p-text, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "AddToCellBuffer: Error".
END.


/* DeleteCellText: Clear a cells buffer 
   10.12.98 jc
*/
PROCEDURE vpr_DeleteCellBuffer:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.    

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpDeleteCellBuffer (CAPS(p-cell), CAPS(p-group), OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "DeleteCellBuffer: Error".
END.


/* SubmitCellText: Append text to the buffer 
   10.12.98 jc
*/
PROCEDURE vpr_SubmitCellBuffer:
    DEF INPUT PARAM p-cell     AS CHAR   NO-UNDO.
    DEF INPUT PARAM p-group    AS CHAR   NO-UNDO.    

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSubmitCellBuffer (CAPS(p-cell), CAPS(p-group), OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SubmitCellBuffer: Error".
END.







/****************************************
 * Fetch cell, group, and page attributes *
 ****************************************/

/*
 * FetchCellWidth - retrieve the width of a cell
 */
PROCEDURE vpr_FetchCellWidth:
    DEF INPUT  PARAM   p-cell   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM   p-group  AS CHAR  NO-UNDO.
    DEF OUTPUT PARAM   p-width  AS INT   NO-UNDO.

  
  
    RUN VpGetCellWidth(CAPS(p-cell), CAPS(p-group), OUTPUT p-width).

    IF p-width = -1 THEN RETURN ERROR "FetchCellWidth: Error".
END.





 
/* gives height of cell  */
PROCEDURE vpr_FetchCellHeight:
    DEF INPUT  PARAM   p-cell   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM   p-group  AS CHAR  NO-UNDO.
    DEF OUTPUT PARAM   p-height AS INT   NO-UNDO.

    /*  DEF VAR p-err AS INT NO-UNDO.
    */
  
  
    RUN VpCellHeight(CAPS(p-cell), CAPS(p-group), OUTPUT p-height).

    IF p-height = -1 THEN RETURN ERROR "FetchCellHeight: Error".
END.


/* Returns height of group. The height of the group is the height
   of the heighest cell. */
PROCEDURE vpr_FetchGroupHeight :
    DEF INPUT PARAM p-group   AS CHAR NO-UNDO.
    DEF OUTPUT PARAM p-height AS INT  NO-UNDO.
  
    /*  DEF VAR p-err AS INT NO-UNDO.
    */
  
  
    RUN VpGroupHeight(CAPS(p-group), OUTPUT p-height).

    IF p-height = -1 THEN RETURN ERROR "FetchGroupHeight: Error".
END.


/* Returns free vertical space on page (with flushed cells)  */
PROCEDURE vpr_FetchPageVSpace:
    DEF OUTPUT PARAM   p-space AS INT  NO-UNDO.

    /*  DEF VAR p-err AS INT NO-UNDO.
    */
  
  
    RUN VpGetFree(OUTPUT p-space).
  
    /* Error-Tracking. */
    IF p-Space = -1 THEN RETURN ERROR "VpFetchFree: Error".
END.


/* Returns vertical position of cursor */
PROCEDURE vpr_FetchPageVPos:
    DEF OUTPUT PARAM p-pos AS INT NO-UNDO.

    /*  DEF VAR p-err AS INT NO-UNDO.
    */
  
  
    RUN VpGetPos(OUTPUT p-pos).
END.



/* Returns number of pages (=actual page)           */
PROCEDURE vpr_FetchPageNo:
    DEF OUTPUT PARAM   p-page AS INT  NO-UNDO.
    
    /*  DEF VAR p-err AS INT NO-UNDO.
    */
  
  
    RUN VpGetPages(OUTPUT p-page).

    IF p-page = -1 THEN RETURN ERROR "FetchPageNo: Error".
END.


/* 19.1.98 */

/* FetchCellVPos - Fetch the vertical position of a cell
   19.1.98 jpc
*/

PROCEDURE vpr_FetchCellVPos:
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-cells AS CHAR NO-UNDO.
    DEF OUTPUT PARAM p-VPos AS INT NO-UNDO.

    RUN VpGetCellVPos(INPUT CAPS(p-group), INPUT CAPS(p-cells), OUTPUT p-VPos).
END.

/* FetchCellHPos - Fetch the horizontal position of a cell
   19.1.98 jpc
*/

PROCEDURE vpr_FetchCellHPos:
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-cells AS CHAR NO-UNDO.
    DEF OUTPUT PARAM p-HPos AS INT NO-UNDO.

    RUN VpGetCellHPos(INPUT CAPS(p-group), INPUT CAPS(p-cells), OUTPUT p-HPos).
END.

/* FetchGroupVPos - Fetch the vertical position of a group
   19.1.98 jpc
*/

PROCEDURE vpr_FetchGroupVPos:
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF OUTPUT PARAM p-VPos AS INT NO-UNDO.

    RUN VpGetGroupVPos(INPUT CAPS(p-group), OUTPUT p-VPos).
END.

/* 23.11.98 */

/* FetchCellLineCount - return the number of lines in a cell
   23.11.98 jpc
*/

PROCEDURE vpr_FetchCellLineCount:
    DEF INPUT PARAM p-group AS CHAR NO-UNDO.
    DEF INPUT PARAM p-cells AS CHAR NO-UNDO.
    DEF OUTPUT PARAM p-LineCount AS INT NO-UNDO.

    RUN VpGetCellLineCount(INPUT CAPS(p-group), INPUT CAPS(p-cells), OUTPUT p-LineCount).
END.










/****************************
 * FlushGroup, NewPage, etc *
 ****************************/

/* prints all cells of given group and increases the line pointer 
   of this group. */
PROCEDURE vpr_FlushGroup :
    DEF INPUT PARAM p-group   AS CHAR    NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpFlushGroup(CAPS(p-group), OUTPUT p-err).

    IF p-err <> 0 THEN RETURN ERROR "FlushGroup: Error".
END.


/* creates new page and resets cell-coordinates     */
PROCEDURE vpr_NewPage:
    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpNewPage(OUTPUT p-err).
  
    IF p-err <> 0 THEN RETURN ERROR "NewPage: Error".
END.

/* sets properties like PageOrientation and PaperTray for the current page
   27.08.1999 jc */
PROCEDURE vpr_SetCurrentPageProperties:
    DEF INPUT PARAM p-prop AS CHAR NO-UNDO.
    DEF INPUT PARAM p-value AS CHAR NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

  

    p-value = IF p-value = "Portrait"  THEN "1"
    ELSE IF p-value = "Landscape" THEN "2"
    ELSE p-value.
  
    RUN VpSetCurrentPageProperties(CAPS(p-prop), p-value, OUTPUT p-err).
  
    IF p-err <> 0 THEN RETURN ERROR "SetCurrentPageProperties: Error".
END.


/*
 * vpr_SetPageVPos: Set the current pos on the current page
 * 25.04.05 jc
 */
PROCEDURE vpr_SetPageVPos:
    DEF INPUT PARAM p-pos AS INT NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.
  
  

    RUN VpSetPageVPos(p-pos, OUTPUT p-err).
  
    IF p-err <> 0 THEN RETURN ERROR "SetPageVPos: Error".
END.


/*
 * SetPaperSize: Set the current paper size
 *
 * 03.07.2001 jc
 */
PROCEDURE vpr_SetPaperSize:
    DEF INPUT PARAM   p-width AS INT  NO-UNDO.
    DEF INPUT PARAM   p-height AS INT NO-UNDO.
  
    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSetPaperSize(p-width, p-height, OUTPUT p-err).

    IF p-err <> 0 THEN RETURN ERROR "SetPaperSize: Error".
END.
  

/* Start printing from page-no to page-no.
   To print all supply 0, 0 */
PROCEDURE vpr_PrintDoc:
    DEF INPUT PARAM   p-from AS INT  NO-UNDO.
    DEF INPUT PARAM   p-to   AS INT  NO-UNDO.
  
    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpPrint(p-from, p-to, OUTPUT p-err).

    IF p-err <> 0 THEN RETURN ERROR "PrintDoc: Error".
END.



/* 
 * PrintPDF:
 * "Printing" to a PDF file, analogous to PrintDoc
 * except for the additional parameter p-FNAM, that provides
 * the filename for the PDF file.
 * If p-FNAM is left blank viper will create a temporary file
 * and return its name in FNAM
 */
PROCEDURE vpr_PrintPDF:
    DEF INPUT PARAM   p-from AS INT  NO-UNDO.
    DEF INPUT PARAM   p-to   AS INT  NO-UNDO.
    DEF INPUT-OUTPUT PARAM p-fnam AS CHAR NO-UNDO.

    DEF VAR fOut           AS CHAR NO-UNDO.
    DEF VAR fPDF           AS CHAR NO-UNDO.
    DEF VAR Com            AS CHAR NO-UNDO.
    DEF VAR lp-optional-ps AS CHAR NO-UNDO INIT "". /* optional ps file, used for landscape */
    DEF VAR lp-papersize   AS CHAR NO-UNDO INIT "a4".
    DEF VAR p-err          AS INT  NO-UNDO.

  
  
    fOut=FILL(" ",255).        /* ensure fOut has enuff room */

    /* bug in 10.0B */
    RUN VpWebPrintDoc(p-from, p-to, gvp_webprt, INPUT-OUTPUT fOut, OUTPUT p-err).

    fOut = TRIM(fOut).
    fPDF = SUBSTR(fOut, 1, R-INDEX(fOut, ".")) + "pdf".
  
    /* win8 / gs9 fix */  
    /**
    IF l-printorientation = 2 THEN DO:    /* Landscape */
  /*  lp-optional-ps = "lscap.ps". */
      lp-papersize = lp-papersize + "q".
      RUN VpSetLandscapePS(fOut,1, OUTPUT p-err).       /* setlandscape: forcerotate!! */
    END.
  
    RUN VpPS2PDF(gvp_GSEXE,
                 gvp_GSDIR,
                 gvp_GSFONTPATH,
                 "-dBATCH -dNOPAUSE -dQUIET -r300x300 -sPAPERSIZE=" + lp-papersize, lp-optional-ps, 
  /*               "-r300x300 -sPAPERSIZE=" + lp-papersize, lp-optional-ps,*/
                 "pdfwrite",fOut,fPDF, OUTPUT p-err).
    **/
    
    IF l-printorientation = 2 THEN 
    DO:    /* Landscape */
        lp-papersize = "-dDEVICEWIDTHPOINTS=842 -dDEVICEHEIGHTPOINTS=595 -dNORANGEPAGESIZE".
    END. 
    ELSE 
    DO:
        lp-papersize = "-sPAPERSIZE=a4".
    END.

    RUN VpPS2PDF(gvp_GSEXE,
        gvp_GSDIR,
        gvp_GSFONTPATH,
        "-dBATCH -dNOPAUSE -dQUIET -r300x300 " + lp-papersize, lp-optional-ps, 
        "pdfwrite",fOut,fPDF, OUTPUT p-err).
    /* win8 / gs9 fix */


    IF p-err = 0 THEN 
    DO:         /* only delete the ps-file if no error has occured. */
        OS-DELETE VALUE(fOUT).
    END.
  
    IF p-fnam = "" THEN 
    DO:
        p-fnam = fPDF.
    END.
    ELSE 
    DO:
        FILE-INFO:FILE-NAME = p-fnam.
        IF FILE-INFO:FULL-PATHNAME <> ? THEN 
        DO:
            OS-DELETE VALUE(FILE-INFO:FULL-PATHNAME).
        END.
        OS-COPY VALUE(fPDF) VALUE(p-fnam).
        OS-DELETE VALUE(fPDF).
    END.

    IF p-err <> 0 THEN RETURN ERROR "PrintPDF: Error".
END.

 





PROCEDURE vpr_WebPrintDoc:
    DEF INPUT PARAM   p-from      AS INT  NO-UNDO.
    DEF INPUT PARAM   p-to        AS INT  NO-UNDO.
    DEF INPUT PARAM   p-method    AS CHAR NO-UNDO.

    DEF VAR p-err        AS INT  NO-UNDO.
    DEF VAR fOut         AS CHAR NO-UNDO.
    DEF VAR fPDF         AS CHAR NO-UNDO.
    DEF VAR Com          AS CHAR NO-UNDO.
    DEF VAR fPDF_base    AS CHAR NO-UNDO.
    DEF VAR lp-papersize AS CHAR NO-UNDO INIT "a4".
    DEF VAR lp-tmp       AS CHAR NO-UNDO.
    DEF VAR lp-crlf      AS CHAR NO-UNDO.
  
    lp-crlf = CHR(13) + CHR(10).
  
    fOut=FILL(" ",255).        /* ensure fOut has 'nuff room */
    RUN vpr_PrintOptions("ShowPrintStatus","Off","","","").
    RUN VpWebPrintDoc(p-from, p-to, gvp_webprt, OUTPUT fOut, OUTPUT p-err).

    fOut = TRIM(fOut).
    fPDF = SUBSTR(fOut, 1, R-INDEX(fOut, ".")) + "pdf".
  
    /**
      Com = "{&WEBPS2PDF} " + SUBSTR(fOut, 1, R-INDEX(fOut, ".") - 1) + ' "{&VP_GSDIR}"'.
      OS-COMMAND SILENT VALUE(Com).
    */
    IF l-printorientation = 2 THEN 
    DO:    /* Landscape */
        lp-papersize = lp-papersize + "q".
        RUN VpSetLandscapePS(fOut,1, OUTPUT p-err).       /* setlandscape: forcerotate!! */
    END.

    RUN VpPS2PDF(gvp_GSEXE,
        gvp_GSDIR,
        gvp_GSFONTPATH,
        "-dBATCH -dNOPAUSE -dQUIET -r300x300 -sPAPERSIZE=" + lp-papersize, "", 
        /*               "-r300x300 -sPAPERSIZE=" + lp-papersize, "",*/
        "pdfwrite",fOut,fPDF, OUTPUT p-err).

    IF p-err = 0 THEN 
    DO:         /* only delete the ps-file if no error has occured. */
        OS-DELETE VALUE(fOUT).
    END.

  

    MESSAGE "WebPrinting is not enabled" VIEW-AS ALERT-BOX.


    IF p-err <> 0 THEN RETURN ERROR "WebPrintDoc: Error".
END.
  








/******************
 * Graphics stuff *
 ******************/

/*
 * helper to change the linestyles from strings to the number encoding used internally
 *
 * jc, 19.04.02
 */
PROCEDURE vpr_my_changestyle:
    DEFINE INPUT PARAMETER  p-char  AS CHAR NO-UNDO.
    DEFINE OUTPUT PARAMETER p-style AS INT  NO-UNDO.
    
    /*
     * support old numbers...
     */
    p-style = INTEGER(p-char) NO-ERROR.
    IF NOT ERROR-STATUS:ERROR THEN RETURN.

    CASE TRIM(p-char):
        WHEN "Solid" THEN 
            DO:
                p-style = 0.
            END.

        WHEN "Dash" THEN 
            DO:
                p-style = 1.
            END.

        WHEN "Dot" THEN 
            DO:
                p-style = 2.
            END.

        WHEN "DashDot" THEN 
            DO:
                p-style = 3.
            END.

        WHEN "DashDotDot" THEN 
            DO:
                p-style = 4.
            END.
        
        OTHERWISE 
        DO:
            p-style = 0.
        END.
    END.
END.


/*
 * helper to change the "justify" value from strings to the number encoding used internally
 *
 * jc, 19.04.02
 */
PROCEDURE vpr_my_changejustify:
    DEFINE INPUT PARAMETER  p-char  AS CHAR NO-UNDO.
    DEFINE OUTPUT PARAMETER p-style AS INT  NO-UNDO.
    
    /*
     * support old numbers...
     */
    p-style = INTEGER(p-char) NO-ERROR.
    IF NOT ERROR-STATUS:ERROR THEN RETURN.

    CASE TRIM(p-char):
        WHEN "fill" THEN 
            DO:
                p-style = -1.
            END.

        WHEN "left" THEN 
            DO:
                p-style = 1.
            END.

        WHEN "right" THEN 
            DO:
                p-style = 2.
            END.

        WHEN "center" THEN 
            DO:
                p-style = 3.
            END.

        WHEN "centered" THEN 
            DO:
                p-style = 3.
            END.
        
        OTHERWISE 
        DO:
            p-style = 0.
        END.
    END.
END.


/*
 * helper to change the "fill" value (for rectangles) from strings to the number encoding used internally
 *
 * jc, 19.04.02
 */
PROCEDURE vpr_my_changefilled:
    DEFINE INPUT PARAMETER  p-char  AS CHAR NO-UNDO.
    DEFINE OUTPUT PARAMETER p-style AS INT  NO-UNDO.
    
    /*
     * support old numbers...
     */
    p-style = INTEGER(p-char) NO-ERROR.
    IF NOT ERROR-STATUS:ERROR THEN RETURN.

    CASE TRIM(p-char):
        WHEN "fill" THEN 
            DO:
                p-style = 1.
            END.

        WHEN "filled" THEN 
            DO:
                p-style = 1.
            END.

        WHEN "true" THEN 
            DO:
                p-style = 1.
            END.

        WHEN "yes" THEN 
            DO:
                p-style = 1.
            END.

        WHEN "on" THEN 
            DO:
                p-style = 1.
            END.
        
        OTHERWISE 
        DO:
            p-style = 0.
        END.
    END.
END.



/* draw line               
 * jc - yet another very old one
 *  ke, changed color to char. 
 * jc, 19.04.02 - changed p-style parameter to char, supporting sensible names
 *                for the line styles
 */
PROCEDURE vpr_DefFreeLine:
    DEF INPUT PARAM p-x         AS INT  NO-UNDO.
    DEF INPUT PARAM p-y         AS INT  NO-UNDO.
    DEF INPUT PARAM p-width     AS INT  NO-UNDO.
    DEF INPUT PARAM p-height    AS INT  NO-UNDO.
    DEF INPUT PARAM p-style     AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-bwidth    AS INT  NO-UNDO.
    DEF INPUT PARAM p-col       AS CHAR NO-UNDO.

    DEF VAR p-err    AS INT NO-UNDO.
    DEF VAR l-Col    AS INT NO-UNDO.

    DEF VAR lp-style AS INT NO-UNDO.
    RUN vpr_my_changestyle (p-style, OUTPUT lp-style).

    RUN vpr_CalcCol (p-Col, OUTPUT l-Col).

  
  
    RUN VpFreeLine(p-x, p-y,
        p-width, p-height,
        lp-style, p-bwidth, l-col, OUTPUT p-err).
                 
    IF p-err <> 0 THEN RETURN ERROR "DefFreeLine: Error".
END.



/* draw rectangle           */
PROCEDURE vpr_DefRect:
    DEF INPUT PARAM p-x         AS INT NO-UNDO.
    DEF INPUT PARAM p-y         AS INT NO-UNDO.
    DEF INPUT PARAM p-width     AS INT NO-UNDO.
    DEF INPUT PARAM p-height    AS INT NO-UNDO.
    DEF INPUT PARAM p-filled    AS CHAR NO-UNDO.
    DEF INPUT PARAM p-col       AS CHAR NO-UNDO.

    DEF    VAR      p-err     AS INT NO-UNDO.
    DEF    VAR      l-Col     AS INT NO-UNDO.

    DEFINE VARIABLE lp-filled AS INT NO-UNDO.
    RUN vpr_my_changefilled(p-filled, OUTPUT lp-filled).
  
    RUN vpr_CalcCol (p-Col, OUTPUT l-Col).

  
  
    RUN VpRectangle(p-x,p-y,p-width,p-height,lp-filled,l-col, OUTPUT p-err).

    IF p-err <> 0 THEN RETURN ERROR "DefRect: Error".
END.


/* draw rounded rectangle   */
PROCEDURE vpr_DefRndRect :
    DEF INPUT PARAM p-x         AS INT NO-UNDO.
    DEF INPUT PARAM p-y         AS INT NO-UNDO.
    DEF INPUT PARAM p-width     AS INT NO-UNDO.
    DEF INPUT PARAM p-height    AS INT NO-UNDO.
    DEF INPUT PARAM p-filled    AS CHAR NO-UNDO.
    DEF INPUT PARAM p-col       AS CHAR NO-UNDO.

    DEF    VAR      p-err     AS INT NO-UNDO.
    DEF    VAR      l-Col     AS INT NO-UNDO.

    DEFINE VARIABLE lp-filled AS INT NO-UNDO.
    RUN vpr_my_changefilled(p-filled, OUTPUT lp-filled).
  
    RUN vpr_CalcCol (p-Col, OUTPUT l-Col).

  
  
    RUN VpRoundRect(p-x,p-y,p-width,p-height,lp-filled,l-col, OUTPUT p-err).

    IF p-err <> 0 THEN RETURN ERROR "DefRndRect: Error".
END.


/* horizontal line */
PROCEDURE vpr_DefHLine :
    DEF INPUT PARAM p-x     AS INT NO-UNDO.
    DEF INPUT PARAM p-y     AS INT NO-UNDO.
    DEF INPUT PARAM p-len   AS INT NO-UNDO.
    DEF INPUT PARAM p-style AS CHAR NO-UNDO.
    DEF INPUT PARAM p-width AS INT NO-UNDO.
    DEF INPUT PARAM p-col   AS CHAR NO-UNDO.

    DEF VAR p-err    AS INT NO-UNDO.
    DEF VAR l-Col    AS INT NO-UNDO.

    DEF VAR lp-style AS INT NO-UNDO.
    RUN vpr_my_changestyle (p-style, OUTPUT lp-style).

    RUN vpr_CalcCol (p-Col, OUTPUT l-Col).
  
  
  
    RUN VpHLine(p-x,p-y,p-len,lp-style,p-width,l-col, OUTPUT p-err).

    IF p-err <> 0 THEN RETURN ERROR "DefHLine: Error".
END.

    
/* vertical line */
PROCEDURE vpr_DefVLine :
    DEF INPUT PARAM p-x     AS INT NO-UNDO.
    DEF INPUT PARAM p-y     AS INT NO-UNDO.
    DEF INPUT PARAM p-len   AS INT NO-UNDO.
    DEF INPUT PARAM p-style AS CHAR NO-UNDO.
    DEF INPUT PARAM p-width AS INT NO-UNDO.
    DEF INPUT PARAM p-col   AS CHAR NO-UNDO.

    DEF VAR p-err    AS INT NO-UNDO.
    DEF VAR l-Col    AS INT NO-UNDO.

    DEF VAR lp-style AS INT NO-UNDO.
    RUN vpr_my_changestyle (p-style, OUTPUT lp-style).

    RUN vpr_CalcCol (p-Col, OUTPUT l-Col).

  
  
    RUN VpVLine(p-x,p-y,p-len,lp-style,p-width,l-col, OUTPUT p-err).    

    IF p-err <> 0 THEN RETURN ERROR "DefVline: Error".
END.


/* sets horizontal separator (line) at current cursor-pos. */
PROCEDURE vpr_DefHSep:
    DEF INPUT PARAM p-len       AS INT NO-UNDO.
    DEF INPUT PARAM p-justify   AS CHAR NO-UNDO.
    DEF INPUT PARAM p-style     AS CHAR NO-UNDO.
    DEF INPUT PARAM p-width     AS INT NO-UNDO.
    DEF INPUT PARAM p-col       AS CHAR NO-UNDO.

    DEF VAR p-err    AS INT NO-UNDO.
    DEF VAR l-Col    AS INT NO-UNDO.

    DEF VAR lp-style AS INT NO-UNDO.
    RUN vpr_my_changestyle (p-style, OUTPUT lp-style).

    DEF VAR lp-justify AS INT NO-UNDO.
    RUN vpr_my_changejustify (p-justify, OUTPUT lp-justify).

    RUN vpr_CalcCol (p-Col, OUTPUT l-Col).

  
  
    RUN VpHSep(p-len,lp-justify,lp-style,p-width,l-col, OUTPUT p-err).
  
    IF p-err <> 0 THEN RETURN ERROR "DefHSep: Error".
END.







/****************************
 * error reporting          *
 ****************************/

/* read-error-report                */
PROCEDURE vpr_VReadErrors:
    /* last error-no.                          */
    DEF INPUT-OUTPUT  PARAM p-lasterr AS INT   NO-UNDO.
    /* number of errors occured                */
    DEF OUTPUT        PARAM p-err     AS INT   NO-UNDO.
    
  
  
    RUN ReadErrors(INPUT-OUTPUT p-lasterr, OUTPUT p-err).

/*  IF p-err = -1 THEN RETURN ERROR ": Error".*/
END.








/*******************************
 * nifty little picture things *
 *******************************/
/*
 * vpr_DefBMP: 
 *      Define a Bitmap to be shown by Viper
 * jc - one of the earliest commands we had...
 * jc - 19.04.02/Viper3.0: removed the two logical paramter, added 
 *      one character instead. Use sensible strings now [No]Resize/[No]KeepRatio
 */

PROCEDURE vpr_DefBmp:
    DEF INPUT PARAM   p-Name   AS CHAR   NO-UNDO.
    DEF INPUT PARAM   p-x      AS INT    NO-UNDO.
    DEF INPUT PARAM   p-y      AS INT    NO-UNDO.
    DEF INPUT PARAM   p-width  AS INT    NO-UNDO.
    DEF INPUT PARAM   p-height AS INT    NO-UNDO.
    DEF INPUT PARAM   p-mode   AS CHAR   NO-UNDO.

    DEFINE VARIABLE lp-adjust   AS LOG  NO-UNDO.
    DEFINE VARIABLE lp-ratio    AS LOG  NO-UNDO.
    DEFINE VARIABLE lp-ii       AS INT  NO-UNDO.
  
    DEF    VAR      p-err       AS INT  NO-UNDO.
    DEF    VAR      lp-savename AS CHAR NO-UNDO.

  
  
    lp-adjust = FALSE.
    lp-ratio = FALSE.

    DO lp-ii = 1 TO NUM-ENTRIES(p-mode):
        CASE TRIM(ENTRY(lp-ii, p-mode)):
            WHEN "KeepRatio" THEN 
                DO:
                    lp-ratio = TRUE.
                END.
            WHEN "NoKeepRatio" THEN 
                DO:
                    lp-ratio = FALSE.
                END.
            WHEN "Keep" THEN 
                DO:
                    lp-ratio = TRUE.
                END.
            WHEN "NoKeep" THEN 
                DO:
                    lp-ratio = FALSE.
                END.
            WHEN "Ratio" THEN 
                DO:
                    lp-ratio = TRUE.
                END.
            WHEN "NoRatio" THEN 
                DO:
                    lp-ratio = FALSE.
                END.
            WHEN "Resize" THEN 
                DO:
                    lp-adjust = TRUE.
                END.
            WHEN "NoResize" THEN 
                DO:
                    lp-adjust = FALSE.
                END.
        END.
    END.   
  
    /* make sure we find the pix */
    /* save current value of FUEL-INFO */
    lp-savename = FILE-INFO:FULL-PATHNAME.
  
    /* get full-pathname to the pic. */
    FILE-INFO:FILE-NAME = p-name.
    p-name = FILE-INFO:FULL-PATHNAME.
  
    /* restore FILE-INFO */
    FILE-INFO:FILE-NAME = lp-savename.
  
    IF p-Name = ? THEN 
    DO:
        RETURN ERROR "DefBmp: Error - file not found".
    END.

    RUN VpBitMap 
        (p-name, 
        p-x, p-y, p-width, p-height, 
        IF lp-adjust THEN 1 ELSE 0, IF lp-ratio THEN 1 ELSE 0, OUTPUT p-err).
     
    IF p-err <> 0 THEN RETURN ERROR "DefBmp: Error".
END.



/* SaveClipboardToFile - saves the clipboard contents
   Type: defines the datatype to be saved. so far only bitmap (BMP)
        and Device Independent Bitmap (DIB) is supported
   FileIn: Filename to save the data to. if no FileIn is given 
        (i.e. an empty string) a temporary file with a unique filename
        is chosen.
   FileOut: returns the filename. empty if the procedure fails.
   17.07.98 jc
*/

PROCEDURE vpr_SaveClipboardToFile:
    DEF INPUT PARAM   Type    AS CHAR NO-UNDO.
    DEF INPUT PARAM   FileIn  AS CHAR NO-UNDO.
    DEF OUTPUT PARAM   FileOut AS CHAR NO-UNDO.
                                            
    DEF VAR p-err AS INT NO-UNDO.
    DEF VAR iType AS INT NO-UNDO.
  
  
  
    iType=0.
    CASE Type:
        WHEN "BITMAP"   THEN 
            iType=2.
        WHEN "BMP"      THEN 
            iType=2.
        WHEN "DIB"      THEN 
            iType=2.
    END CASE.
  
    FileOut=FILL(" ",255).        /* ensure FileOut has 'nuff room */
    /* bug in 10.0B */
    RUN VpSaveClipboardToFile(iType,FileIn,INPUT-OUTPUT FileOut, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SaveClipboardToFile: Error".
END.  




/* SaveWindowToFile - saves the given window as DIB
   HWND: Windowhandle of the window that should be saved.
   AreaType: Save all of HWND or only clientarea?
   FileIn: Filename to save the data to. if no FileIn is given 
        (i.e. an empty string) a temporary file with a unique filename
        is chosen.
   FileOut: returns the filename. empty if the procedure fails.
   17.07.98 jc
*/

PROCEDURE vpr_SaveWindowToFile:
    DEF INPUT PARAM   HWND    AS INT NO-UNDO.
    DEF INPUT PARAM   AreaType AS CHAR NO-UNDO.
    DEF INPUT PARAM   FileIn  AS CHAR NO-UNDO.
    DEF OUTPUT PARAM  FileOut AS CHAR NO-UNDO.
                                            
    DEF VAR p-err AS INT NO-UNDO.
    DEF VAR iType AS INT NO-UNDO.
  
  
  
    iType=2.
    CASE AreaType:
        WHEN "ALL"   THEN 
            iType=1.
        WHEN "WINDOW"      THEN 
            iType=1.
        WHEN "CLIENT"      THEN 
            iType=2.
    END CASE.
  
    FileOut=FILL(" ",255).        /* ensure FileOut has 'nuff room */
    /* bug in 10.0.b */
    RUN VpSaveWindowToFile(HWND,iType,FileIn,INPUT-OUTPUT FileOut, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SaveWindowToFile: Error".
END.  








/*************************
 * window control stuff *
 *************************/

/* Show the preview window */
PROCEDURE vpr_ShowPreview:
    /*  DEF OUTPUT PARAM   p-err AS SHORT  NO-UNDO.
      */
    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpShowPreview(OUTPUT p-err).
  
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "ShowPreview: Error".
END.

/* Hide the preview window */
PROCEDURE vpr_HidePreview:
    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpHidePreview(OUTPUT p-err).
  
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "HidePreview: Error".
END.


/*
 * Get the current preview state (hidden/visible)
 *
 * 17.03.03 jc
 */
PROCEDURE vpr_FetchPreviewStatus:
    DEF INPUT  PARAM p-wait   AS INT NO-UNDO.
    DEF OUTPUT PARAM p-status AS INT NO-UNDO.

    DEF VAR p-prevstat AS CHAR NO-UNDO.

  

    RUN VpGetPreviewStatus(INPUT p-wait, OUTPUT p-status).
    IF p-status=1 THEN 
    DO:
        p-prevstat = "visible".
    END.
    ELSE 
    DO:
        p-prevstat = "hidden".
    END.
END.


/* Set the window position and size */
PROCEDURE vpr_SetWindowPos:
    DEF INPUT PARAM p-left    AS INT NO-UNDO.
    DEF INPUT PARAM p-top     AS INT NO-UNDO.
    DEF INPUT PARAM p-width   AS INT NO-UNDO.
    DEF INPUT PARAM p-height  AS INT NO-UNDO.
                                            
    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSetWindowPos(p-left, p-top, p-width, p-height, OUTPUT p-err).
  
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "SetWindowPos: Error".
END.



/*
 * show a persistent preview
 */
PROCEDURE vpr_ShowDoc:
    DEF VAR p-err   AS INT  NO-UNDO.
    DEF VAR lp-fnam AS CHAR NO-UNDO.
  
  
  
    RUN VpShowDoc(OUTPUT p-err).
    IF p-err = 1 THEN 
    DO:
        lp-fnam = SEARCH("VprRead.exe").
        IF lp-fnam = ? THEN 
        DO:
            RETURN ERROR "vpr_showDoc: no way to find VprRead.exe".
        END.
        ELSE 
        DO:
            OS-COMMAND SILENT NO-CONSOLE VALUE(lp-fnam + "/install").
            RUN VpShowDoc(OUTPUT p-err).
        END.
    END.
  
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "vpr_ShowDoc: Error".
END.



/*************************
 * Printer control stuff *
 *************************/

/* select printer */
PROCEDURE vpr_SelectPrinter:
    DEF INPUT PARAM p-name AS CHAR NO-UNDO.
    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpSelectPrinter(INPUT p-name, OUTPUT p-err).
  
    /* Error-Tracking. */
    IF p-err = 2 THEN RETURN "2".
    IF p-err <> 0 THEN RETURN ERROR "SelectPrinter: Error".
END.


/* PrintOptions: You can set different options in VIPER. 
   They are ugly code, most with integer. */
PROCEDURE vpr_PrintOptions:

    /* Name of option you want to set.
       officially known: orientation, Previewmode. */
    DEF INPUT PARAM p-Mode AS CHAR NO-UNDO.
    /* Option 1 to 4 are char options for the user. */
    DEF INPUT PARAM p-Opt1 AS CHAR NO-UNDO.
    DEF INPUT PARAM p-Opt2 AS CHAR NO-UNDO.
    DEF INPUT PARAM p-Opt3 AS CHAR NO-UNDO.
    DEF INPUT PARAM p-Opt4 AS CHAR NO-UNDO.

    DEF VAR lp-Int1  AS INT  NO-UNDO.
    DEF VAR lp-Int2  AS INT  NO-UNDO.
    DEF VAR lp-Int3  AS INT  NO-UNDO.
    DEF VAR lp-Char1 AS CHAR NO-UNDO.
    DEF VAR p-err    AS INT  NO-UNDO.

    /* Switch char options to numeric values. */
    CASE p-Mode:
        WHEN "Orientation":U THEN 
            DO:
                /* Option1 is orientation mode. Opt2-Opt4 are meaningless. */
                lp-Int1 =      IF p-Opt1 = "Default"   THEN 0
                ELSE IF p-Opt1 = "Portrait"  THEN 1
                ELSE IF p-Opt1 = "Landscape" THEN 2
                ELSE 0.
                l-printorientation = lp-int1.
            END. /* of mode orientation */
        WHEN "PreviewMode":U THEN 
            DO:
                /* Option1 is print mode. Opt2-Opt4 are meaningless. */
                lp-Int1 = 
                    IF p-Opt1 = "Preview"    THEN 0 /* Whole doc with preview. */
                    ELSE IF p-Opt1 = "Direct"     THEN 2 /* Whole doc direct to printer */
                    ELSE IF p-Opt1 = "PageByPage" THEN 4 /* Whole doc but pg by pg. */
                    ELSE 0.
            END. /* of mode print mode */
        WHEN "ENABLEPRINTERDIALOG":U THEN 
            DO:
                /* Option1 is on or off. nothing else */
                lp-Int1 =   IF p-Opt1 = "On" THEN 1
                ELSE 0.
            END.    /* PrinterDialog */
        WHEN "SHOWPRINTSTATUS":U THEN 
            DO:
                /* Option1 is on or off. nothing else */
                lp-Int1 =   IF p-Opt1 = "On" THEN 1
                ELSE IF p-Opt1 = "NoCancel" THEN 2
                ELSE 0.
            END.    /* ShowPrintStatus */
        
    END CASE. /* p-mode */
  
  
  
    RUN VpPrintOptions 
        ( CAPS(p-Mode), lp-Int1, lp-Int2, lp-Int3, lp-Char1, OUTPUT p-err ).

    IF p-err <> 0 THEN RETURN ERROR "PrintOptions(SetPageOrientation/SetPreviewMode/SetPrinterDialogMode): Error".
END. /* of printoptions. */


/* Define a wrapper for the printmode orientation. */
PROCEDURE vpr_SetPageOrientation:
    DEF INPUT PARAM p-Orientation AS CHAR NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

    RUN vpr_PrintOptions ("Orientation", p-Orientation, "", "", ""/*, OUTPUT p-err*/).
END PROCEDURE. /* setorientation */


/* Define a wrapper for the previewmode. */
PROCEDURE vpr_SetPreviewMode:
    DEF INPUT PARAM p-Previewmode AS CHAR NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

    RUN vpr_PrintOptions ("Previewmode", p-Previewmode, "", "", ""/*, OUTPUT p-err*/).
END PROCEDURE. /* setorientation */



/* SetPrinterAttrib - fancier print options handling :-))))
   07.04.1998 jpc
   11.10.1999 jpc - added l_PAFLAG to see which values are valid
*/

PROCEDURE vpr_SetPrinterAttrib:
    DEF INPUT PARAM p-Attribs AS CHAR NO-UNDO.
  
    DEF VAR p-err             AS INT    NO-UNDO INIT 0.
    DEF VAR c_entry           AS CHAR   NO-UNDO.
    DEF VAR c_entry_left      AS CHAR   NO-UNDO.
    DEF VAR c_entry_rite      AS CHAR   NO-UNDO.
  
    DEF VAR i_copies          AS INT    NO-UNDO.
    DEF VAR i_from            AS INT    NO-UNDO.
    DEF VAR i_to              AS INT    NO-UNDO.
    DEF VAR i_tofile          AS INT    NO-UNDO.
    DEF VAR i_sort            AS INT    NO-UNDO.
    DEF VAR c_name            AS CHAR   NO-UNDO.
  
    DEF VAR i_duplex          AS INT    NO-UNDO INIT 0.
  
    DEF VAR ptr_PrinterAttrib AS MEMPTR.
  
    DEF VAR ii                AS INT    NO-UNDO.
    DEF VAR ij                AS INT    NO-UNDO.
    DEF VAR l_PAFLAGS         AS INT    NO-UNDO INIT 0.


    ij = NUM-ENTRIES(p-attribs).

  
  
    DO ii = 1 TO ij:
        c_entry = TRIM(ENTRY(ii,p-attribs)).
        c_entry_left=TRIM(ENTRY(1,c_entry,"=")).
        c_entry_rite=TRIM(ENTRY(2,c_entry,"=")).

        CASE c_entry_left:    
            WHEN "Copies"     THEN 
                DO: 
                    i_copies = INT(c_entry_rite). 
                    l_PAFLAGS = l_PAFLAGS + 1 . 
                END.
            WHEN "From"       THEN 
                DO: 
                    i_from = INT(c_entry_rite). 
                    l_PAFLAGS = l_PAFLAGS + 2 . 
                END.
            WHEN "To"         THEN 
                DO: 
                    i_to = INT(c_entry_rite). 
                    l_PAFLAGS = l_PAFLAGS + 4 . 
                END.
            WHEN "ToFile"     THEN 
                DO:
                    i_toFile = IF (c_entry_rite = "YES"
                        OR c_entry_rite = "TRUE") THEN 1 ELSE 0.
                    l_PAFLAGS = l_PAFLAGS + 8 .
                END.
            WHEN "Sort"       THEN 
                DO:
                    i_sort = IF (c_entry_rite = "YES"
                        OR c_entry_rite = "TRUE") THEN 1 ELSE 0.
                    l_PAFLAGS = l_PAFLAGS + 16 .
                END.
            WHEN "PrinterName" THEN 
                DO:  
                    c_name = c_entry_rite. 
                    l_PAFLAGS = l_PAFLAGS + 32 . 
                END.
            WHEN "FileName"   THEN 
                DO: 
                    c_name = c_entry_rite. 
                    l_PAFLAGS = l_PAFLAGS + 32 . 
                END.
            WHEN "FileTo"     THEN 
                DO: 
                    c_name = c_entry_rite. 
                    l_PAFLAGS = l_PAFLAGS + 32 . 
                END.
            WHEN "Name"       THEN 
                DO: 
                    c_name = c_entry_rite. 
                    l_PAFLAGS = l_PAFLAGS + 32 . 
                END.
            WHEN "Duplex"     THEN 
                DO: 
                    i_duplex = INT(c_entry_rite). 
                END.
        END CASE.  
    END.
  
    /* Now setup the structure */
    /* struct PrinterAttrib
       {
          WORD size;      // size of the structure
          BYTE ver;       // version of the structure
          WORD copies;    // number of copies to print
          WORD from;      // first page
          WORD to;        // last page
          BYTE sort;      // sort output?
          BYTE toFile;    // send output to file instead of printer?
          WORD paflags;   // what's been set?
          WORD sizeOfName;// size of the following string
          char name[xxx]; // file or printer name
       }
    */
  
    SET-SIZE(ptr_PrinterAttrib)=16 + LENGTH(c_name). /* one extra byte for terminating NULL */
    PUT-SHORT(ptr_PrinterAttrib,1) =16 + LENGTH(c_name).
    PUT-BYTE(ptr_PrinterAttrib,3)=2.          /* version 2 */
    PUT-SHORT(ptr_PrinterAttrib,4)=i_copies.
    PUT-SHORT(ptr_PrinterAttrib,6)=i_from.
    PUT-SHORT(ptr_PrinterAttrib,8)=i_to.
    PUT-BYTE(ptr_PrinterAttrib,10)=i_sort.
    PUT-BYTE(ptr_PrinterAttrib,11)=i_toFile.
    PUT-SHORT(ptr_PrinterAttrib,12)=l_PAFLAGS.
    PUT-SHORT(ptr_PrinterAttrib,14)=LENGTH(c_name).
    PUT-STRING(ptr_PrinterAttrib,16)=c_name.

    RUN VpSetPrinterAttrib (ptr_PrinterAttrib,i_duplex).

    IF p-err <> 0 THEN RETURN ERROR "SetPrinterAttrib: Error".
END.  

    
  


/**************************
 * Fetch Printer Attributes *
 **************************/
 
/* 28.05.98 */

PROCEDURE vpr_FetchPrinterAttrib:
    DEF INPUT PARAM p_attrib AS CHAR NO-UNDO.
    DEF OUTPUT PARAM p_value AS CHAR NO-UNDO.
  
    DEFINE VARIABLE lp-val AS INT NO-UNDO.
  
    RUN VpGetPrinterAttrib(CAPS(p_attrib), OUTPUT lp-val).
    p_value = TRIM(STRING(lp-val)).
  
END.




/*************************************
 * dialog and user interaction stuff *
 *************************************/

/* show printer setup dialog */
PROCEDURE vpr_PrinterSetup:
    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpPrinterSetup(OUTPUT p-err).
  
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "PrinterSetup: Error".
END.


/* show printer dialog */
PROCEDURE vpr_PrinterDialog:
    DEF OUTPUT PARAM lButton AS LOGICAL NO-UNDO.
    DEF VAR iButton AS INT NO-UNDO.

  
  
    RUN VpPrinterDialog(OUTPUT iButton).
  
    /* Error-Tracking. */
    IF iButton = -1 THEN RETURN ERROR "PrinterDialog: Error".
  
    lButton = IF iButton = 0 THEN FALSE ELSE TRUE.

END.




/* Define a wrapper for the printmode PrinterDialog. */
PROCEDURE vpr_SetPrinterDialogMode:
    DEF INPUT PARAM p-PrintDlg AS CHAR NO-UNDO.
    DEF VAR p-err AS INT NO-UNDO.

  
  

    RUN vpr_PrintOptions ("ENABLEPRINTERDIALOG", p-PrintDlg, "", "", ""/*, OUTPUT p-err*/).
END PROCEDURE. /* SetPrinterDialogMode */




/***************************
 * Document control stuff  *
 ***************************/

/*
 * SetDocTitle - set the title of a viper document
 * 04.10.2001 jc
 */

PROCEDURE vpr_SetDocTitle:
    DEF INPUT PARAM p-title AS CHAR NO-UNDO.
    
    DEF VAR p-err AS INT NO-UNDO.

    
    
    RUN VpSetDocTitle(p-title, OUTPUT p-err).
  
    IF p-err <> 0 THEN RETURN ERROR "SetDocTitle: Error".
END.



/* Reset whole document, reads actual printer setup. */
PROCEDURE vpr_ResetDoc:
    DEF VAR p-err AS INT NO-UNDO.

  

    RUN VpDeleteAll(OUTPUT p-err).

    IF p-err <> 0 THEN RETURN ERROR "ResetDoc: Error".
END.


/* EndDoc - Tell viper that the document is over...
   19.1.98 jpc
*/

PROCEDURE vpr_EndDoc:
    DEF VAR p-err AS INT NO-UNDO.

  
  
    RUN VpEndDoc(OUTPUT p-err).
  
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "EndDoc: Error".
END.


/* SaveDoc - save a document to a File
   29.04.98 jpc
*/

PROCEDURE vpr_SaveDoc:
    DEF INPUT PARAM p-sFileName AS CHAR NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.
  
  
  
    RUN VpSaveDoc(p-sFileName, OUTPUT p-err).
  
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "SaveDoc: Error".
END.
  

/* OpenDoc - loads a document to a File
   29.04.98 jpc
*/

PROCEDURE vpr_OpenDoc:
    DEF INPUT PARAM p-sFileName AS CHAR NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.

  

    RUN VpOpenDoc(p-sFileName, OUTPUT p-err).
  
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "OpenDoc: Error".
END.
  


/* ExportDoc - save a document to a File
   23.08.02 jc
*/

PROCEDURE vpr_ExportDoc:
    DEF INPUT PARAM p-from        AS INT  NO-UNDO.
    DEF INPUT PARAM p-to          AS INT  NO-UNDO.
    DEF INPUT PARAM p-fname       AS CHAR NO-UNDO.
    DEF INPUT PARAM p-type        AS CHAR NO-UNDO.

    DEF VAR p-err AS INT NO-UNDO.
  
  
  
    RUN VpExportDoc(p-from, p-to, p-fname, p-type, OUTPUT p-err).
  
    /* Error-Tracking. */
    IF p-err <> 0 THEN RETURN ERROR "ExportDoc: Error".
END.
  








/*********************************
 * MISC stuff i can't find a     *
 * better place for              *
 *********************************/

/* ViperDEBUG - some 'commands' to see some internal Viper stuff */
/* 27.04.98 jpc */
/* 'commands' so far known to ViperDEBUG - Params
        DISPLAY_PAGE_SIZE - No Params
*/
PROCEDURE vpr_ViperDEBUG:
    DEF INPUT PARAM p-commands    AS CHAR NO-UNDO.
    DEF INPUT PARAM p-paramList   AS CHAR NO-UNDO.
  
    DEF VAR p-err AS INT NO-UNDO.
  
    RUN VpDEBUG (CAPS(p-commands), CAPS(p-paramlist), OUTPUT p-err).
END PROCEDURE.



/*
    dump the document contents
    21.02.05 jc
*/
PROCEDURE vpr_DebugDumpDocument:
    DEF INPUT PARAM p-file AS CHAR NO-UNDO.

    DEFINE VARIABLE p-err AS INT NO-UNDO.

    RUN VpDebugDumpDocument(p-file, OUTPUT p-err).
END PROCEDURE.



/*********************************
 * helper functions of all kinds *
 *********************************/
 
PROCEDURE vpr_ShowDLLVersion:
    DEF VAR lp-ver AS INT NO-UNDO.
  
    RUN VpShowDLLVersion (OUTPUT lp-ver).
END.




/* Change an color string in the format "red,green,blue" to an int.
   Instead of comma seperated list the v6 colors are allowed. */
PROCEDURE vpr_CalcCol:

    DEF INPUT  PARAM p-ColChar AS CHAR NO-UNDO.
    DEF OUTPUT PARAM p-ColInt  AS INT  NO-UNDO.

    /* There are some predefined colors.
       These are the colors which are known until V6 from progress.
       (without light-yellow). */
    CASE p-ColChar:
        WHEN "Light-Gray"    THEN 
            p-ColChar = "225,225,225".
        WHEN "Gray"          THEN 
            p-ColChar = "128,128,128".
        WHEN "Dark-Gray"     THEN 
            p-ColChar = "100,100,100".
        WHEN "Black"         THEN 
            p-ColChar = "0,0,0".
        WHEN "White"         THEN 
            p-ColChar = "255,255,255".
        WHEN "Blue"          THEN 
            p-ColChar = "0,0,255".
        WHEN "Light-Blue"    THEN 
            p-ColChar = "128,128,255".
        WHEN "Green"         THEN 
            p-ColChar = "0,255,0".
        WHEN "Light-Green"   THEN 
            p-ColChar = "128,255,128".
        WHEN "Cyan"          THEN 
            p-ColChar = "0,255,255".
        WHEN "Light-Cyan"    THEN 
            p-ColChar = "128,255,255".
        WHEN "Red"           THEN 
            p-ColChar = "255,0,0".
        WHEN "Light-Red"     THEN 
            p-ColChar = "255,128,128".
        WHEN "Magenta"       THEN 
            p-ColChar = "255,0,255".
        WHEN "Light-Magenta" THEN 
            p-ColChar = "255,128,255".
        WHEN "Brown"         THEN 
            p-ColChar = "119,43,26".
        WHEN "Light-Brown"   THEN 
            p-ColChar = "165,91,50".
        WHEN "Yellow"        THEN 
            p-ColChar = "255,255,0".
        WHEN "Light-Yellow"  THEN 
            p-ColChar = "255,255,128".
        WHEN ""              THEN 
            p-ColChar = "0,0,0". /* Avoid Errors with empty fiels. */
        WHEN ?               THEN 
            p-ColChar = "0,0,0". /* Avoid Errors with empty fiels. */
    END CASE.  

    /* There must be three parts be defined. But we do !not! check for errors. */
    p-ColInt =            
        INT(TRIM(ENTRY(1, p-ColChar)))    /* red   */
        + ( 256   * INT(TRIM(ENTRY(2, p-ColChar))) )  /* green */
        + ( 65536 * INT(TRIM(ENTRY(3, p-ColChar))) ) NO-ERROR. /* Blue  */
    IF ERROR-STATUS:ERROR THEN 
    DO:
        p-ColInt =            
            INT(TRIM(ENTRY(1, p-ColChar, ":")))    /* red   */
            + ( 256   * INT(TRIM(ENTRY(2, p-ColChar, ":"))) )  /* green */
            + ( 65536 * INT(TRIM(ENTRY(3, p-ColChar, ":"))) ) NO-ERROR. /* Blue  */
        IF ERROR-STATUS:ERROR THEN 
        DO:
            MESSAGE "Viper: Error in color-string (~"" + p-ColChar + "~"). Setting to default color (~"0:0:0~")"
                VIEW-AS ALERT-BOX INFO BUTTONS OK.
            p-ColInt = 0.
        END.
    END.
END PROCEDURE. /* calccol */


/* Change an attribute string to an format number. */
PROCEDURE vpr_CalcFormat:

    DEF INPUT PARAM p-Attr AS CHAR NO-UNDO.
    DEF OUTPUT PARAM p-Form AS INT NO-UNDO.

    DEF VAR ii AS INT NO-UNDO.
  
    DO ii = 1 TO NUM-ENTRIES(p-Attr):
        p-Form =   p-Form 
            +      IF ENTRY(ii, p-Attr) = "italic"    THEN 1
            ELSE IF ENTRY(ii, p-Attr) = "underline" THEN 2
            ELSE IF ENTRY(ii, p-Attr) = "strikeout" THEN 4
            ELSE IF ENTRY(ii, p-Attr) = "bold"      THEN 8
            ELSE 0.
    END.
  
    IF p-Form >= 16 THEN p-Form = 15. /* Not to much */

END PROCEDURE. /* calcformat */



/* 
 External windooze procedures. 
*/

PROCEDURE LoadLibraryA EXTERNAL "kernel32.dll":
    DEF INPUT  PARAM  p-name  AS CHAR  NO-UNDO.
    DEF RETURN PARAM p-dll    AS LONG NO-UNDO.
END.

PROCEDURE FreeLibrary EXTERNAL "kernel32.dll":
    DEF INPUT PARAM p-dll AS LONG NO-UNDO.
END.



/*
 * from now on I simple add new procedure to the end of the file
 * the old sort order isn't helpful anymore, so with this order,
 * we can at least easily find the last additions to viper
 * 03.05.05 jc
 */
PROCEDURE vpr_SetDocAttrib:
    DEFINE INPUT PARAM  p-attriblist    AS CHAR     NO-UNDO.
    DEFINE VARIABLE lp-err AS INTEGER NO-UNDO.

    
  
    RUN VpSetDocAttrib(p-attriblist, OUTPUT lp-err).
    /* Error-Tracking. */
    IF lp-err <> 0 THEN RETURN ERROR "SetDocAttrib: Error".
END.



/* return the height needed to print all of the cells' text  */
PROCEDURE vpr_FetchCellTextHeight:
    DEF INPUT  PARAM   p-cell   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM   p-group  AS CHAR  NO-UNDO.
    DEF OUTPUT PARAM   p-height AS INT   NO-UNDO.

  
  
    RUN VpGetCellTextHeight(CAPS(p-cell), CAPS(p-group), OUTPUT p-height).

    IF p-height = -1 THEN RETURN ERROR "FetchCellTextHeight: Error".
END.

/* return the width necessary to print the cells' text  */
PROCEDURE vpr_FetchCellTextWidth:
    DEF INPUT  PARAM   p-cell   AS CHAR  NO-UNDO.
    DEF INPUT  PARAM   p-group  AS CHAR  NO-UNDO.
    DEF OUTPUT PARAM   p-height AS INT   NO-UNDO.

  
  
    RUN VpGetCellTextWidth(CAPS(p-cell), CAPS(p-group), OUTPUT p-height).

    IF p-height = -1 THEN RETURN ERROR "FetchCellTextHeight: Error".
END.


/* set a viperobj (graphical...)
 * 13.05.05 jc
 */
PROCEDURE vpr_SetGraphObj:
    DEF INPUT PARAM p-objnam    AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-group     AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-type      AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-x         AS INT   NO-UNDO.
    DEF INPUT PARAM p-y         AS INT   NO-UNDO.
    DEF INPUT PARAM p-w         AS INT   NO-UNDO.
    DEF INPUT PARAM p-h         AS INT   NO-UNDO.
    DEF INPUT PARAM p-attribs   AS CHAR  NO-UNDO.

    DEF VAR lp-err AS INT NO-UNDO.

  

    RUN VpSetGraphObj(CAPS(p-objnam),CAPS(p-group),CAPS(p-type),p-x,p-y,p-w,p-h,CAPS(p-attribs),OUTPUT lp-err).

    /* Error-Tracking. */
    IF lp-err <> 0 THEN RETURN ERROR "vpr_SetGraphObj: Error".
  
END PROCEDURE.


/* set group attributes
 * currently only one attribute (fixed=true/false) is supported
 *
 * 26.05.04 jc
 */
PROCEDURE vpr_SetGroupAttrib:
    DEF INPUT PARAM p-group   AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-attr    AS CHAR  NO-UNDO.

    DEF VAR lp-err AS INT NO-UNDO.

  

    RUN VpSetGroupAttr(CAPS(p-group), CAPS(p-attr), OUTPUT lp-err).

    /* Error-Tracking. */
    IF lp-err <> 0 THEN RETURN ERROR "vpr_SetGroupAttr: Error".
  
END PROCEDURE.

/*
 * wrapper to keep us from incompatibility with 3.2Beta
 * where this was named ...Attr instead of ..Attrib
 */
PROCEDURE vpr_SetGroupAttr:
    DEF INPUT PARAM p-group   AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-attr    AS CHAR  NO-UNDO.

    RUN vpr_SetGroupAttrib(p-group, p-attr).
END PROCEDURE.


/* set graphObj attributes
 *
 * 27.05.04 jc
 */
PROCEDURE vpr_SetGraphObjAttrib:
    DEF INPUT PARAM p-object  AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-group   AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-attr    AS CHAR  NO-UNDO.

    DEF VAR lp-err AS INT NO-UNDO.

  

    RUN VpSetGraphObjAttr(CAPS(p-object), CAPS(p-group), CAPS(p-attr), OUTPUT lp-err).

    /* Error-Tracking. */
    IF lp-err <> 0 THEN RETURN ERROR "vpr_SetGraphObjAttr: Error".
  
END PROCEDURE.

/*
 * wrapper to keep us from incompatibility with 3.2Beta
 * where this was named ...Attr instead of ..Attrib
 */
PROCEDURE vpr_SetGraphObjAttr:
    DEF INPUT PARAM p-object  AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-group   AS CHAR  NO-UNDO.
    DEF INPUT PARAM p-attr    AS CHAR  NO-UNDO.
  
    RUN vpr_SetGraphObjAttrib(p-object, p-group, p-attr).
END PROCEDURE.



/* get the leftmost position of the bounding rectangle around a group  */
PROCEDURE vpr_FetchGroupHPos:
    DEF INPUT  PARAM   p-group  AS CHAR  NO-UNDO.
    DEF OUTPUT PARAM   p-hpos   AS INT   NO-UNDO.

  

    RUN VpGetGroupHPos(CAPS(p-group), OUTPUT p-hpos).

    IF p-hpos = -1 THEN RETURN ERROR "FetchGroupHPos: Error".
END.


/* get the width of the bounding rectangle around a group  */
PROCEDURE vpr_FetchGroupWidth:
    DEF INPUT  PARAM   p-group  AS CHAR  NO-UNDO.
    DEF OUTPUT PARAM   p-width  AS INT   NO-UNDO.

  

    RUN VpGetGroupHPos(CAPS(p-group), OUTPUT p-width).

    IF p-width = -1 THEN RETURN ERROR "FetchGroupHPos: Error".
END.

/*
 * SetCellLineSpacing - Set the space between lines
 */
PROCEDURE vpr_SetCellRotation:
    DEF INPUT PARAM p-cell    AS CHAR NO-UNDO.
    DEF INPUT PARAM p-group   AS CHAR NO-UNDO.
    DEF INPUT PARAM p-angle   AS DEC  NO-UNDO.
  
    DEF VAR p-err AS INT NO-UNDO INIT 0.
    RUN VpSetCellRotation (CAPS(p-cell), CAPS(p-group), p-angle, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SetCellRotation: Error".
END.


PROCEDURE vpr_GetDefaultPrinter:
    DEF OUTPUT PARAM p-printer AS CHAR NO-UNDO.

    DEF VAR p-memory AS MEMPTR NO-UNDO.
    RUN _VpGetDefaultPrinter(OUTPUT p-memory).
    p-printer = GET-STRING(p-memory, 1).
END.


PROCEDURE vpr_SetDefaultPrinter:
    DEF INPUT PARAMETER p-name AS CHAR.
    DEF OUTPUT PARAMETER p-ret AS INTEGER.

    RUN _VpSetDefaultPrinter(p-name, OUTPUT p-ret).
END.

PROCEDURE vpr_SetTempDir:
    DEFINE INPUT  PARAMETER p-tmpdir AS CHARACTER NO-UNDO.
    
    DEFINE VARIABLE p-err AS INTEGER NO-UNDO.
    RUN VpSetTempDir(p-tmpdir, OUTPUT p-err).
    IF p-err <> 0 THEN RETURN ERROR "SetTempDir: Error".
END.

 

      

/* 
 * Configuration file included by viper.p.
 * Allows user to configure certain aspects of
 * viper
 */

        
                  
        
                  
        
                  
        
                  
        
                  
        
                  
        /*
        &IF DEFINED(Delimiter) > 0                  &THEN
          &UNDEFINE Delimiter
        &ENDIF  
        */