&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