| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495 |
- &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI ADM1
- &ANALYZE-RESUME
- /* Connected Databases
- anadat PROGRESS
- */
- &Scoped-define WINDOW-NAME CURRENT-WINDOW
- /* Temp-Table and Buffer definitions */
- DEFINE TEMP-TABLE TTabel NO-UNDO LIKE Tabel.
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS F-Frame-Win
- /*------------------------------------------------------------------------
- File:
- Description: from cntnrfrm.w - ADM SmartFrame Template
- Input Parameters:
- <none>
- Output Parameters:
- <none>
-
- ------------------------------------------------------------------------*/
- /* This .W file was created with the Progress UIB. */
- /*----------------------------------------------------------------------*/
- /* 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 --- */
- DEF VAR VKnr AS INT NO-UNDO.
- DEF VAR VBesnr AS INT NO-UNDO.
- /* ---------- Globale Variablen ---------------------------------- */
- { v8/globvar.i" " " " "SHARED" }
- { v8/debivar.i " " " " "SHARED" }
- { v8/artivar.i " " " " "SHARED" }
- { v8/contvar.i " " " " "SHARED" }
- /* _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
- /* Name of first Frame and/or Browse and/or first Query */
- &Scoped-define FRAME-NAME F-Main
- &Scoped-define BROWSE-NAME BROWSE-1
- /* Internal Tables (found by Frame, Query & Browse Queries) */
- &Scoped-define INTERNAL-TABLES TTabel
- /* Definitions for BROWSE BROWSE-1 */
- &Scoped-define FIELDS-IN-QUERY-BROWSE-1 TTabel.CodeC TTabel.Bez1 ~
- TTabel.Int_1
- &Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-1
- &Scoped-define OPEN-QUERY-BROWSE-1 OPEN QUERY BROWSE-1 FOR EACH TTabel NO-LOCK ~
- BY TTabel.Recart ~
- BY TTabel.CodeC.
- &Scoped-define TABLES-IN-QUERY-BROWSE-1 TTabel
- &Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-1 TTabel
- /* Definitions for FRAME F-Main */
- /* Standard List Definitions */
- &Scoped-Define ENABLED-OBJECTS BROWSE-1
- /* Custom List Definitions */
- /* List-1,List-2,List-3,List-4,List-5,List-6 */
- /* _UIB-PREPROCESSOR-BLOCK-END */
- &ANALYZE-RESUME
- /* *********************** Control Definitions ********************** */
- /* Definitions of the field level widgets */
- /* Query definitions */
- &ANALYZE-SUSPEND
- DEFINE QUERY BROWSE-1 FOR
- TTabel SCROLLING.
- &ANALYZE-RESUME
- /* Browse definitions */
- DEFINE BROWSE BROWSE-1
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS BROWSE-1 F-Frame-Win _STRUCTURED
- QUERY BROWSE-1 DISPLAY
- TTabel.CodeC COLUMN-LABEL "Geb-Cd" FORMAT "x(12)":U
- TTabel.Bez1 COLUMN-LABEL "Gebinde" FORMAT "x(40)":U
- TTabel.Int_1 COLUMN-LABEL "Anzahl" FORMAT "->>>,>>>,>>9":U
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- WITH NO-ROW-MARKERS SEPARATORS SIZE 71.8 BY 15.91
- BGCOLOR 15
- TITLE BGCOLOR 15 "Gebindeübersicht der gelieferten Gebinde".
- /* ************************ Frame Definitions *********************** */
- DEFINE FRAME F-Main
- BROWSE-1 AT ROW 3 COL 23.6
- WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
- SIDE-LABELS NO-UNDERLINE THREE-D
- AT COL 1 ROW 1
- SIZE 119.6 BY 19.62.
- /* *********************** Procedure Settings ************************ */
- &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
- /* Settings for THIS-PROCEDURE
- Type: SmartFrame
- Allow: Basic,Browse,DB-Fields,Query,Smart
- Other Settings: PERSISTENT-ONLY
- Temp-Tables and Buffers:
- TABLE: TTabel T "?" NO-UNDO AnaDat Tabel
- 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 F-Frame-Win ASSIGN
- HEIGHT = 19.62
- WIDTH = 119.6.
- /* END WINDOW DEFINITION */
- */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB F-Frame-Win
- /* ************************* Included-Libraries *********************** */
- {src/adm/method/containr.i}
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- /* *********** Runtime Attributes and AppBuilder Settings *********** */
- &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
- /* SETTINGS FOR WINDOW F-Frame-Win
- VISIBLE,,RUN-PERSISTENT */
- /* SETTINGS FOR FRAME F-Main
- NOT-VISIBLE */
- /* BROWSE-TAB BROWSE-1 1 F-Main */
- /* _RUN-TIME-ATTRIBUTES-END */
- &ANALYZE-RESUME
- /* Setting information for Queries and Browse Widgets fields */
- &ANALYZE-SUSPEND _QUERY-BLOCK BROWSE BROWSE-1
- /* Query rebuild information for BROWSE BROWSE-1
- _TblList = "Temp-Tables.TTabel"
- _OrdList = "Temp-Tables.TTabel.Recart|yes,Temp-Tables.TTabel.CodeC|yes"
- _FldNameList[1] > Temp-Tables.TTabel.CodeC
- "TTabel.CodeC" "Geb-Cd" "x(12)" "character" ? ? ? ? ? ? no ? no no ? yes no no "U" "" ""
- _FldNameList[2] > Temp-Tables.TTabel.Bez1
- "TTabel.Bez1" "Gebinde" "x(40)" "character" ? ? ? ? ? ? no ? no no ? yes no no "U" "" ""
- _FldNameList[3] > Temp-Tables.TTabel.Int_1
- "TTabel.Int_1" "Anzahl" "->>>,>>>,>>9" "integer" ? ? ? ? ? ? no ? no no ? yes no no "U" "" ""
- _Query is NOT OPENED
- */ /* BROWSE BROWSE-1 */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
- /* Query rebuild information for FRAME F-Main
- _Options = ""
- _Query is NOT OPENED
- */ /* FRAME F-Main */
- &ANALYZE-RESUME
-
- /* ************************ Control Triggers ************************ */
- &Scoped-define SELF-NAME F-Main
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL F-Main F-Frame-Win
- ON END-ERROR OF FRAME F-Main
- DO:
- RUN new-state ( INPUT 'ENDE, MAIN':U ).
- RETURN NO-APPLY.
- END.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &Scoped-define BROWSE-NAME BROWSE-1
- &Scoped-define SELF-NAME BROWSE-1
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BROWSE-1 F-Frame-Win
- ON END-ERROR OF BROWSE-1 IN FRAME F-Main /* Gebindeübersicht der gelieferten Gebinde */
- DO:
- RUN new-state ( INPUT 'ENDE, MAIN':U ).
- RETURN NO-APPLY.
- END.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &UNDEFINE SELF-NAME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK F-Frame-Win
- /* *************************** Main Block *************************** */
- &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 dispatch IN THIS-PROCEDURE ('initialize':U).
- &ENDIF
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- /* ********************** Internal Procedures *********************** */
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects F-Frame-Win _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: <none>
- ------------------------------------------------------------------------------*/
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available F-Frame-Win _ADM-ROW-AVAILABLE
- PROCEDURE adm-row-available :
- /*------------------------------------------------------------------------------
- Purpose: Dispatched to this procedure when the Record-
- Source has a new row available. This procedure
- tries to get the new row (or foriegn keys) from
- the Record-Source and process it.
- Parameters: <none>
- ------------------------------------------------------------------------------*/
- /* Define variables needed by this internal procedure. */
- {src/adm/template/row-head.i}
- /* Process the newly available records (i.e. display fields,
- open queries, and/or pass records on to any RECORD-TARGETS). */
- {src/adm/template/row-end.i}
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI F-Frame-Win _DEFAULT-DISABLE
- PROCEDURE disable_UI :
- /*------------------------------------------------------------------------------
- Purpose: DISABLE the User Interface
- Parameters: <none>
- 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 enable_UI F-Frame-Win _DEFAULT-ENABLE
- PROCEDURE enable_UI :
- /*------------------------------------------------------------------------------
- Purpose: ENABLE the User Interface
- Parameters: <none>
- 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 BROWSE-1
- WITH FRAME F-Main.
- {&OPEN-BROWSERS-IN-QUERY-F-Main}
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-view F-Frame-Win
- PROCEDURE local-view :
- /*------------------------------------------------------------------------------
- Purpose: Override standard ADM method
- Notes:
- ------------------------------------------------------------------------------*/
- VKnr = LVLnr.
- VBesnr = LVBesnr.
-
- FOR EACH TTabel:
- DELETE TTabel.
- END.
- FOR EACH Besze USE-INDEX Besze-k1
- WHERE Besze.Firma = GVFirma
- AND Besze.Besnr = VBesnr NO-LOCK:
- DO WHILE TRUE:
- IF Besze.KGeb_Cd = '' THEN LEAVE.
- IF Besze.KGeb_Me = 0 THEN LEAVE.
- FIND KGebinde USE-INDEX KGebinde-k1
- WHERE KGebinde.Firma = GVFirma
- AND KGebinde.Geb_Cd = Besze.KGeb_Cd NO-LOCK NO-ERROR.
- IF NOT AVAILABLE KGebinde THEN LEAVE.
- FIND TTabel USE-INDEX Tabel-k1
- WHERE TTabel.Firma = GVFirma
- AND TTabel.RecArt = 'A'
- AND TTabel.CodeC = KGebinde.Geb_Cd
- AND TTabel.CodeI = 0
- AND TTabel.Sprcd = 1 NO-ERROR.
- IF NOT AVAILABLE TTabel THEN DO:
- CREATE TTabel.
- ASSIGN TTabel.Firma = GVFirma
- TTabel.RecArt = 'A'
- TTabel.CodeC = KGebinde.Geb_Cd
- TTabel.CodeI = 0
- TTabel.Sprcd = 1
- TTabel.Bez1 = KGebinde.Bez.
- END.
- TTabel.Int_1 = TTabel.Int_1 + Besze.KGeb_Me.
- LEAVE.
- END.
- DO WHILE TRUE:
- IF Besze.VGeb_Cd = '' THEN LEAVE.
- IF Besze.VGeb_Me = 0 THEN LEAVE.
- FIND VGebinde USE-INDEX VGebinde-k1
- WHERE VGebinde.Firma = GVFirma
- AND VGebinde.Geb_Cd = Besze.VGeb_Cd NO-LOCK NO-ERROR.
- IF NOT AVAILABLE VGebinde THEN LEAVE.
- FIND TTabel USE-INDEX Tabel-k1
- WHERE TTabel.Firma = GVFirma
- AND TTabel.RecArt = 'B'
- AND TTabel.CodeC = VGebinde.Geb_Cd
- AND TTabel.CodeI = 0
- AND TTabel.Sprcd = 1 NO-ERROR.
- IF NOT AVAILABLE TTabel THEN DO:
- CREATE TTabel.
- ASSIGN TTabel.Firma = GVFirma
- TTabel.RecArt = 'B'
- TTabel.CodeC = VGebinde.Geb_Cd
- TTabel.CodeI = 0
- TTabel.Sprcd = 1
- TTabel.Bez1 = VGebinde.Bez.
- END.
- TTabel.Int_1 = TTabel.Int_1 + Besze.VGeb_Me.
- LEAVE.
- END.
- DO WHILE TRUE:
- IF Besze.GGeb_Cd = '' THEN LEAVE.
- IF Besze.GGeb_Me = 0 THEN LEAVE.
- FIND GGebinde USE-INDEX GGebinde-k1
- WHERE GGebinde.Firma = GVFirma
- AND GGebinde.Geb_Cd = Besze.GGeb_Cd NO-LOCK NO-ERROR.
- IF NOT AVAILABLE GGebinde THEN LEAVE.
- FIND TTabel USE-INDEX Tabel-k1
- WHERE TTabel.Firma = GVFirma
- AND TTabel.RecArt = 'C'
- AND TTabel.CodeC = GGebinde.Geb_Cd
- AND TTabel.CodeI = 0
- AND TTabel.Sprcd = 1 NO-ERROR.
- IF NOT AVAILABLE TTabel THEN DO:
- CREATE TTabel.
- ASSIGN TTabel.Firma = GVFirma
- TTabel.RecArt = 'C'
- TTabel.CodeC = GGebinde.Geb_Cd
- TTabel.CodeI = 0
- TTabel.Sprcd = 1
- TTabel.Bez1 = GGebinde.Bez.
- END.
- TTabel.Int_1 = TTabel.Int_1 + Besze.GGeb_Me.
- LEAVE.
- END.
- END.
- RUN dispatch IN THIS-PROCEDURE ( INPUT 'view':U ) .
-
- RUN OPEN_QUERY.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE OPEN_QUERY F-Frame-Win
- PROCEDURE OPEN_QUERY :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DO WITH FRAME {&FRAME-NAME}:
- IF NUM-RESULTS("{&BROWSE-NAME}":U) <> ? THEN CLOSE QUERY {&BROWSE-NAME}.
-
- OPEN QUERY {&BROWSE-NAME}
- FOR EACH TTabel NO-LOCK
- BY TTabel.RecArt
- BY TTabel.CodeC .
- APPLY 'ENTRY' TO BROWSE {&BROWSE-NAME}.
- END.
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records F-Frame-Win _ADM-SEND-RECORDS
- PROCEDURE send-records :
- /*------------------------------------------------------------------------------
- Purpose: Send record ROWID's for all tables used by
- this file.
- Parameters: see template/snd-head.i
- ------------------------------------------------------------------------------*/
- /* Define variables needed by this internal procedure. */
- {src/adm/template/snd-head.i}
- /* For each requested table, put it's ROWID in the output list. */
- {src/adm/template/snd-list.i "TTabel"}
- /* Deal with any unexpected table requests before closing. */
- {src/adm/template/snd-end.i}
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed F-Frame-Win
- PROCEDURE state-changed :
- /* -----------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- -------------------------------------------------------------*/
- DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE NO-UNDO.
- DEFINE INPUT PARAMETER p-state AS CHARACTER NO-UNDO.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
|