&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2 &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DECLARATIONS Procedure USING System.Runtime.InteropServices._FieldBuilder FROM ASSEMBLY. &ANALYZE-RESUME /* Connected Databases */ &Scoped-define WINDOW-NAME CURRENT-WINDOW {adecomm/appserv.i} &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS fFrameWin /*------------------------------------------------------------------------ File: Description: from cntnrfrm.w - ADM2 SmartFrame Template Input Parameters: Output Parameters: ------------------------------------------------------------------------*/ /* This .W file was created with the Progress AppBuilder. */ /*----------------------------------------------------------------------*/ /* Create an unnamed pool to store all the widgets created by this procedure. This is a good default which assures that this procedure's triggers and internal procedures will execute in this procedure's storage, and that proper cleanup will occur on deletion of the procedure. */ CREATE WIDGET-POOL. /* *************************** Definitions ************************** */ /* Parameters Definitions --- */ /* Local Variable Definitions --- */ {src/adm2/widgetprto.i} DEFINE VARIABLE hQuery AS HANDLE NO-UNDO. DEFINE VARIABLE cFirma AS CHARACTER NO-UNDO. DEFINE VARIABLE cBenutzer AS CHARACTER NO-UNDO. DEFINE VARIABLE cProgramm AS CHARACTER NO-UNDO. DEFINE VARIABLE cTabelle AS CHARACTER NO-UNDO. 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. DEFINE TEMP-TABLE ttFelder NO-UNDO FIELD cFileName AS CHARACTER FIELD cName AS CHARACTER FIELD cType AS CHARACTER FIELD cFormat AS CHARACTER FIELD cView-As AS CHARACTER FIELD cView-Wert AS CHARACTER FIELD cView-Text AS CHARACTER . DEFINE TEMP-TABLE tviewer_ze LIKE viewer_ze. DEFINE VARIABLE htviewer AS HANDLE NO-UNDO. htviewer = TEMP-TABLE tviewer_ze:DEFAULT-BUFFER-HANDLE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK /* ******************** Preprocessor Definitions ******************** */ &Scoped-define PROCEDURE-TYPE SmartFrame &Scoped-define DB-AWARE no &Scoped-define ADM-CONTAINER FRAME &Scoped-define ADM-SUPPORTED-LINKS Data-Target,Data-Source,Page-Target,Update-Source,Update-Target /* Name of designated FRAME-NAME and/or first browse and/or first query */ &Scoped-define FRAME-NAME fMain &Scoped-define BROWSE-NAME Br_Felder /* Internal Tables (found by Frame, Query & Browse Queries) */ &Scoped-define INTERNAL-TABLES ttFelder /* Definitions for BROWSE Br_Felder */ &Scoped-define FIELDS-IN-QUERY-Br_Felder cName cType cFormat cView-as &Scoped-define ENABLED-FIELDS-IN-QUERY-Br_Felder &Scoped-define SELF-NAME Br_Felder &Scoped-define QUERY-STRING-Br_Felder FOR EACH ttFelder &Scoped-define OPEN-QUERY-Br_Felder OPEN QUERY hQuery FOR EACH ttFelder. &Scoped-define TABLES-IN-QUERY-Br_Felder ttFelder &Scoped-define FIRST-TABLE-IN-QUERY-Br_Felder ttFelder /* Definitions for FRAME fMain */ &Scoped-define OPEN-BROWSERS-IN-QUERY-fMain ~ ~{&OPEN-QUERY-Br_Felder} /* Standard List Definitions */ &Scoped-Define ENABLED-OBJECTS RECT-7 Br_Felder /* Custom List Definitions */ /* List-1,List-2,List-3,List-4,List-5,List-6 */ /* _UIB-PREPROCESSOR-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Prototypes ********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD createSelectionlist fFrameWin FUNCTION createSelectionlist RETURNS LOGICAL ( ipcView-as AS CHARACTER ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********************** Control Definitions ********************** */ /* Definitions of the field level widgets */ DEFINE RECTANGLE RECT-7 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 76 BY 13.33. /* Query definitions */ &ANALYZE-SUSPEND DEFINE QUERY Br_Felder FOR ttFelder SCROLLING. &ANALYZE-RESUME /* Browse definitions */ DEFINE BROWSE Br_Felder &ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS Br_Felder fFrameWin _FREEFORM QUERY Br_Felder DISPLAY cName FORMAT "x(20)" LABEL 'Name' cType FORMAT "x(12)" LABEL 'Typ' cFormat FORMAT "x(12)" LABEL 'FORMAT' cView-as FORMAT "x(20)" LABEL 'VIEW AS' /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME WITH NO-ROW-MARKERS SEPARATORS SIZE 74 BY 12.86. /* ************************ Frame Definitions *********************** */ DEFINE FRAME fMain Br_Felder AT ROW 1.48 COL 3 WIDGET-ID 200 RECT-7 AT ROW 1.24 COL 2 WIDGET-ID 2 WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY SIDE-LABELS NO-UNDERLINE THREE-D AT COL 1 ROW 1 SIZE 78 BY 13.81 WIDGET-ID 100. /* *********************** Procedure Settings ************************ */ &ANALYZE-SUSPEND _PROCEDURE-SETTINGS /* Settings for THIS-PROCEDURE Type: SmartFrame Allow: Basic,Browse,DB-Fields,Query,Smart Container Links: Data-Target,Data-Source,Page-Target,Update-Source,Update-Target Other Settings: PERSISTENT-ONLY APPSERVER */ /* This procedure should always be RUN PERSISTENT. Report the error, */ /* then cleanup and return. */ IF NOT THIS-PROCEDURE:PERSISTENT THEN DO: MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U VIEW-AS ALERT-BOX ERROR BUTTONS OK. RETURN. END. &ANALYZE-RESUME _END-PROCEDURE-SETTINGS /* ************************* Create Window ************************** */ &ANALYZE-SUSPEND _CREATE-WINDOW /* DESIGN Window definition (used by the UIB) CREATE WINDOW fFrameWin ASSIGN HEIGHT = 13.86 WIDTH = 78.4. /* END WINDOW DEFINITION */ */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB fFrameWin /* ************************* Included-Libraries *********************** */ {src/adm2/containr.i} /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********** Runtime Attributes and AppBuilder Settings *********** */ &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES /* SETTINGS FOR WINDOW fFrameWin VISIBLE,,RUN-PERSISTENT */ /* SETTINGS FOR FRAME fMain NOT-VISIBLE FRAME-NAME */ /* BROWSE-TAB Br_Felder RECT-7 fMain */ ASSIGN FRAME fMain:HIDDEN = TRUE. /* _RUN-TIME-ATTRIBUTES-END */ &ANALYZE-RESUME /* Setting information for Queries and Browse Widgets fields */ &ANALYZE-SUSPEND _QUERY-BLOCK BROWSE Br_Felder /* Query rebuild information for BROWSE Br_Felder _START_FREEFORM OPEN QUERY hQuery FOR EACH ttFelder _END_FREEFORM _Query is OPENED */ /* BROWSE Br_Felder */ &ANALYZE-RESUME &ANALYZE-SUSPEND _QUERY-BLOCK FRAME fMain /* Query rebuild information for FRAME fMain _Options = "" _Query is NOT OPENED */ /* FRAME fMain */ &ANALYZE-RESUME /* ************************ Control Triggers ************************ */ &Scoped-define BROWSE-NAME Br_Felder &Scoped-define SELF-NAME Br_Felder &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br_Felder fFrameWin ON LEFT-MOUSE-DBLCLICK OF Br_Felder IN FRAME fMain DO: Br_Felder:FETCH-SELECTED-ROW(1). RUN ADD_FIELD ( ttFelder.cName ). Br_Felder:DELETE-SELECTED-ROW(1). END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &UNDEFINE SELF-NAME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK fFrameWin /* *************************** Main Block *************************** */ SUBSCRIBE 'ANZEIGE_FELDER' ANYWHERE RUN-PROCEDURE 'CREATE_BROWSER'. cFirma = DYNAMIC-FUNCTION('getMandant':U) NO-ERROR. &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN /* Now enable the interface if in test mode - otherwise this happens when the object is explicitly initialized from its container. */ RUN initializeObject. &ENDIF /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ********************** Internal Procedures *********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ADD_FIELD fFrameWin PROCEDURE ADD_FIELD : /*------------------------------------------------------------------------------*/ /* Purpose: Super Override */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipcFeld AS CHARACTER NO-UNDO. DEFINE VARIABLE iPrior AS INTEGER NO-UNDO. DEFINE VARIABLE i1 AS INTEGER NO-UNDO. DEFINE VARIABLE cType AS CHARACTER NO-UNDO. DEFINE VARIABLE cRowid AS CHARACTER NO-UNDO. DEFINE BUFFER bttFelder FOR ttFelder. FIND FIRST bttFelder NO-LOCK WHERE bttFelder.cName = ipcFeld. FIND AnaDat._File NO-LOCK WHERE AnaDat._File._File-Name = cTabelle. FIND AnaDat._Field NO-LOCK OF AnaDat._File WHERE AnaDat._Field._Field-name = ipcFeld. EMPTY TEMP-TABLE tviewer_ze. CREATE tviewer_ze. ASSIGN tviewer_ze.mandant = cFirma tviewer_ze.benutzer = cBenutzer tviewer_ze.program = cProgramm tviewer_ze.tabelle = cTabelle tviewer_ze.feld = ipcFeld. RUN ADD_VIEWER_FIELD ( INPUT-OUTPUT htviewer ). REPEAT TRANSACTION ON ERROR UNDO, LEAVE: FIND FIRST tviewer_ze. CREATE viewer_ze. BUFFER-COPY tviewer_ze TO viewer_ze. cRowid = STRING(ROWID(viewer_ze)). RELEASE viewer_ze. LEAVE. END. PUBLISH 'OPENQUERY_viewer_ze' (INPUT cRowid). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects fFrameWin _ADM-CREATE-OBJECTS PROCEDURE adm-create-objects : /*------------------------------------------------------------------------------ Purpose: Create handles for all SmartObjects used in this procedure. After SmartObjects are initialized, then SmartLinks are added. Parameters: ------------------------------------------------------------------------------*/ END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE CREATE_BROWSER fFrameWin PROCEDURE CREATE_BROWSER : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipcBenutzer AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER ipcProgramm AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER ipcTabelle AS CHARACTER NO-UNDO. cBenutzer = ipcBenutzer. cProgramm = ipcProgramm. cTabelle = ipcTabelle . DEFINE VARIABLE httTabelle AS HANDLE NO-UNDO. DEFINE VARIABLE ii AS INTEGER NO-UNDO. DEFINE VARIABLE i1 AS INTEGER NO-UNDO. DEFINE VARIABLE cFeld AS CHARACTER NO-UNDO. DEFINE VARIABLE hFeld AS HANDLE NO-UNDO. DEFINE VARIABLE cView-as AS CHARACTER NO-UNDO. DEFINE BUFFER bviewer_ze FOR viewer_ze. FIND AnaDat._File NO-LOCK WHERE AnaDat._File._File-Name = cTabelle. EMPTY TEMP-TABLE ttFelder. CREATE BUFFER httTabelle FOR TABLE cTabelle. DO ii = 1 TO httTabelle:NUM-FIELDS: cFeld = httTabelle:BUFFER-FIELD(ii):NAME. FIND FIRST bviewer_ze NO-LOCK WHERE bviewer_ze.mandant = cFirma AND bviewer_ze.Benutzer = ipcBenutzer AND bviewer_ze.Program = ipcProgramm AND bviewer_ze.tabelle = ipctabelle AND bviewer_ze.feld = cFeld NO-ERROR. IF AVAILABLE bviewer_ze THEN NEXT. hFeld = httTabelle:BUFFER-FIELD(cFeld) NO-ERROR. FIND AnaDat._Field OF AnaDat._File WHERE AnaDat._Field._Field-name = cFeld. cView-As = AnaDat._Field._View-as. IF cView-as = ? THEN hFeld:VIEW-AS. IF INDEX(cView-as, 'COMBO-BOX') > 0 THEN DO: DYNAMIC-FUNCTION ('createSelectionList':U, cView-as). cView-as = 'COMBO-BOX'. END. CREATE ttFelder. ASSIGN ttFelder.cName = _Field._Field-Name ttFelder.cType = _Field._DATA-TYPE ttFelder.cFormat = _Field._Format ttFelder.cView-As = cView-as . CASE ttFelder.cView-As: WHEN 'COMBO-BOX' THEN DO: DO i1 = 1 TO EXTENT(cComboWert): ttFelder.cView-Wert = ttFelder.cView-Wert + (IF ttFelder.cView-Wert = '' THEN '' ELSE ';') + cComboWert[i1]. ttFelder.cView-Text = ttFelder.cView-Text + (IF ttFelder.cView-Text = '' THEN '' ELSE ';') + cComboText[i1]. END. END. END CASE. END. DELETE OBJECT httTabelle NO-ERROR. DO WITH FRAME {&FRAME-NAME}: hQuery:QUERY-OPEN(). END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI fFrameWin _DEFAULT-DISABLE PROCEDURE disable_UI : /*------------------------------------------------------------------------------ Purpose: DISABLE the User Interface Parameters: Notes: Here we clean-up the user-interface by deleting dynamic widgets we have created and/or hide frames. This procedure is usually called when we are ready to "clean-up" after running. ------------------------------------------------------------------------------*/ /* Hide all frames. */ HIDE FRAME fMain. IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enableObject fFrameWin PROCEDURE enableObject : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ DO WITH FRAME {&FRAME-NAME}: hQuery = Br_Felder:QUERY. hQuery:QUERY-PREPARE('FOR EACH ttFelder NO-LOCK'). END. RUN SUPER. /* Code placed here will execute AFTER standard behavior. */ END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI fFrameWin _DEFAULT-ENABLE PROCEDURE enable_UI : /*------------------------------------------------------------------------------ Purpose: ENABLE the User Interface Parameters: Notes: Here we display/view/enable the widgets in the user-interface. In addition, OPEN all queries associated with each FRAME and BROWSE. These statements here are based on the "Other Settings" section of the widget Property Sheets. ------------------------------------------------------------------------------*/ ENABLE RECT-7 Br_Felder WITH FRAME fMain. {&OPEN-BROWSERS-IN-QUERY-fMain} END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Implementations ***************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION createSelectionlist fFrameWin 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