&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2 &ANALYZE-RESUME /* Connected Databases anadat PROGRESS */ &Scoped-define WINDOW-NAME CURRENT-WINDOW /* Temp-Table and Buffer definitions */ DEFINE TEMP-TABLE RowObject {"d-tabel.i"}. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS vTableWin /*------------------------------------------------------------------------ File: Description: from viewer.w - Template for SmartDataViewer objects 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 ************************** */ /* Komma-Trennzeichen */ /* Keyfelder werden beim Mutieren nicht "Enabled" */ &Scoped-define KEY_FELDER CodeI,CodeC &Scoped-define NUR_LESEN /* Parameters Definitions --- */ /* Local Variable Definitions --- */ DEF VAR SAktiv AS LOG NO-UNDO INIT FALSE. DEF VAR FNeu AS LOG NO-UNDO INIT FALSE. DEF VAR FMut AS LOG NO-UNDO INIT FALSE. DEF VAR FCopy AS LOG NO-UNDO INIT FALSE. DEF VAR FCancel AS LOG NO-UNDO INIT FALSE. DEF VAR Fenster AS HANDLE NO-UNDO. DEF VAR oldColValues AS CHAR NO-UNDO. DEF VAR oldColList AS CHAR NO-UNDO. DEF VAR Firma AS CHAR NO-UNDO. DEF VAR Sprcd AS INT NO-UNDO. DEF VAR RecArt AS CHAR NO-UNDO. DEF VAR LetztFeld AS CHAR NO-UNDO. DEF VAR ErstFeld AS CHAR NO-UNDO. DEF VAR fCodeI AS LOG INIT FALSE NO-UNDO. DEF TEMP-TABLE THandle FIELD TNr AS INT FIELD TFeld AS HANDLE FIELD TType AS CHAR FIELD TLabel AS CHAR FIELD TLength AS DEC FIELD TFormat AS CHAR FIELD TY AS DEC FIELD TX AS DEC FIELD TFx AS DEC. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK /* ******************** Preprocessor Definitions ******************** */ &Scoped-define PROCEDURE-TYPE SmartDataViewer &Scoped-define DB-AWARE no &Scoped-define ADM-CONTAINER FRAME &Scoped-define ADM-SUPPORTED-LINKS Data-Target,Update-Source,TableIO-Target,GroupAssign-Source,GroupAssign-Target /* Include file with RowObject temp-table definition */ &Scoped-define DATA-FIELD-DEFS "d-tabel.i" /* Name of designated FRAME-NAME and/or first browse and/or first query */ &Scoped-define FRAME-NAME F-Main /* Standard List Definitions */ &Scoped-Define ENABLED-FIELDS RowObject.CodeC RowObject.CodeI ~ RowObject.Bez1 RowObject.Bez2 RowObject.Firma RowObject.RecArt ~ RowObject.Sprcd RowObject.BezL RowObject.Int_1 RowObject.Int_2 ~ RowObject.Int_3 RowObject.Dec_1 RowObject.Dec_2 RowObject.Dec_3 &Scoped-define ENABLED-TABLES RowObject &Scoped-define FIRST-ENABLED-TABLE RowObject &Scoped-Define ENABLED-OBJECTS RECT-Viewer &Scoped-Define DISPLAYED-FIELDS RowObject.CodeC RowObject.CodeI ~ RowObject.Bez1 RowObject.Bez2 RowObject.Firma RowObject.RecArt ~ RowObject.Sprcd RowObject.BezL RowObject.Int_1 RowObject.Int_2 ~ RowObject.Int_3 RowObject.Dec_1 RowObject.Dec_2 RowObject.Dec_3 &Scoped-define DISPLAYED-TABLES RowObject &Scoped-define FIRST-DISPLAYED-TABLE RowObject /* Custom List Definitions */ /* ADM-ASSIGN-FIELDS,List-2,List-3,List-4,List-5,List-6 */ /* _UIB-PREPROCESSOR-BLOCK-END */ &ANALYZE-RESUME /* *********************** Control Definitions ********************** */ /* Definitions of the field level widgets */ DEFINE RECTANGLE RECT-Viewer EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 110 BY 5.76. /* ************************ Frame Definitions *********************** */ DEFINE FRAME F-Main RowObject.CodeC AT ROW 1.52 COL 18 COLON-ALIGNED LABEL "CodeC" FORMAT "x(08)" VIEW-AS FILL-IN NATIVE SIZE 20 BY 1 BGCOLOR 15 RowObject.CodeI AT ROW 1.52 COL 73 COLON-ALIGNED VIEW-AS FILL-IN NATIVE SIZE 10.4 BY 1 BGCOLOR 15 RowObject.Bez1 AT ROW 2.52 COL 18 COLON-ALIGNED VIEW-AS FILL-IN NATIVE SIZE 32 BY 1 BGCOLOR 15 RowObject.Bez2 AT ROW 2.52 COL 73 COLON-ALIGNED VIEW-AS FILL-IN NATIVE SIZE 32 BY 1 BGCOLOR 15 RowObject.Firma AT ROW 2.81 COL 68.6 COLON-ALIGNED VIEW-AS FILL-IN SIZE 13.6 BY 1 NO-TAB-STOP RowObject.RecArt AT ROW 2.81 COL 72.6 COLON-ALIGNED LABEL "Recart" FORMAT "x(20)" VIEW-AS FILL-IN SIZE 9.6 BY 1 NO-TAB-STOP RowObject.Sprcd AT ROW 2.91 COL 77 COLON-ALIGNED VIEW-AS FILL-IN SIZE 4.8 BY 1 NO-TAB-STOP RowObject.BezL AT ROW 3.52 COL 18 COLON-ALIGNED VIEW-AS FILL-IN NATIVE SIZE 82 BY 1 BGCOLOR 15 RowObject.Int_1 AT ROW 4.52 COL 18 COLON-ALIGNED LABEL "Int_1" FORMAT "zzz,zz9-" VIEW-AS FILL-IN NATIVE SIZE 13 BY 1 BGCOLOR 15 RowObject.Int_2 AT ROW 4.52 COL 48 COLON-ALIGNED LABEL "Int_2" FORMAT "zzz,zz9-" VIEW-AS FILL-IN NATIVE SIZE 13 BY 1 BGCOLOR 15 RowObject.Int_3 AT ROW 4.52 COL 78 COLON-ALIGNED LABEL "Int_3" FORMAT "zzz,zz9-" VIEW-AS FILL-IN NATIVE SIZE 13 BY 1 BGCOLOR 15 RowObject.Dec_1 AT ROW 5.52 COL 18 COLON-ALIGNED LABEL "Dec_1" FORMAT "zzz,zz9.99-" VIEW-AS FILL-IN NATIVE SIZE 17 BY 1 BGCOLOR 15 RowObject.Dec_2 AT ROW 5.52 COL 48 COLON-ALIGNED LABEL "Dec_2" FORMAT "zzz,zz9.99-" VIEW-AS FILL-IN NATIVE SIZE 17 BY 1 BGCOLOR 15 RowObject.Dec_3 AT ROW 5.52 COL 78 COLON-ALIGNED LABEL "Dec_3" FORMAT "zzz,zz9.99-" VIEW-AS FILL-IN NATIVE SIZE 17 BY 1 BGCOLOR 15 RECT-Viewer AT ROW 1.24 COL 2 WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY USE-DICT-EXPS SIDE-LABELS NO-UNDERLINE THREE-D NO-AUTO-VALIDATE AT COL 1 ROW 1 SCROLLABLE . /* *********************** Procedure Settings ************************ */ &ANALYZE-SUSPEND _PROCEDURE-SETTINGS /* Settings for THIS-PROCEDURE Type: SmartDataViewer Data Source: "d-tabel.w" Allow: Basic,DB-Fields,Smart Container Links: Data-Target,Update-Source,TableIO-Target,GroupAssign-Source,GroupAssign-Target Frames: 1 Add Fields to: Neither Other Settings: PERSISTENT-ONLY COMPILE Temp-Tables and Buffers: TABLE: RowObject D "?" ? ADDITIONAL-FIELDS: {d-tabel.i} END-FIELDS. END-TABLES. */ /* 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 vTableWin ASSIGN HEIGHT = 7.05 WIDTH = 114.6. /* END WINDOW DEFINITION */ */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB vTableWin /* ************************* Included-Libraries *********************** */ {src/adm2/viewer.i} /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********** Runtime Attributes and AppBuilder Settings *********** */ &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES /* SETTINGS FOR WINDOW vTableWin VISIBLE,,RUN-PERSISTENT */ /* SETTINGS FOR FRAME F-Main NOT-VISIBLE FRAME-NAME Size-to-Fit */ ASSIGN FRAME F-Main:SCROLLABLE = FALSE FRAME F-Main:HIDDEN = TRUE. /* SETTINGS FOR FILL-IN RowObject.CodeC IN FRAME F-Main EXP-LABEL EXP-FORMAT */ /* SETTINGS FOR FILL-IN RowObject.Dec_1 IN FRAME F-Main EXP-LABEL EXP-FORMAT */ /* SETTINGS FOR FILL-IN RowObject.Dec_2 IN FRAME F-Main EXP-LABEL EXP-FORMAT */ /* SETTINGS FOR FILL-IN RowObject.Dec_3 IN FRAME F-Main EXP-LABEL EXP-FORMAT */ /* SETTINGS FOR FILL-IN RowObject.Int_1 IN FRAME F-Main EXP-LABEL EXP-FORMAT */ /* SETTINGS FOR FILL-IN RowObject.Int_2 IN FRAME F-Main EXP-LABEL EXP-FORMAT */ /* SETTINGS FOR FILL-IN RowObject.Int_3 IN FRAME F-Main EXP-LABEL EXP-FORMAT */ /* SETTINGS FOR FILL-IN RowObject.RecArt IN FRAME F-Main EXP-LABEL EXP-FORMAT */ /* _RUN-TIME-ATTRIBUTES-END */ &ANALYZE-RESUME /* Setting information for Queries and Browse Widgets fields */ &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main /* Query rebuild information for FRAME F-Main _Options = "NO-LOCK" _Query is NOT OPENED */ /* FRAME F-Main */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK vTableWin /* *************************** Main Block *************************** */ SAktiv = DYNAMIC-FUNCTION('getSuperAktiv':U) NO-ERROR. IF SAktiv THEN DO: Firma = DYNAMIC-FUNCTION('GETMANDANT':U) NO-ERROR. RecArt = DYNAMIC-FUNCTION('GETTABELLE':U) NO-ERROR. END. SUBSCRIBE TO 'SETRECTBREITE' ANYWHERE. /* Triggers ------------------------------------------------------ */ ON 'RETURN':U OF FRAME {&FRAME-NAME} ANYWHERE DO: RUN RETURN_FELD ( INPUT SELF:HANDLE ). IF RETURN-VALUE = 'TAB' THEN DO: APPLY 'TAB' TO SELF. RETURN NO-APPLY. END. END. ON 'ENTRY':U OF FRAME {&FRAME-NAME} ANYWHERE DO: RUN ENTRY_FELD_TEST ( INPUT SELF:HANDLE ). IF RETURN-VALUE = 'ERROR' THEN DO: APPLY 'ENTRY' TO SELF. RETURN NO-APPLY. END. IF RETURN-VALUE = 'APPLY' THEN DO: RETURN NO-APPLY. END. END. ON 'LEAVE':U OF FRAME {&FRAME-NAME} ANYWHERE DO: RUN LEAVE_FELD_TEST ( INPUT SELF:HANDLE ). IF RETURN-VALUE = 'ERROR' THEN DO: APPLY 'ENTRY' TO SELF. RETURN NO-APPLY. END. IF RETURN-VALUE = 'APPLY' THEN DO: RETURN NO-APPLY. END. END. &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN RUN initializeObject. &ENDIF /************************ INTERNAL PROCEDURES ********************/ /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ********************** Internal Procedures *********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE addRecord vTableWin PROCEDURE addRecord : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ FNeu = TRUE. FMut = TRUE. RUN SUPER. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE cancelRecord vTableWin PROCEDURE cancelRecord : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ /* Code placed here will execute PRIOR to standard behavior. */ FCancel = TRUE. RUN SUPER. /* Code placed here will execute AFTER standard behavior. */ END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE copyRecord vTableWin PROCEDURE copyRecord : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ FNeu = TRUE. FMut = TRUE. FCopy = TRUE. RUN SUPER. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE deleteRecord vTableWin PROCEDURE deleteRecord : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ DEF VAR Ja AS LOG NO-UNDO. Ja = DYNAMIC-FUNCTION( 'ANTWORT_JA':U, INPUT 1000 ). IF NOT Ja THEN DO: PUBLISH 'TOOLBAR' ( INPUT 'CANCEL':U ). RETURN NO-APPLY. 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 disableFields vTableWin PROCEDURE disableFields : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER pcFieldType AS CHARACTER NO-UNDO. DO WITH FRAME {&FRAME-NAME}: END. RUN SUPER( INPUT pcFieldType). IF NOT VALID-HANDLE(Fenster) THEN Fenster = FRAME {&FRAME-NAME}:CURRENT-ITERATION. RUN READONLY_FELDER ( INPUT Fenster, INPUT '{&ENABLED-FIELDS}', INPUT TRUE ). IF NUM-ENTRIES('{&KEY_FELDER}', ',') > 0 THEN DO: RUN FARBE_FELDER ( INPUT Fenster, INPUT '{&KEY_FELDER}', INPUT 15 ). END. DO WITH FRAME {&FRAME-NAME}: END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI vTableWin _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 F-Main. IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE displayFields vTableWin PROCEDURE displayFields : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER pcColValues AS CHARACTER NO-UNDO. IF FCancel THEN pcColValues = OldColValues. IF NOT FNeu THEN OldColValues = pcColValues. OldColList = DYNAMIC-FUNCTION('getDisplayedFields':U). IF FNeu THEN RUN FEHLWERTE ( INPUT-OUTPUT pcColValues ). DO WITH FRAME {&FRAME-NAME}: END. RUN SUPER( INPUT pcColValues). FCancel = FALSE. DO WITH FRAME {&FRAME-NAME}: END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enableFields vTableWin PROCEDURE enableFields : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ IF NOT VALID-HANDLE(Fenster) THEN Fenster = FRAME {&FRAME-NAME}:CURRENT-ITERATION. RUN READONLY_FELDER ( INPUT Fenster, INPUT '{&ENABLED-FIELDS}', INPUT FALSE ). IF NUM-ENTRIES('{&NUR_LESEN}', ',') > 0 THEN DO: RUN READONLY_FELDER ( INPUT Fenster, INPUT '{&NUR_LESEN}', INPUT TRUE ). END. DO WITH FRAME {&FRAME-NAME}: END. IF FNeu THEN RETURN. IF NUM-ENTRIES('{&KEY_FELDER}', ',') > 0 THEN DO: RUN SCHUETZE_FELDER ( INPUT Fenster, INPUT '{&KEY_FELDER}', INPUT TRUE ). END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enableObject vTableWin PROCEDURE enableObject : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ RUN SUPER. IF NOT VALID-HANDLE(Fenster) THEN Fenster = FRAME {&FRAME-NAME}:CURRENT-ITERATION. IF SAktiv THEN DO: RUN READONLY_FELDER ( INPUT Fenster, INPUT '{&ENABLED-FIELDS}', INPUT TRUE ). END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ENTRY_FELD_TEST vTableWin PROCEDURE ENTRY_FELD_TEST : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipHandle AS HANDLE NO-UNDO. DEF VAR FeldName AS CHAR NO-UNDO. DEF VAR FeldInhalt AS CHAR NO-UNDO. FeldName = ''. FeldInhalt = ''. IF NOT VALID-HANDLE(ipHandle) THEN RETURN ''. IF ipHandle:TYPE = 'FRAME' THEN RETURN ''. IF ipHandle:TYPE = 'WINDOW' THEN RETURN ''. IF ipHandle:TYPE = 'LITERAL' THEN RETURN ''. FeldName = ipHandle:NAME. IF ipHandle:TYPE = 'FILL-IN' OR ipHandle:TYPE = 'COMBO-BOX' OR ipHandle:TYPE = 'TOGGLE-BOX' THEN FeldInhalt = ipHandle:SCREEN-VALUE. RETURN ''. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FEHLWERTE vTableWin PROCEDURE FEHLWERTE : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT-OUTPUT PARAMETER pcColValues AS CHAR NO-UNDO. DEF VAR FwFelder AS CHAR NO-UNDO. DEF VAR FwFeld AS CHAR NO-UNDO. DEF VAR FwValue AS CHAR NO-UNDO. DEF VAR ix AS INT NO-UNDO. DEF VAR i1 AS INT NO-UNDO. IF FCancel THEN RETURN. GET-KEY-VALUE SECTION 'Fw???????' KEY ? VALUE FwFelder. IF NOT FCopy THEN DO: DO ix = 1 TO NUM-ENTRIES(FwFelder, ','): FwFeld = ENTRY (ix , FwFelder , ','). i1 = LOOKUP(FwFeld, oldColList, ',') + 1. IF i1 < 2 THEN NEXT. GET-KEY-VALUE SECTION 'Fw???????' KEY FwFeld VALUE FwValue. ENTRY(i1, pcColValues, CHR(1)) = FwValue NO-ERROR. END. DO WHILE fCodeI: DO ix = 1 TO 999: IF NOT CAN-FIND ( FIRST Tabel WHERE Tabel.Firma = Firma AND Tabel.RecArt = RecArt AND Tabel.CodeI = ix AND Tabel.CodeC = '' NO-LOCK) THEN LEAVE. END. i1 = LOOKUP('CodeI', oldColList, ',') + 1. ENTRY(i1, pcColValues, CHR(1)) = STRING(ix) NO-ERROR. LEAVE. END. END. IF FCopy THEN DO: END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FORMAT_VIEWER vTableWin PROCEDURE FORMAT_VIEWER : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipParam AS CHAR NO-UNDO. DEF INPUT PARAMETER ipFirma AS CHAR NO-UNDO. DEF INPUT PARAMETER ipSprcd AS INT NO-UNDO. DEF VAR i1 AS INT NO-UNDO. DEF VAR ib AS INT NO-UNDO. DEF VAR ie AS INT NO-UNDO. DEF VAR cFelder AS CHAR NO-UNDO. DEF VAR xFeld AS CHAR NO-UNDO. DEF VAR xLabel AS CHAR NO-UNDO. DEF VAR xFormat AS CHAR NO-UNDO. DEF VAR dLength AS DEC NO-UNDO. DEF VAR sFeld AS CHAR NO-UNDO. DEF VAR sLabel AS CHAR NO-UNDO. DEF VAR sFormat AS CHAR NO-UNDO. DEF VAR sLength AS CHAR NO-UNDO. DEF VAR hTabOrder AS HANDLE NO-UNDO. DEF VAR hFelder AS HANDLE NO-UNDO. DEF VAR xBeg AS DEC NO-UNDO INIT 20. DEF VAR xPos AS DEC NO-UNDO INIT 20. DEF VAR yPos AS DEC NO-UNDO INIT 1.50. DEF VAR yCode AS DEC NO-UNDO INIT 0. DEF VAR yBezk AS DEC NO-UNDO INIT 0. DEF VAR yBezL AS DEC NO-UNDO INIT 0. DEF VAR yInt AS DEC NO-UNDO INIT 0. DEF VAR yDec AS DEC NO-UNDO INIT 0. DEF VAR MaxBreite AS DEC NO-UNDO INIT 0. DEF VAR MaxHoehe AS DEC NO-UNDO INIT 0. Firma = ipFirma. Sprcd = ipSprcd. ErstFeld = ''. LetztFeld = ''. fCodeI = FALSE. DO i1 = 1 TO NUM-ENTRIES(ipParam, ';'): xFeld = ''. xLabel = ''. xFormat = ''. cFelder = ENTRY(i1, ipParam, ';') NO-ERROR. xFeld = ENTRY(1 , cFelder, ',') NO-ERROR. xLabel = ENTRY(2 , cFelder, ',') NO-ERROR. xFormat = ENTRY(3 , cFelder, ',') NO-ERROR. IF xFeld = 'CodeI' THEN fCodeI = TRUE. DO WHILE TRUE: IF xFormat <> '' THEN LEAVE. CASE xFeld: WHEN 'Firma' THEN xFormat = 'x(08)'. WHEN 'RecArt' THEN xFormat = 'x(04)'. WHEN 'Sprcd' THEN xFormat = '9'. WHEN 'CodeI' THEN xFormat = '999999'. WHEN 'CodeC' THEN xFormat = 'x(08)'. WHEN 'Bez1' THEN xFormat = 'x(30)'. WHEN 'Bez2' THEN xFormat = 'x(30)'. WHEN 'BezL' THEN xFormat = 'x(80)'. WHEN 'Int_1' THEN xFormat = 'zzz,zz9'. WHEN 'Int_2' THEN xFormat = 'zzz,zz9'. WHEN 'Int_3' THEN xFormat = 'zzz,zz9'. WHEN 'Dec_1' THEN xFormat = 'zzz,zz9.99'. WHEN 'Dec_2' THEN xFormat = 'zzz,zz9.99'. WHEN 'Dec_3' THEN xFormat = 'zzz,zz9.99'. END CASE. LEAVE. END. DO WHILE TRUE: dLength = LENGTH(xFormat). ib = INDEX(xFormat, '('). IF ib = 0 THEN LEAVE. ib = ib + 1. ie = INDEX(xFormat, ')'). IF ie = 0 THEN LEAVE. ie = ie - ib. dLength = DECIMAL(SUBSTRING(xFormat,ib,ie)). LEAVE. END. sFeld = sFeld + xFeld . sLabel = sLabel + xLabel. sFormat = sFormat + xFormat. sLength = sLength + STRING(dLength). IF i1 = NUM-ENTRIES(ipParam, ';') THEN LEAVE. sFeld = sFeld + ';'. sLabel = sLabel + ';'. sFormat = sFormat + ';'. sLength = sLength + ';'. END. IF NOT VALID-HANDLE(hFelder) THEN hFelder = FRAME {&FRAME-NAME}:CURRENT-ITERATION. ASSIGN hFelder = hFelder:FIRST-CHILD. FOR EACH THandle: DELETE THandle. END. DO WHILE VALID-HANDLE (hFelder) : DO WHILE TRUE: IF hFelder:TYPE = 'LITERAL' THEN LEAVE. IF hFelder:TYPE = 'RECTANGLE' THEN LEAVE. i1 = LOOKUP(hFelder:NAME, sFeld, ';'). IF i1 = 0 THEN DO: hFelder:HIDDEN = TRUE. hFelder:TAB-STOP = FALSE. hFelder:SENSITIVE = FALSE. hFelder:READ-ONLY = TRUE. LEAVE. END. CREATE THandle. ASSIGN THandle.TNr = i1 THandle.TFeld = hFelder THandle.TLabel = ENTRY(i1, sLabel , ';') THandle.TFormat = ENTRY(i1, sFormat, ';') THandle.TLength = DECIMAL(ENTRY(i1, sLength, ';')) THandle.TType = hFelder:DATA-TYPE. CASE THandle.TType: WHEN 'CHARACTER' THEN DO: IF THandle.TLength < 6 THEN THandle.TLength = THandle.TLength * 2.00. ELSE IF THandle.TLength < 10 THEN THandle.TLength = THandle.TLength * 1.75. ELSE IF THandle.TLength < 15 THEN THandle.TLength = THandle.TLength * 1.50. ELSE IF THandle.TLength < 20 THEN THandle.TLength = THandle.TLength * 1.25. ELSE THandle.TLength = THandle.TLength + 2. END. WHEN 'INTEGER' THEN DO: IF THandle.TLength < 3 THEN THandle.TLength = THandle.TLength * 2.22. ELSE IF THandle.TLength < 5 THEN THandle.TLength = THandle.TLength * 2.00. ELSE IF THandle.TLength < 7 THEN THandle.TLength = THandle.TLength * 1.75. ELSE THandle.TLength = THandle.TLength + 1.666. END. WHEN 'DECIMAL' THEN DO: IF THandle.TLength < 3 THEN THandle.TLength = THandle.TLength * 2.22. ELSE IF THandle.TLength < 5 THEN THandle.TLength = THandle.TLength * 2.00. ELSE IF THandle.TLength < 7 THEN THandle.TLength = THandle.TLength * 1.75. ELSE THandle.TLength = THandle.TLength + 1.666. END. END CASE. ASSIGN hFelder:HIDDEN = FALSE hFelder:TAB-STOP = TRUE hFelder:SENSITIVE = TRUE hFelder:READ-ONLY = FALSE hFelder:LABEL = THandle.TLabel hFelder:FORMAT = THandle.TFormat hFelder:WIDTH = THandle.TLength. LEAVE. END. ASSIGN hFelder = hFelder:NEXT-SIBLING. END. hTabOrder = ?. FOR EACH THandle BY THandle.TNr: hFelder = THandle.TFeld. IF VALID-HANDLE(hTabOrder) THEN hFelder:MOVE-AFTER-TAB-ITEM(hTabOrder). hTabOrder = hFelder. IF hFelder:NAME BEGINS 'Code' THEN DO: IF yCode = 0 THEN DO: yCode = yPos. yPos = yPos + 1. END. THandle.TY = yCode. END. IF hFelder:NAME = 'Bez1' OR hFelder:NAME = 'Bez2' THEN DO: IF yBezK = 0 THEN DO: yBezK = yPos. yPos = yPos + 1. END. THandle.TY = yBezK. END. IF hFelder:NAME = 'BezL' THEN DO: IF yBezL = 0 THEN DO: yBezL = yPos. yPos = yPos + 1. END. THandle.TY = yBezL. END. IF hFelder:NAME BEGINS 'Int' THEN DO: IF yInt = 0 THEN DO: yInt = yPos. yPos = yPos + 1. END. THandle.TY = yInt. END. IF hFelder:NAME BEGINS 'Dec' THEN DO: IF yDec = 0 THEN DO: yDec = yPos. yPos = yPos + 1. END. THandle.TY = yDec. END. IF ErstFeld = '' THEN ErstFeld = hFelder:NAME. LetztFeld = hFelder:NAME. END. FOR EACH THandle BREAK BY THandle.TY BY THandle.TNr : hFelder = THandle.TFeld. IF FIRST-OF ( THandle.TY ) THEN xPos = XBeg. THandle.TX = xPos. THandle.TFx = xPos. IF hFelder:NAME BEGINS 'Code' THEN xPos = 72. IF hFelder:NAME BEGINS 'Bez' THEN xPos = 72. IF hFelder:NAME BEGINS 'Int' THEN xPos = xPos + 35. IF hFelder:NAME BEGINS 'Dec' THEN xPos = xPos + 35. IF THandle.TX = xBeg THEN THandle.TFx = 3. IF THandle.TX = 72 THEN THandle.TFx = 55. IF THandle.TX = 55 THEN THandle.TFx = 45. IF THandle.TX = 90 THEN THandle.TFx = 80. END. MaxBreite = 0. MaxHoehe = 0. FOR EACH THandle BREAK BY THandle.TY BY THandle.TNr : hFelder = THandle.TFeld. hFelder:ROW = THandle.TY. hFelder:COLUMN = THandle.TX. IF (hFelder:FRAME-COL + hFelder:WIDTH-CHAR) > MaxBreite THEN MaxBreite = hFelder:COLUMN + hFelder:WIDTH-CHAR. IF hFelder:FRAME-ROW > MaxHoehe THEN MaxHoehe = hFelder:FRAME-ROW. hFelder = hFelder:SIDE-LABEL-HANDLE. hFelder:ROW = THandle.TY. hFelder:COLUMN = THandle.TFx. END. RECT-Viewer:WIDTH-CHAR = MaxBreite. RECT-Viewer:HEIGHT-CHAR = MaxHoehe + 0.2. RETURN STRING(RECT-Viewer:WIDTH-CHAR) + ';' + STRING(RECT-Viewer:HEIGHT-CHAR). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE LEAVE_FELD_TEST vTableWin PROCEDURE LEAVE_FELD_TEST : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipHandle AS HANDLE NO-UNDO. DEF VAR FeldName AS CHAR NO-UNDO. DEF VAR FeldInhalt AS CHAR NO-UNDO. DEF VAR ix AS INT NO-UNDO. DEF VAR LKY AS INT NO-UNDO. DEF VAR hLEAVE AS HANDLE NO-UNDO. DEF VAR hENTER AS HANDLE NO-UNDO. DEF VAR Daten AS CHAR NO-UNDO. IF FMut = FALSE THEN RETURN ''. LKY = LASTKEY. hENTER = LAST-EVENT:WIDGET-ENTER. hLEAVE = LAST-EVENT:WIDGET-LEAVE. FeldName = ''. FeldInhalt = ''. IF NOT VALID-HANDLE(ipHandle) THEN RETURN ''. IF ipHandle:TYPE = 'FRAME' THEN RETURN ''. IF ipHandle:TYPE = 'WINDOW' THEN RETURN ''. IF ipHandle:TYPE = 'LITERAL' THEN RETURN ''. FeldName = ipHandle:NAME. IF ipHandle:TYPE = 'FILL-IN' OR ipHandle:TYPE = 'COMBO-BOX' OR ipHandle:TYPE = 'TOGGLE-BOX' THEN FeldInhalt = ipHandle:SCREEN-VALUE. DO WHILE FNeu: CASE FeldName: WHEN 'CodeI' THEN DO: RUN TEST_FIND ( INPUT SELF ). IF RETURN-VALUE = 'FIND' THEN DO: RUN FEHLER ( INPUT 1023 ). RETURN 'ERROR'. END. END. END CASE. LEAVE. END. IF FeldName = LetztFeld THEN DO: DO WHILE TRUE: IF KEYFUNCTION(LKY) = 'TAB' THEN LEAVE. IF KEYFUNCTION(LKY) = 'RETURN' THEN LEAVE. IF KEYFUNCTION(LKY) = 'F9' THEN LEAVE. RETURN ''. END. APPLY 'ALT-S'. RETURN 'APPLY'. END. RETURN ''. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE RETURN_FELD vTableWin PROCEDURE RETURN_FELD : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipHandle AS HANDLE NO-UNDO. DEF VAR FeldName AS CHAR NO-UNDO. IF FMut = FALSE THEN RETURN ''. IF NOT VALID-HANDLE(ipHandle) THEN RETURN ''. IF ipHandle:TYPE = 'FRAME' THEN RETURN ''. IF ipHandle:TYPE = 'WINDOW' THEN RETURN ''. FeldName = ipHandle:NAME. IF LOOKUP(FeldName, '{&ENABLED-FIELDS}', ' ') > 0 THEN DO: RETURN 'TAB'. END. IF LOOKUP(FeldName, '{&ENABLED-OBJECTS}', ' ') > 0 THEN DO: RETURN 'TAB'. END. FeldName = 'rowObject.' + FeldName. IF LOOKUP(FeldName, '{&ENABLED-FIELDS}', ' ') > 0 THEN DO: RETURN 'TAB'. END. IF LOOKUP(FeldName, '{&ENABLED-OBJECTS}', ' ') > 0 THEN DO: RETURN 'TAB'. END. RETURN ''. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SETRECTBREITE vTableWin PROCEDURE SETRECTBREITE : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipBreite AS DEC NO-UNDO. DO WITH FRAME {&FRAME-NAME}: RECT-Viewer:WIDTH-CHAR = ipBreite. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE TEST_FIND vTableWin PROCEDURE TEST_FIND : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEF INPUT PARAMETER ipFeld AS HANDLE NO-UNDO. CASE ipFeld:NAME: WHEN 'CodeI' THEN DO: FIND Tabel USE-INDEX Tabel-k2 WHERE Tabel.Firma = Firma AND Tabel.RecArt = RecArt AND Tabel.CodeI = INTEGER(ipFeld:SCREEN-VALUE) AND Tabel.CodeC = '' AND Tabel.Sprcd = Sprcd NO-LOCK NO-ERROR. END. WHEN 'CodeC' THEN DO: FIND Tabel USE-INDEX Tabel-k1 WHERE Tabel.Firma = Firma AND Tabel.RecArt = RecArt AND Tabel.CodeC = ipFeld:SCREEN-VALUE AND Tabel.CodeI = 0 AND Tabel.Sprcd = Sprcd NO-LOCK NO-ERROR. END. END CASE. IF AVAILABLE Tabel THEN RETURN 'FIND'. ELSE RETURN 'NOTFIND'. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE updateMode vTableWin PROCEDURE updateMode : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER pcMode AS CHARACTER NO-UNDO. CASE pcMode: WHEN 'updateBegin' THEN DO: END. WHEN 'updateEnd' THEN DO: END. END. RUN SUPER( INPUT pcMode). CASE pcMode: WHEN 'updateBegin' THEN DO: FMut = TRUE. END. WHEN 'updateEnd' THEN DO: FNeu = FALSE. FMut = FALSE. FCopy = FALSE. END. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE updateRecord vTableWin PROCEDURE updateRecord : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ DEF VAR iWert AS INT NO-UNDO. DEF VAR JA AS LOG INIT FALSE NO-UNDO. DEF BUFFER BArtPreis FOR ArtPreis. DO WITH FRAME {&FRAME-NAME}: rowObject.Firma:SCREEN-VALUE = Firma. rowObject.RecArt:SCREEN-VALUE = RecArt. rowObject.Sprcd:SCREEN-VALUE = STRING(Sprcd). IF rowObject.CodeI:SENSITIVE = FALSE THEN rowObject.CodeI:SCREEN-VALUE = '0'. IF rowObject.CodeC:SENSITIVE = FALSE THEN rowObject.CodeC:SCREEN-VALUE = ''. END. RUN SUPER. REPEAT TRANSACTION: IF RecArt <> 'PREGRP' THEN LEAVE. iWert = INTEGER(rowObject.Int_2:SCREEN-VALUE). IF iWert > 0 THEN LEAVE. MESSAGE 'Alle Preise mit dieser Gruppe werden auf inaktiv gesetzt!' VIEW-AS ALERT-BOX INFORMATION BUTTONS YES-NO UPDATE JA. IF NOT JA THEN LEAVE. FOR EACH ArtPreis NO-LOCK WHERE ArtPreis.Firma = Firma AND ArtPreis.Preis_Grp = INTEGER(rowObject.CodeI:SCREEN-VALUE). FIND BArtPreis WHERE RECID(BArtPreis) = RECID(ArtPreis). ASSIGN BArtPreis.Aktiv = FALSE. RELEASE BArtPreis. END. LEAVE. END. /* Code placed here will execute AFTER standard behavior. */ END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME