GeMIS_WEB/GUI/administration/webfunction.p

&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
/* Procedure Description
"Structured Procedure File Template.

Use this template to create a new Structured Procedure file to compile and run PROGRESS 4GL code. You edit structured procedure files using the AB's Section Editor."
*/
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*------------------------------------------------------------------------
    File        : webfunction.p
    Purpose     : 

    Syntax      :

    Description : 

    Author(s)   : walter.riechsteiner
    Created     : Wed Aug 07 18:14:03 CEST 2024
    Notes       :
  ----------------------------------------------------------------------*/
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

DEFINE VARIABLE cView-as-Feld AS CHARACTER NO-UNDO.
DEFINE VARIABLE cView-inhalt AS CHARACTER NO-UNDO.
DEFINE VARIABLE cComboArt    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cComboWert   AS CHARACTER NO-UNDO EXTENT.
DEFINE VARIABLE cComboText   AS CHARACTER NO-UNDO EXTENT.

{ properties_formular_html.i }

DEFINE TEMP-TABLE tviewer_ze LIKE viewer_ze.


/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME

/* ************************  Function Prototypes ********************** */

&IF DEFINED(EXCLUDE-createSelectionList) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD createSelectionList Procedure
FUNCTION createSelectionList RETURNS LOGICAL 
    (ipcView-as AS CHARACTER) FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-getMaxLength) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getMaxLength Procedure
FUNCTION getMaxLength RETURNS INTEGER 
    (ipcFormat AS CHARACTER) FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure Template
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 15
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME
 



&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME



/* **********************  Internal Procedures  *********************** */

&IF DEFINED(EXCLUDE-ADD_VIEWER_FIELD) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ADD_VIEWER_FIELD Procedure
PROCEDURE ADD_VIEWER_FIELD:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:     Super Override                                                 */
    /*  Parameters:                                                                 */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE INPUT-OUTPUT PARAMETER iphviewer_ze AS HANDLE NO-UNDO.
    
    DEFINE VARIABLE htviewer_ze AS HANDLE    NO-UNDO.
    DEFINE VARIABLE iPrior      AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cView-As    AS CHARACTER NO-UNDO.
    DEFINE VARIABLE i1          AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cType       AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cFeldType   AS CHARACTER NO-UNDO.
    
    htviewer_ze = TEMP-TABLE tviewer_ze:DEFAULT-BUFFER-HANDLE.
    EMPTY TEMP-TABLE tviewer_ze.
    htviewer_ze:BUFFER-COPY(iphviewer_ze).
    
    FIND FIRST tviewer_ze.
    
    FOR EACH viewer_ze NO-LOCK
        WHERE viewer_ze.mandant  = tviewer_ze.mandant
        AND   viewer_ze.benutzer = tviewer_ze.Benutzer
        AND   viewer_ze.program  = tviewer_ze.Program
        AND   viewer_ze.tabelle  = tviewer_ze.tabelle
        
        BY viewer_ze.prior DESCENDING:
        
        iPrior = viewer_ze.prior + 10.
        LEAVE.
    END.
    
    FIND AnaDat._File NO-LOCK 
        WHERE AnaDat._File._File-Name = tviewer_ze.tabelle.
    FIND AnaDat._Field OF AnaDat._File
        WHERE AnaDat._Field._Field-name = tviewer_ze.Feld.
        
    FIND AnaDat._Index WHERE RECID(AnaDat._Index) = AnaDat._File._Prime-Index.
    FIND FIRST AnaDat._Index-Field OF anaDat._Index
        WHERE AnaDat._Index-Field._Field-Recid = RECID(AnaDat._Field) NO-ERROR.
        
    ASSIGN
        tviewer_ze.feldtype   = AnaDat._Field._Data-type
        tviewer_ze.feldformat = AnaDat._Field._Format
        tviewer_ze.prior      = iPrior
        tviewer_ze.lReadonly  = (IF AVAILABLE _Index-Field THEN TRUE ELSE FALSE).
        
    cView-As = AnaDat._Field._View-As.

    IF cView-as = ? THEN 'FILL_IN'.
    
    cFeldType = tviewer_ze.feldtype.
    IF INDEX(cView-as, 'COMBO-BOX') > 0 THEN 
    DO:
        DYNAMIC-FUNCTION ('createSelectionList':U, cView-as).
        cView-as = 'COMBO-BOX'.
        DO i1 = 1 TO EXTENT(cComboText):
            tviewer_ze.selecttexte = tviewer_ze.selecttexte
                + (IF tviewer_ze.selecttexte = '' THEN '' ELSE ';')
                + TRIM(cComboText[i1]).
            tviewer_ze.selectwerte = tviewer_ze.selectwerte
                + (IF tviewer_ze.selectwerte = '' THEN '' ELSE ';')
                + TRIM(cComboWert[i1]).
        END.
        ASSIGN 
            tviewer_ze.textalign = 'left'
            cFeldType            = 'SELECTION'.
    END.
    
    IF INDEX(cView-as, 'TOGGLE-BOX') > 0 THEN 
    DO:
        DYNAMIC-FUNCTION ('createCheckBox':U, cView-as).
        cView-as  = 'checkbox'.
        cFeldType = 'checkbox'.
    END.
 
    CASE cFeldType:
        WHEN 'INTEGER' THEN 
            tviewer_ze.textalign = 'right'.
        WHEN 'INT64' THEN 
            tviewer_ze.textalign = 'right'.
        WHEN 'DECIMAL' THEN
            ASSIGN  
                tviewer_ze.textalign   = 'right'
                tviewer_ze.numdecimals = _Field._Decimals. 
        WHEN 'DATE' THEN 
            tviewer_ze.textalign = 'center'.
        OTHERWISE  
        tviewer_ze.textalign = 'left'.
    END CASE.
        
    tviewer_ze.attributes = tviewer_ze.attributes
        + (IF tviewer_ze.attributes = '' THEN '' ELSE ' ')
        + SUBSTITUTE('id=&1 name=&1', QUOTER(tviewer_ze.feld)).
        
    CASE cFeldType:
        WHEN 'INTEGER' THEN 
            DO:
                cType = (IF tviewer_ze.lHidden THEN 'hidden' ELSE 'text').
                tviewer_ze.attributes = tviewer_ze.attributes
                    + (IF tviewer_ze.attributes = '' THEN '' ELSE ' ')
                    + SUBSTITUTE('type="&1" step="0"', cType).
                tviewer_ze.styles = tviewer_ze.styles
                    + (IF tviewer_ze.styles = '' THEN '' ELSE '; ')
                    + 'width: 50%'.
            END.
        WHEN 'INT64' THEN 
            DO: 
                cType = (IF tviewer_ze.lHidden THEN 'hidden' ELSE 'text').
                tviewer_ze.attributes = tviewer_ze.attributes
                    + (IF tviewer_ze.attributes = '' THEN '' ELSE ' ')
                    + SUBSTITUTE('type="&1" step="0"', cType).
                tviewer_ze.styles = tviewer_ze.styles
                    + (IF tviewer_ze.styles = '' THEN '' ELSE '; ')
                    + 'width: 50%'.
            END.
        WHEN 'DECIMAL' THEN 
            DO:
                cType = (IF tviewer_ze.lHidden THEN 'hidden' ELSE 'text').
                ASSIGN  
                    tviewer_ze.attributes = tviewer_ze.attributes
                        + (IF tviewer_ze.attributes = '' THEN '' ELSE ' ')
                        + SUBSTITUTE('type="&1" step="&2"', cType, '0.' + FILL('0', tviewer_ze.numdecimals)).
                tviewer_ze.styles = tviewer_ze.styles
                    + (IF tviewer_ze.styles = '' THEN '' ELSE '; ')
                    + 'width: 50%'.
            END.
        WHEN 'CHARACTER' THEN 
            DO:
                cType = (IF tviewer_ze.lHidden THEN 'hidden' ELSE 'text').
                i1 = DYNAMIC-FUNCTION ('getMaxLength':U, tviewer_ze.feldformat).
                ASSIGN  
                    tviewer_ze.attributes = tviewer_ze.attributes
                        + (IF tviewer_ze.attributes = '' THEN '' ELSE ' ')
                        + SUBSTITUTE('type="&1" maxlength="&2"', cType, i1)
                    tviewer_ze.styles     = tviewer_ze.styles
                        + (IF tviewer_ze.styles = '' THEN '' ELSE '; ')
                        + 'width: 90%'.
            END.
        WHEN 'DATE' THEN 
            tviewer_ze.textalign = 'center'.
        WHEN 'SELECTION' THEN 
            DO:
                cType = (IF tviewer_ze.lHidden THEN 'hidden' ELSE 'text').
                ASSIGN  
                    tviewer_ze.attributes = tviewer_ze.attributes
                        + (IF tviewer_ze.attributes = '' THEN '' ELSE ' ')
                        + SUBSTITUTE('type="&1"', cType)
                    tviewer_ze.styles     = tviewer_ze.styles
                        + (IF tviewer_ze.styles = '' THEN '' ELSE '; ')
                        + 'width: 90%'
                        + '; height: 25px'.
            END.
        OTHERWISE 
        DO:  
            ASSIGN  
                cType                 = (IF tviewer_ze.lHidden THEN 'hidden' ELSE 'text')
                tviewer_ze.attributes = tviewer_ze.attributes
                    + (IF tviewer_ze.attributes = '' THEN '' ELSE ' ')
                    + SUBSTITUTE('type="&1"', cType)
                tviewer_ze.styles     = tviewer_ze.styles
                    + (IF tviewer_ze.styles = '' THEN '' ELSE '; ')
                    + 'width: 90%'.
        END.
    END CASE.
        
    IF  tviewer_ze.lReadonly THEN 
        tviewer_ze.attributes = tviewer_ze.attributes
            + (IF tviewer_ze.attributes = '' THEN '' ELSE ' ')
            + 'readonly="true"'.
        
    iphviewer_ze:BUFFER-COPY(htviewer_ze).           
    LEAVE.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF



/* ************************  Function Implementations ***************** */

&IF DEFINED(EXCLUDE-createSelectionList) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION createSelectionList Procedure
FUNCTION createSelectionList RETURNS LOGICAL 
    ( ipcView-as AS CHARACTER ):
    /*------------------------------------------------------------------------------
     Purpose:
     Notes:
    ------------------------------------------------------------------------------*/

    DEFINE VARIABLE cViewas   AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cItemList AS CHARACTER NO-UNDO.
    DEFINE VARIABLE lPairs    AS LOGICAL   NO-UNDO INIT FALSE.
    DEFINE VARIABLE ii        AS INTEGER   NO-UNDO.
    DEFINE VARIABLE i1        AS INTEGER   NO-UNDO.
    DEFINE VARIABLE i2        AS INTEGER   NO-UNDO.

    cViewas = TRIM(REPLACE(ipcView-as, 'VIEW-AS'  , '')).
    cViewas = TRIM(REPLACE(cViewas   , 'COMBO-BOX', '')).
    
    ii = INDEX(cViewas, 'SIZE').
    IF ii > 0 THEN cViewas = TRIM(SUBSTRING(cViewas,01,ii - 1)).
    
    IF INDEX(cViewas, 'LIST-ITEM-PAIRS') > 0 THEN 
    DO:
        lPairs    = TRUE.
        cItemList = TRIM(REPLACE(cviewas, 'LIST-ITEM-PAIRS', '')).
    END.
    ELSE 
    DO:
        lPairs    = FALSE.
        cItemList = TRIM(REPLACE(cviewas, 'LIST-ITEMS'     , '')).
    END.
    DO WHILE SUBSTRING(cItemList, 01, 01) < CHR(32):
        cItemList = SUBSTRING(cItemList,02).
    END.
    DO WHILE TRUE:
        ii = LENGTH(cItemList).
        IF SUBSTRING(cItemList,ii) > CHR(32) THEN LEAVE.
        cItemList = SUBSTRING(cItemList,ii - 1).
    END. 
    
    cItemList = REPLACE(cItemList, ','    , ';').
    cItemList = REPLACE(cItemList, CHR(10), ';').
    i1 = NUM-ENTRIES(cItemList, ';').
    
    EXTENT(cComboText) = ?.
    EXTENT(cComboWert) = ?.
    
    i2 = 0.
    IF lPairs THEN 
    DO:
        ii = i1 / 2.
        EXTENT(cComboWert) = ii.
        EXTENT(cComboText) = ii.
        DO ii = 1 TO i1 BY 2:
            i2 = i2 + 1.
            cComboText[i2] = REPLACE(REPLACE(ENTRY(ii    , cItemList, ';'), '"', ''), "'", '').
            cComboWert[i2] = REPLACE(REPLACE(ENTRY(ii + 1, cItemList, ';'), '"', ''), "'", '').
        END.
    END.
    ELSE 
    DO:
        EXTENT(cComboWert) = i1.
        EXTENT(cComboText) = i1.
        DO ii = 1 TO i1 BY 1:
            i2 = i2 + 1.
            cComboText[i2] = REPLACE(REPLACE(ENTRY(ii, cItemList, ';'), '"', ''), "'", '').
            cComboWert[i2] = REPLACE(REPLACE(ENTRY(ii, cItemList, ';'), '"', ''), "'", '').
        END.
    END.
    
    RETURN TRUE.

END FUNCTION.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF



&IF DEFINED(EXCLUDE-getMaxLength) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getMaxLength Procedure
FUNCTION getMaxLength RETURNS INTEGER 
    ( ipcFormat AS CHARACTER ):
    /*------------------------------------------------------------------------------
     Purpose:
     Notes:
    ------------------------------------------------------------------------------*/

    DEFINE VARIABLE x1      AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cFormat AS CHARACTER NO-UNDO.
    
    x1 = INDEX(ipcFormat, '(').
    IF x1 = 0 THEN RETURN LENGTH(ipcFormat).
    
    cFormat = REPLACE(ipcFormat, '(', ';').
    cFormat = REPLACE(cFormat  , ')', ';').
    x1 = INTEGER(ENTRY(2, cFormat, ';')).

    RETURN x1.

END FUNCTION.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF