&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 XSchrift NO-UNDO LIKE Schrift. DEFINE NEW SHARED TEMP-TABLE XTermOut NO-UNDO LIKE TermOut. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS B-table-Win /*------------------------------------------------------------------------ File: Description: from BROWSER.W - Basic SmartBrowser Object Template Input Parameters: Output Parameters: ------------------------------------------------------------------------*/ /* 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 --- */ DEFINE VARIABLE AltSchname LIKE Schrift.Schname NO-UNDO. DEFINE VARIABLE QOpen AS LOG NO-UNDO. DEFINE VARIABLE FOpen AS LOG NO-UNDO. DEFINE VARIABLE OBreite AS INTEGER. DEFINE VARIABLE VProgname AS CHARACTER NO-UNDO. DEFINE VARIABLE XArtnr LIKE Artst.Artnr. DEFINE VARIABLE ARecid AS RECID INIT -1 NO-UNDO. DEFINE VARIABLE BRecid AS RECID INIT -1 NO-UNDO. DEFINE VARIABLE FInit AS LOG NO-UNDO. DEFINE VARIABLE VBesko AS LOG NO-UNDO. DEFINE VARIABLE VBesnr AS INTEGER NO-UNDO. DEFINE VARIABLE VPos AS INTEGER NO-UNDO. DEFINE VARIABLE iLager AS INTEGER NO-UNDO. /* ------------------------------------------------------------------------- */ DEFINE VARIABLE VArtnr LIKE Artst.Artnr NO-UNDO. DEFINE VARIABLE BArtnr LIKE Artst.Artnr NO-UNDO. DEFINE VARIABLE VWgr AS CHARACTER NO-UNDO. DEFINE VARIABLE VHerst AS CHARACTER NO-UNDO. DEFINE VARIABLE VKnr LIKE Debst.Knr NO-UNDO. DEFINE VARIABLE BKnr LIKE Debst.Knr NO-UNDO. DEFINE VARIABLE FUnter AS LOG NO-UNDO. DEFINE VARIABLE FLeer AS LOG NO-UNDO. DEFINE VARIABLE XWgr AS CHARACTER FORMAT "x(30)" NO-UNDO. DEFINE VARIABLE XPgr AS CHARACTER FORMAT "x(30)" NO-UNDO. DEFINE VARIABLE XAgr AS CHARACTER FORMAT "x(30)" NO-UNDO. DEFINE VARIABLE XStern AS CHARACTER FORMAT "x" NO-UNDO. DEFINE VARIABLE cDrucker AS CHARACTER NO-UNDO. DEFINE VARIABLE VTotal0 AS DECIMAL EXTENT 10. DEFINE VARIABLE VTotal1 AS DECIMAL EXTENT 10. DEFINE VARIABLE VZeile AS CHARACTER FORMAT "x(180)". DEFINE VARIABLE RRand AS INTEGER INIT 0. DEFINE BUFFER BArtLief FOR ArtLief. DEFINE BUFFER BArtst FOR Artst. DEFINE BUFFER BAdresse FOR Adresse. /* ---------- Globale Variablen ---------------------------------- */ { v8/globvar.i" " " " "SHARED" } { v8/debivar.i " " " " "SHARED" } { v8/artivar.i " " " " "SHARED" } { v8/contvar.i " " " " "SHARED" } { v8/listtitv.i "NEW" "SHARED" } /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK /* ******************** Preprocessor Definitions ******************** */ &Scoped-define PROCEDURE-TYPE SmartBrowser &Scoped-define DB-AWARE no &Scoped-define ADM-SUPPORTED-LINKS Record-Source,Record-Target,TableIO-Target /* Name of designated FRAME-NAME and/or first browse and/or first query */ &Scoped-define FRAME-NAME F-Main &Scoped-define BROWSE-NAME Br_Druckername /* Internal Tables (found by Frame, Query & Browse Queries) */ &Scoped-define INTERNAL-TABLES XSchrift Schrift /* Definitions for BROWSE Br_Druckername */ &Scoped-define FIELDS-IN-QUERY-Br_Druckername XSchrift.Schname &Scoped-define ENABLED-FIELDS-IN-QUERY-Br_Druckername &Scoped-define QUERY-STRING-Br_Druckername FOR EACH XSchrift NO-LOCK ~ BY XSchrift.Schname &Scoped-define OPEN-QUERY-Br_Druckername OPEN QUERY Br_Druckername FOR EACH XSchrift NO-LOCK ~ BY XSchrift.Schname. &Scoped-define TABLES-IN-QUERY-Br_Druckername XSchrift &Scoped-define FIRST-TABLE-IN-QUERY-Br_Druckername XSchrift /* Definitions for BROWSE Br_Schriftbild */ &Scoped-define FIELDS-IN-QUERY-Br_Schriftbild Schrift.Schbild &Scoped-define ENABLED-FIELDS-IN-QUERY-Br_Schriftbild &Scoped-define QUERY-STRING-Br_Schriftbild FOR EACH Schrift NO-LOCK ~ BY Schrift.Schbild &Scoped-define OPEN-QUERY-Br_Schriftbild OPEN QUERY Br_Schriftbild FOR EACH Schrift NO-LOCK ~ BY Schrift.Schbild. &Scoped-define TABLES-IN-QUERY-Br_Schriftbild Schrift &Scoped-define FIRST-TABLE-IN-QUERY-Br_Schriftbild Schrift /* Definitions for FRAME F-Main */ /* Standard List Definitions */ &Scoped-Define ENABLED-FIELDS Listen.VNr[1] Listen.BNr[1] Listen.ECh[1] ~ Listen.ECh[2] Listen.VNr[4] Listen.BNr[4] Listen.VFl[1] Listen.VFl[2] &Scoped-define ENABLED-TABLES Listen &Scoped-define FIRST-ENABLED-TABLE Listen &Scoped-Define ENABLED-OBJECTS RECT-10 RECT-11 RECT-12 RECT-13 RECT-17 ~ Br_Druckername Br_Schriftbild F_USER F_Programm F_Zeichen F_Sort F_TZZ ~ F_KZZ F_FZZ F_LQ F_KOPIE F_SCHACHT CB_Lager Btn_Start Btn_Ende Btn_Excel &Scoped-Define DISPLAYED-FIELDS Listen.VNr[1] Listen.BNr[1] Listen.ECh[1] ~ Listen.ECh[2] Listen.VNr[4] Listen.BNr[4] Listen.VFl[1] Listen.VFl[2] &Scoped-define DISPLAYED-TABLES Listen &Scoped-define FIRST-DISPLAYED-TABLE Listen &Scoped-Define DISPLAYED-OBJECTS F_USER F_Programm F_Zeichen F_Sort F_TZZ ~ F_KZZ F_FZZ F_LQ F_KOPIE F_SCHACHT CB_Lager /* Custom List Definitions */ /* List-1,List-2,List-3,List-4,List-5,List-6 */ &Scoped-define List-1 F_USER F_Programm F_Zeichen F_Sort F_TZZ F_KZZ F_FZZ ~ F_LQ F_KOPIE F_SCHACHT &Scoped-define List-2 Listen.VNr[1] Listen.BNr[1] Listen.ECh[1] ~ Listen.ECh[2] Listen.VNr[4] Listen.BNr[4] Listen.VFl[1] Listen.VFl[2] /* _UIB-PREPROCESSOR-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _XFTR "Foreign Keys" B-table-Win _INLINE /* Actions: ? adm/support/keyedit.w ? ? ? */ /* STRUCTURED-DATA &BROWSE-NAME ************************** * Set attributes related to FOREIGN KEYS */ RUN set-attribute-list ( 'Keys-Accepted = "", Keys-Supplied = ""':U). /************************** */ /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _XFTR "Advanced Query Options" B-table-Win _INLINE /* Actions: ? adm/support/advqedit.w ? ? ? */ /* STRUCTURED-DATA &BROWSE-NAME ************************ * Set attributes related to SORTBY-OPTIONS */ RUN set-attribute-list ( 'SortBy-Options = ""':U). /************************ */ /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********************** Control Definitions ********************** */ /* Definitions of the field level widgets */ DEFINE BUTTON Btn_Ende LABEL "&Ende" SIZE 14 BY 1.24. DEFINE BUTTON Btn_Excel LABEL "E&xcel" SIZE 14 BY 1.24. DEFINE BUTTON Btn_Start LABEL "&Starten" SIZE 14 BY 1.24. DEFINE VARIABLE CB_Lager AS CHARACTER FORMAT "X(256)":U LABEL "Lager" VIEW-AS COMBO-BOX INNER-LINES 5 LIST-ITEM-PAIRS "Item 1","Item 1" DROP-DOWN-LIST SIZE 31.8 BY 1 NO-UNDO. DEFINE VARIABLE F_FZZ AS INTEGER FORMAT "999":U INITIAL 0 LABEL "Fusszeilen" VIEW-AS FILL-IN NATIVE SIZE 7 BY 1.05 TOOLTIP "Wieviele Zeilen müssen am Ende der Seite leer bleiben" BGCOLOR 15 NO-UNDO. DEFINE VARIABLE F_KOPIE AS INTEGER FORMAT "9":U INITIAL 0 LABEL "Anz. Kopien" VIEW-AS FILL-IN NATIVE SIZE 4.2 BY 1.05 TOOLTIP "Anzahl Listenkopien" BGCOLOR 15 NO-UNDO. DEFINE VARIABLE F_KZZ AS INTEGER FORMAT "999":U INITIAL 0 LABEL "Kopfzeilen" VIEW-AS FILL-IN NATIVE SIZE 7 BY 1.05 TOOLTIP "Wieviele leere Kopfzeilen müssen gedruckt werden" BGCOLOR 15 NO-UNDO. DEFINE VARIABLE F_LQ AS LOGICAL FORMAT "j/n":U INITIAL NO LABEL "Schönschrift" VIEW-AS FILL-IN NATIVE SIZE 4.2 BY 1.05 TOOLTIP "Wieviele Zeilen müssen am Ende der Seite leer bleiben" BGCOLOR 15 NO-UNDO. DEFINE VARIABLE F_Programm AS CHARACTER FORMAT "X(20)":U INITIAL "BESTVOR" LABEL "Programm" VIEW-AS FILL-IN NATIVE SIZE 18 BY 1 BGCOLOR 15 NO-UNDO. DEFINE VARIABLE F_SCHACHT AS INTEGER FORMAT "9":U INITIAL 0 LABEL "Schacht" VIEW-AS FILL-IN NATIVE SIZE 4.2 BY 1.05 TOOLTIP "Welcher Schacht muss angesteuer werden" BGCOLOR 15 NO-UNDO. DEFINE VARIABLE F_TZZ AS INTEGER FORMAT "999":U INITIAL 0 LABEL "Zeilen" VIEW-AS FILL-IN NATIVE SIZE 7 BY 1.05 TOOLTIP "Wieviele Zeilen hat die ganze Seite" BGCOLOR 15 NO-UNDO. DEFINE VARIABLE F_USER AS CHARACTER FORMAT "X(20)":U LABEL "Benutzer" VIEW-AS FILL-IN NATIVE SIZE 18 BY 1 BGCOLOR 15 NO-UNDO. DEFINE VARIABLE F_Zeichen AS INTEGER FORMAT "zzz,zzz,zz9":U INITIAL 0 LABEL "Anz. Zeichen" VIEW-AS FILL-IN NATIVE SIZE 18 BY 1 BGCOLOR 15 NO-UNDO. DEFINE VARIABLE F_Sort AS INTEGER VIEW-AS RADIO-SET VERTICAL RADIO-BUTTONS "Lieferant/Warengruppe", 1 SIZE 35.2 BY 2.57 NO-UNDO. DEFINE RECTANGLE RECT-10 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 40 BY 4.14. DEFINE RECTANGLE RECT-11 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 78 BY 9.05. DEFINE RECTANGLE RECT-12 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 40 BY 3.81. DEFINE RECTANGLE RECT-13 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 139.8 BY 1.81. DEFINE RECTANGLE RECT-17 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 144 BY 21.43. /* Query definitions */ &ANALYZE-SUSPEND DEFINE QUERY Br_Druckername FOR XSchrift SCROLLING. DEFINE QUERY Br_Schriftbild FOR Schrift SCROLLING. &ANALYZE-RESUME /* Browse definitions */ DEFINE BROWSE Br_Druckername &ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS Br_Druckername B-table-Win _STRUCTURED QUERY Br_Druckername NO-LOCK DISPLAY XSchrift.Schname COLUMN-LABEL "Drucker" FORMAT "x(30)":U /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME WITH NO-ASSIGN NO-ROW-MARKERS SEPARATORS SIZE 36 BY 8.57 BGCOLOR 15 . DEFINE BROWSE Br_Schriftbild &ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS Br_Schriftbild B-table-Win _STRUCTURED QUERY Br_Schriftbild DISPLAY Schrift.Schbild FORMAT "x(30)":U /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME WITH NO-ROW-MARKERS SEPARATORS SIZE 36 BY 8.57 BGCOLOR 15 . /* ************************ Frame Definitions *********************** */ DEFINE FRAME F-Main Br_Druckername AT ROW 1.71 COL 4 Br_Schriftbild AT ROW 1.71 COL 43 F_USER AT ROW 2.1 COL 98.8 COLON-ALIGNED F_Programm AT ROW 3.19 COL 98.8 COLON-ALIGNED F_Zeichen AT ROW 4.33 COL 98.8 COLON-ALIGNED F_Sort AT ROW 6.43 COL 84 NO-LABELS F_TZZ AT ROW 11.57 COL 11.4 COLON-ALIGNED F_KZZ AT ROW 11.57 COL 33.8 COLON-ALIGNED F_FZZ AT ROW 11.57 COL 57.6 COLON-ALIGNED F_LQ AT ROW 11.57 COL 82.8 COLON-ALIGNED F_KOPIE AT ROW 11.57 COL 105.2 COLON-ALIGNED F_SCHACHT AT ROW 11.57 COL 122 COLON-ALIGNED CB_Lager AT ROW 13.52 COL 26 COLON-ALIGNED WIDGET-ID 2 Btn_Start AT ROW 14.14 COL 126.8 Listen.VNr[1] AT ROW 14.52 COL 26 COLON-ALIGNED HELP "" LABEL "von - bis Artikelnr." FORMAT "999999" VIEW-AS FILL-IN NATIVE SIZE 12.6 BY 1.05 BGCOLOR 15 Listen.BNr[1] AT ROW 14.52 COL 45.2 COLON-ALIGNED HELP "" LABEL "-" FORMAT "999999" VIEW-AS FILL-IN NATIVE SIZE 12.6 BY 1.05 BGCOLOR 15 Listen.ECh[1] AT ROW 15.52 COL 26 COLON-ALIGNED LABEL "Warengruppen" FORMAT "x(250)" VIEW-AS FILL-IN NATIVE SIZE 51.8 BY 1 BGCOLOR 15 Btn_Ende AT ROW 15.67 COL 126.8 Listen.ECh[2] AT ROW 16.52 COL 26 COLON-ALIGNED LABEL "Hersteller" FORMAT "x(250)" VIEW-AS FILL-IN NATIVE SIZE 51.8 BY 1 BGCOLOR 15 Btn_Excel AT ROW 17.14 COL 126.8 Listen.VNr[4] AT ROW 17.52 COL 26 COLON-ALIGNED LABEL "von - bis Lieferant" FORMAT "999999" VIEW-AS FILL-IN NATIVE SIZE 12.6 BY 1 BGCOLOR 15 Listen.BNr[4] AT ROW 17.52 COL 45.2 COLON-ALIGNED LABEL "-" FORMAT "999999" VIEW-AS FILL-IN NATIVE SIZE 12.6 BY 1 BGCOLOR 15 Listen.VFl[1] AT ROW 18.52 COL 28 LABEL "Nur unterschrittene" VIEW-AS TOGGLE-BOX SIZE 28 BY 1 Listen.VFl[2] AT ROW 19.52 COL 28 LABEL "Bestellung erfassen" VIEW-AS TOGGLE-BOX SIZE 28.2 BY 1 RECT-10 AT ROW 1.48 COL 82.6 RECT-11 AT ROW 1.48 COL 3 RECT-12 AT ROW 6 COL 83 RECT-13 AT ROW 11.14 COL 3.8 RECT-17 AT ROW 1.24 COL 2 WITH 1 DOWN KEEP-TAB-ORDER OVERLAY SIDE-LABELS NO-UNDERLINE THREE-D AT COL 1 ROW 1 SCROLLABLE . /* *********************** Procedure Settings ************************ */ &ANALYZE-SUSPEND _PROCEDURE-SETTINGS /* Settings for THIS-PROCEDURE Type: SmartBrowser Allow: Basic,Browse Frames: 1 Add Fields to: EXTERNAL-TABLES Other Settings: PERSISTENT-ONLY Temp-Tables and Buffers: TABLE: XSchrift T "?" NO-UNDO AnaDat Schrift TABLE: XTermOut T "NEW SHARED" NO-UNDO AnaDat TermOut 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 B-table-Win ASSIGN HEIGHT = 22.05 WIDTH = 146. /* END WINDOW DEFINITION */ */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB B-table-Win /* ************************* Included-Libraries *********************** */ {src/adm/method/browser.i} /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********** Runtime Attributes and AppBuilder Settings *********** */ &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES /* SETTINGS FOR WINDOW B-table-Win NOT-VISIBLE,,RUN-PERSISTENT */ /* SETTINGS FOR FRAME F-Main NOT-VISIBLE FRAME-NAME Size-to-Fit */ /* BROWSE-TAB Br_Druckername RECT-17 F-Main */ /* BROWSE-TAB Br_Schriftbild Br_Druckername F-Main */ ASSIGN FRAME F-Main:SCROLLABLE = FALSE FRAME F-Main:HIDDEN = TRUE. /* SETTINGS FOR FILL-IN Listen.BNr[1] IN FRAME F-Main 2 EXP-LABEL EXP-FORMAT EXP-HELP */ /* SETTINGS FOR FILL-IN Listen.BNr[4] IN FRAME F-Main 2 EXP-LABEL EXP-FORMAT */ /* SETTINGS FOR FILL-IN Listen.ECh[1] IN FRAME F-Main 2 EXP-LABEL EXP-FORMAT */ /* SETTINGS FOR FILL-IN Listen.ECh[2] IN FRAME F-Main 2 EXP-LABEL EXP-FORMAT */ /* SETTINGS FOR FILL-IN F_FZZ IN FRAME F-Main 1 */ /* SETTINGS FOR FILL-IN F_KOPIE IN FRAME F-Main 1 */ /* SETTINGS FOR FILL-IN F_KZZ IN FRAME F-Main 1 */ /* SETTINGS FOR FILL-IN F_LQ IN FRAME F-Main 1 */ /* SETTINGS FOR FILL-IN F_Programm IN FRAME F-Main 1 */ /* SETTINGS FOR FILL-IN F_SCHACHT IN FRAME F-Main 1 */ /* SETTINGS FOR RADIO-SET F_Sort IN FRAME F-Main 1 */ /* SETTINGS FOR FILL-IN F_TZZ IN FRAME F-Main 1 */ /* SETTINGS FOR FILL-IN F_USER IN FRAME F-Main 1 */ /* SETTINGS FOR FILL-IN F_Zeichen IN FRAME F-Main 1 */ /* SETTINGS FOR TOGGLE-BOX Listen.VFl[1] IN FRAME F-Main 2 EXP-LABEL */ /* SETTINGS FOR TOGGLE-BOX Listen.VFl[2] IN FRAME F-Main 2 EXP-LABEL */ /* SETTINGS FOR FILL-IN Listen.VNr[1] IN FRAME F-Main 2 EXP-LABEL EXP-FORMAT EXP-HELP */ /* SETTINGS FOR FILL-IN Listen.VNr[4] IN FRAME F-Main 2 EXP-LABEL EXP-FORMAT */ /* _RUN-TIME-ATTRIBUTES-END */ &ANALYZE-RESUME /* Setting information for Queries and Browse Widgets fields */ &ANALYZE-SUSPEND _QUERY-BLOCK BROWSE Br_Druckername /* Query rebuild information for BROWSE Br_Druckername _TblList = "Temp-Tables.XSchrift" _Options = "NO-LOCK" _OrdList = "Temp-Tables.XSchrift.Schname|yes" _FldNameList[1] > Temp-Tables.XSchrift.Schname "XSchrift.Schname" "Drucker" ? "character" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no _Query is NOT OPENED */ /* BROWSE Br_Druckername */ &ANALYZE-RESUME &ANALYZE-SUSPEND _QUERY-BLOCK BROWSE Br_Schriftbild /* Query rebuild information for BROWSE Br_Schriftbild _TblList = "AnaDat.Schrift" _OrdList = "AnaDat.Schrift.Schbild|yes" _FldNameList[1] = AnaDat.Schrift.Schbild _Query is NOT OPENED */ /* BROWSE Br_Schriftbild */ &ANALYZE-RESUME &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 /* ************************ Control Triggers ************************ */ &Scoped-define SELF-NAME F-Main &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL F-Main B-table-Win ON GO OF FRAME F-Main DO: DO TRANSACTION: FIND Listen WHERE RECID(Listen) = ARecid. Listen.Listfl = ''. END. RUN new-state ('drucken_ende':U). END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define BROWSE-NAME Br_Druckername &Scoped-define SELF-NAME Br_Druckername &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br_Druckername B-table-Win ON ROW-ENTRY OF Br_Druckername IN FRAME F-Main DO: /* This code displays initial values for newly added or copied rows. */ {src/adm/template/brsentry.i} END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br_Druckername B-table-Win ON ROW-LEAVE OF Br_Druckername IN FRAME F-Main DO: /* Do not disable this code or no updates will take place except by pressing the Save button on an Update SmartPanel. */ {src/adm/template/brsleave.i} END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br_Druckername B-table-Win ON VALUE-CHANGED OF Br_Druckername IN FRAME F-Main DO: DEFINE VARIABLE VRecid AS RECID NO-UNDO. {src/adm/template/brschnge.i} DO WHILE TRUE WITH FRAME {&FRAME-NAME}: ASchname = XSchrift.Schname. RUN dispatch IN THIS-PROCEDURE ('open-query':U). IF NUM-RESULTS('Br_Schriftbild':U) = ? THEN LEAVE. IF NUM-RESULTS('Br_Schriftbild':U) = 0 THEN LEAVE. FIND FIRST BSchrift WHERE BSchrift.Schname = ASchname AND BSchrift.Schbild = ASchbild NO-LOCK NO-ERROR. IF AVAILABLE BSchrift THEN VRecid = RECID(BSchrift). ELSE DO: GET FIRST Br_Schriftbild. VRecid = RECID(Schrift). END. REPOSITION Br_Schriftbild TO RECID(VRecid). ASchbild = Schrift.Schbild. LEAVE. END. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define BROWSE-NAME Br_Schriftbild &Scoped-define SELF-NAME Br_Schriftbild &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br_Schriftbild B-table-Win ON ROW-ENTRY OF Br_Schriftbild IN FRAME F-Main DO: /* This code displays initial values for newly added or copied rows. */ {src/adm/template/brsentry.i} END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br_Schriftbild B-table-Win ON ROW-LEAVE OF Br_Schriftbild IN FRAME F-Main DO: /* Do not disable this code or no updates will take place except by pressing the Save button on an Update SmartPanel. */ {src/adm/template/brsleave.i} END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br_Schriftbild B-table-Win ON VALUE-CHANGED OF Br_Schriftbild IN FRAME F-Main DO: {src/adm/template/brschnge.i} IF ASchbild <> Schrift.Schbild THEN DO: ASSIGN F_TZZ = Schrift.Schzztot F_KZZ = Schrift.Schzzbeg F_FZZ = Schrift.Schzzend. DISPLAY {&List-1} WITH FRAME {&FRAME-NAME}. END. ASchbild = Schrift.Schbild. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME Btn_Ende &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Ende B-table-Win ON CHOOSE OF Btn_Ende IN FRAME F-Main /* Ende */ DO: DO TRANSACTION: FIND Listen WHERE RECID(Listen) = ARecid. Listen.Listfl = ''. END. { v8/druck_ende.i } RUN new-state ('Seite_1':U). APPLY 'GO' TO FRAME {&FRAME-NAME}. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME Btn_Excel &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Excel B-table-Win ON CHOOSE OF Btn_Excel IN FRAME F-Main /* Excel */ DO: RUN EXCEL. RUN new-state ('Seite_1':U). APPLY 'GO' TO FRAME {&FRAME-NAME}. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME Btn_Start &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Start B-table-Win ON CHOOSE OF Btn_Start IN FRAME F-Main /* Starten */ DO: DO TRANSACTION WITH FRAME {&FRAME-NAME}: ASSIGN {&List-1}. i1 = Br_Druckername:NUM-SELECTED-ROWS. IF i1 = 0 THEN RETURN NO-APPLY. Br_Druckername:FETCH-SELECTED-ROW(1). i1 = Br_Schriftbild:NUM-SELECTED-ROWS. IF i1 = 0 THEN RETURN NO-APPLY. Br_Schriftbild:FETCH-SELECTED-ROW(1). iLager = INTEGER(CB_Lager:SCREEN-VALUE). FIND Listen WHERE RECID(Listen) = ARecid. FIND LiDruck WHERE RECID(LiDruck) = BRecid. ASSIGN Breite = F_Zeichen Listen.Sort = F_Sort Listen.ProgWahl = F_Sort LiDruck.Listtzz = F_TZZ LiDruck.Listkzz = F_KZZ LiDruck.Listfzz = F_FZZ LiDruck.Listlq = F_LQ LiDruck.ListCopy = F_KOPIE LiDruck.Schacht = F_SCHACHT LiDruck.Listdru = XSchrift.Schname LiDruck.Listbild = Schrift.Schbild. IF LiDruck.ListCopy = 0 THEN LiDruck.ListCopy = 1. ASSIGN {&List-2}. IF VNr[01] = 0 AND BNr[01] = 0 THEN BNr[01] = 999999. IF VNr[01] > BNr[01] THEN BNr[01] = VNr[01]. IF VNr[02] = 0 AND BNr[02] = 0 THEN BNr[02] = 99. IF VNr[02] > BNr[02] THEN BNr[02] = VNr[02]. IF VNr[03] = 0 AND BNr[03] = 0 THEN BNr[03] = 99. IF VNr[03] > BNr[03] THEN BNr[03] = VNr[03]. IF VNr[04] = 0 AND BNr[04] = 0 THEN BNr[04] = 999999. IF VNr[04] > BNr[04] THEN BNr[04] = VNr[04]. IF VNr[05] = 0 AND BNr[05] = 0 THEN BNr[05] = 99. IF VNr[05] > BNr[05] THEN BNr[05] = VNr[05]. DISPLAY {&List-2} WITH FRAME {&FRAME-NAME}. ASSIGN LiDruck.ProgWahl = Listen.ProgWahl LiDruck.Listprog = TRIM(F_Programm) + STRING(Listen.ProgWahl,'99'). RELEASE Listen . RELEASE LiDruck. END. FIND Listen WHERE RECID(Listen ) = ARecid NO-LOCK. FIND LiDruck WHERE RECID(LiDruck) = BRecid NO-LOCK. DISABLE Btn_Start WITH FRAME {&FRAME-NAME}. DISABLE Btn_Ende WITH FRAME {&FRAME-NAME}. RUN LIBILD. RUN DRUCKEN. DO TRANSACTION WITH FRAME {&FRAME-NAME}: FIND Listen WHERE RECID(Listen) = ARecid. ASSIGN Listen.Listfl = ''. RELEASE Listen . END. FIND Listen WHERE RECID(Listen ) = ARecid NO-LOCK. ENABLE Btn_Start WITH FRAME {&FRAME-NAME}. ENABLE Btn_Ende WITH FRAME {&FRAME-NAME}. RETURN NO-APPLY. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME CB_Lager &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL CB_Lager B-table-Win ON VALUE-CHANGED OF CB_Lager IN FRAME F-Main /* Lager */ DO: iLager = INTEGER(SELF:SCREEN-VALUE). END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME Listen.ECh[1] &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Listen.ECh[1] B-table-Win ON LEFT-MOUSE-DBLCLICK OF Listen.ECh[1] IN FRAME F-Main /* Warengruppen */ DO: Linktext = SELF:SCREEN-VALUE. RUN "v8/d-ausw-warengrp.w". SELF:SCREEN-VALUE = Linktext. Linktext = ''. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME Listen.ECh[2] &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Listen.ECh[2] B-table-Win ON LEFT-MOUSE-DBLCLICK OF Listen.ECh[2] IN FRAME F-Main /* Hersteller */ DO: LVRecArt = 'HERST'. LVTitel = 'Hersteller'. LVFirma = GVFirma. Linktext = SELF:SCREEN-VALUE. RUN "v8/d-ausw-tabel.w". SELF:SCREEN-VALUE = Linktext. Linktext = ''. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define BROWSE-NAME Br_Druckername &UNDEFINE SELF-NAME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK B-table-Win /* *************************** Main Block *************************** */ &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN RUN dispatch IN THIS-PROCEDURE ('initialize':U). &ENDIF ON END-ERROR ANYWHERE DO: DO TRANSACTION: FIND Listen WHERE RECID(Listen) = ARecid. Listen.Listfl = ''. RELEASE Listen. END. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ********************** Internal Procedures *********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available B-table-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: ------------------------------------------------------------------------------*/ /* 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 B-table-Win _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 DRUCKEN B-table-Win PROCEDURE DRUCKEN : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ FIND Steuer WHERE Steuer.Firma = GVFirma NO-LOCK NO-ERROR. VSort = Listen.Sort. VArtnr = Listen.VNr[01]. BArtnr = Listen.BNr[01]. VWgr = Listen.ECh[01]. VHerst = Listen.ECh[02]. VKnr = Listen.VNr[04]. BKnr = Listen.BNr[04]. FUnter = Listen.VFl[01]. VBesko = Listen.VFl[02]. DO WITH FRAME {&FRAME-NAME}: iLager = INTEGER(CB_Lager:SCREEN-VALUE). END. RUN LISTTIT1. DO PRESELECT EACH BArtLief USE-INDEX ArtLief-k2 WHERE BArtLief.Firma = GVFirma AND BArtLief.Knr >= VKnr AND BArtLief.Knr <= BKnr AND BArtLief.Artnr >= VArtnr AND BArtLief.Artnr <= BArtnr NO-LOCK, FIRST BArtst USE-INDEX Artst-k1 WHERE BArtst.Firma = BArtLief.Firma AND BArtst.Artnr = BArtLief.Artnr AND BArtst.Inhalt = BArtLief.Inhalt AND BArtst.Jahr = BArtLief.Jahr AND ((VWgr = '') OR (VWgr <> '' AND LOOKUP(STRING(BArtst.Wg_Grp,"999"), VWgr , ',') > 0)) AND ((VHerst = '') OR (VHerst <> '' AND LOOKUP(STRING(BArtst.Herst ,"999"), VHerst, ',') > 0)) AND BArtst.Aktiv = TRUE AND BArtst.Ausverk < 9 NO-LOCK, FIRST ArtLager NO-LOCK WHERE ArtLager.Firma = BArtst.Firma AND ArtLager.Artnr = BArtst.Artnr AND ArtLager.Inhalt = BArtst.Inhalt AND ArtLager.Jahr = BArtst.Jahr AND ArtLager.Lager = iLager BREAK BY BArtLief.Knr BY BArtst.Wg_Grp BY BArtst.Prod_Grp BY BArtst.Art_Grp BY BArtst.Artnr BY BArtst.Inhalt BY BArtst.Jahr : DO VCopy = 1 TO LiDruck.ListCopy: LNeu = TRUE. VZeile = "". VTotal0 = 0. VTotal1 = 0. XWgr = ''. XPgr = ''. XAgr = ''. FLeer = FALSE. { v8/opendruck.i } REPEAT: IF LNeu THEN FIND FIRST BArtst. ELSE FIND NEXT BArtst. IF NOT AVAILABLE BArtst THEN LEAVE. LNeu = FALSE. DO WHILE FIRST-OF ( BArtLief.Knr ) : FIND BAdresse USE-INDEX Adresse-k1 WHERE BAdresse.Firma = AdFirma AND BAdresse.Knr = BArtLief.Knr NO-LOCK NO-ERROR. Ueber4 = STRING(BArtLief.Knr,"999999 "). IF AVAILABLE BAdresse THEN Ueber4 = Ueber4 + BAdresse.Anzeig_Br. ELSE Ueber4 = Ueber4 + FILL('?', 20). Ueber4 = Drufettb + Ueber4 + Drufette. TiDruck = TRUE. REPEAT TRANSACTION WHILE VBesko: FIND SteuNr WHERE SteuNr.Firma = GVFirma EXCLUSIVE-LOCK. SteuNr.Nr3 = SteuNr.Nr3 + 1. VBesnr = SteuNr.Nr3. FIND Liefst USE-INDEX Liefst-k1 WHERE Liefst.Firma = GVFirma AND Liefst.Knr = BArtLief.Knr NO-LOCK. CREATE Besko. ASSIGN Besko.Firma = GVFirma Besko.Besnr = VBesnr Besko.Knr = Liefst.Knr Besko.Best_Datum = TODAY Besko.Lief_Datum = TODAY + 7 Besko.Buch_Datum = ? Besko.I_Best = Liefst.Kontakt Besko.Rabatt = Liefst.Rabatt Besko.Gedruckt = FALSE Besko.Verbucht = FALSE Besko.Best_Sta = 1 Besko.Bemerkung = Liefst.Bemerkung Besko.Kopf = Liefst.Kopf Besko.Schluss = Liefst.Schluss Besko.Kond = Liefst.Kond Besko.Lager = iLager. FIND Waehrung NO-LOCK USE-INDEX Waehrung-k1 WHERE Waehrung.Firma = Liefst.Firma AND Waehrung.FRW = Liefst.FRW NO-ERROR. IF AVAILABLE Waehrung THEN DO: ASSIGN Besko.FRW = Waehrung.FRW Besko.Faktor = Waehrung.Faktor Besko.Kurs = Waehrung.Kurs. END. ELSE DO: ASSIGN Besko.FRW = 'CHF' Besko.Faktor = 1 Besko.Kurs = 1.0. END. RELEASE Besko. RELEASE SteuNr. RELEASE Waehrung. LEAVE. END. LEAVE. END. IF FIRST-OF ( BArtst.Wg_Grp ) THEN DO: FIND WarenGrp USE-INDEX WarenGrp-k1 WHERE WarenGrp.Firma = GVFirma AND WarenGrp.Wgr = BArtst.Wg_Grp NO-LOCK NO-ERROR. IF AVAILABLE WarenGrp THEN XWgr = WarenGrp.Bez1. ELSE XWgr = FILL('?', 20). END. IF FIRST-OF ( BArtst.Prod_Grp ) THEN DO: FIND ProdGrp USE-INDEX ProdGrp-k1 WHERE ProdGrp.Firma = GVFirma AND ProdGrp.Wgr = BArtst.Wg_Grp AND ProdGrp.Prod_Grp = BArtst.Prod_Grp NO-LOCK NO-ERROR. IF AVAILABLE ProdGrp THEN XPgr = ProdGrp.Bez1. ELSE XPgr = FILL('?', 20). END. IF FIRST-OF ( BArtst.Art_Grp ) THEN DO: FIND ArtikGrp USE-INDEX ArtikGrp-k1 WHERE ArtikGrp.Firma = GVFirma AND ArtikGrp.Wgr = BArtst.Wg_Grp AND ArtikGrp.Prod_Grp = BArtst.Prod_Grp AND ArtikGrp.Art_Grp = BArtst.Art_Grp NO-LOCK NO-ERROR. IF AVAILABLE ArtikGrp THEN XAgr = ArtikGrp.Bez1. ELSE XAgr = FILL('?', 20). END. IF LAST-OF ( BArtst.Wg_Grp) THEN FLeer = TRUE. IF LAST-OF ( BArtst.Prod_Grp) THEN FLeer = TRUE. IF LAST-OF ( BArtst.Art_Grp) THEN FLeer = TRUE. XStern = ''. IF (ArtLager.Bestand + ArtLager.Bestellt) <= ArtLager.Mind_Bestand THEN XStern = '*'. IF FUnter THEN DO: IF XStern <> '' THEN NEXT. END. RUN LISTTIT2. IF XWgr <> '' AND XWgr BEGINS '-' THEN XWgr = ''. IF XPgr <> '' AND XPgr BEGINS '-' THEN XPgr = ''. IF XAgr <> '' AND XAgr BEGINS '-' THEN XAgr = ''. IF XWgr <> '' THEN DO: VZeile = XWgr. { v8/putzeilf.i "1" } END. IF XPgr <> '' THEN DO: VZeile = XPgr. { v8/putzeilf.i "1" } END. IF XAgr <> '' THEN DO: VZeile = XAgr. { v8/putzeilf.i "1" } END. XWgr = ''. XPGr = ''. XAgr = ''. FIND Artbez USE-INDEX Artbez-k1 WHERE Artbez.Firma = BArtst.Firma AND Artbez.Artnr = BArtst.Artnr AND Artbez.Inhalt = BArtst.Inhalt AND Artbez.Jahr = BArtst.Jahr AND Artbez.Sprcd = 1 NO-LOCK NO-ERROR. FIND KGebinde USE-INDEX KGebinde-k1 WHERE KGebinde.Firma = GVFirma AND KGebinde.Geb_Cd = BArtst.KGeb_Cd NO-LOCK NO-ERROR. FIND VGebinde USE-INDEX VGebinde-k1 WHERE VGebinde.Firma = GVFirma AND VGebinde.Geb_Cd = BArtst.VGeb_Cd NO-LOCK NO-ERROR. FIND GGebinde USE-INDEX GGebinde-k1 WHERE GGebinde.Firma = GVFirma AND GGebinde.Geb_Cd = BArtst.GGeb_Cd NO-LOCK NO-ERROR. SUBSTRING(VZeile,001) = STRING(BArtst.Artnr ,'999999'). SUBSTRING(VZeile,008) = STRING(BArtst.Inhalt ,'9999'). SUBSTRING(VZeile,014) = STRING(ArtBez.Bez1 ,'x(30)'). SUBSTRING(VZeile,046) = STRING(BArtst.Jahr ,'zzzz'). IF BArtst.Alk_Gehalt <> 0 THEN SUBSTRING(VZeile,052) = STRING(BArtst.Alk_Gehalt ,'z9.99'). SUBSTRING(VZeile,059) = STRING(KGebinde.Inhalt ,'zzzz'). SUBSTRING(VZeile,065) = STRING(KGebinde.KBez ,'x(10)'). SUBSTRING(VZeile,077) = STRING(ArtLager.Bestand ,'zzz,zz9-'). SUBSTRING(VZeile,086) = STRING(BArtst.Bestellt ,'zzz,zzz'). SUBSTRING(VZeile,095) = STRING(BArtst.Mind_Bestand,'zzz,zzz'). SUBSTRING(VZeile,103) = STRING(XStern ,'x'). { v8/putzeile.i "1" } IF ArtBez.Bez2 <> '' THEN DO: SUBSTRING(VZeile,014) = STRING(ArtBez.Bez2 ,'x(30)'). { v8/putzeile.i "1" } END. IF FLeer THEN DO: { v8/putzeile.i "1" } FLeer = FALSE. END. IF NOT VBesko THEN NEXT. REPEAT TRANSACTION: FIND LAST Besze USE-INDEX Besze-k1 WHERE Besze.Firma = GVFirma AND Besze.Besnr = VBesnr NO-LOCK NO-ERROR. IF AVAILABLE Besze THEN VPos = Besze.Pos + 10. ELSE VPos = 10. CREATE Besze. ASSIGN Besze.Firma = GVFirma Besze.Besnr = VBesnr Besze.Pos = VPos Besze.Artnr = BArtst.Artnr Besze.Inhalt = BArtst.Inhalt Besze.Jahr = BArtst.Jahr Besze.Bez1 = Artbez.Bez1 Besze.Bez2 = Artbez.Bez2 Besze.Preis = BArtLief.S_Preis Besze.Aktion = FALSE Besze.Lager = iLager Besze.KGeb_Cd = BArtst.KGeb_Cd Besze.VGeb_Cd = BArtst.VGeb_Cd Besze.GGeb_Cd = BArtst.GGeb_Cd Besze.KGebKto = KGebinde.Geb_Kto Besze.VGebKto = VGebinde.Geb_Kto Besze.GGebKto = GGebinde.Geb_Kto Besze.EP = BArtLief.L_EP Besze.S_Artnr = BArtLief.S_Artnr Besze.S_Bez1 = BArtLief.S_Bez1 Besze.S_Bez2 = BArtLief.S_Bez2 Besze.S_Preis = BArtLief.S_Preis Besze.S_Preis_FRW = BArtLief.S_Preis_FRW Besze.L_EP = BArtLief.L_EP Besze.L_EP_FRW = BArtLief.L_EP_FRW Besze.L_Rabatt = BArtLief.L_Rabatt Besze.Spesen = BArtLief.Spesen Besze.Rabatt = BArtLief.Rabatt. LEAVE. END. END. /* REPEAT */ TiDruck = TRUE. IF DOpen = TRUE THEN DO: OUTPUT CLOSE. END. ELSE DO: RUN "v8/d-liste.w" ( INPUT Helptext[02] ). END. END. /* Kopien */ END. /* DO PRESELECT */ APPLY 'CHOOSE' TO Btn_Ende IN FRAME {&FRAME-NAME}. RETURN NO-APPLY. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE EXCEL B-table-Win PROCEDURE EXCEL : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ /* DEF VAR FileName AS CHAR NO-UNDO. DEF VAR ok AS LOG NO-UNDO. DEF VAR VPG AS INT EXTENT 20 NO-UNDO. DEF VAR VMax AS INT NO-UNDO. DEF VAR XPreisgrp AS CHAR NO-UNDO. DEF VAR XWgr AS CHAR NO-UNDO. DEF VAR XPro AS CHAR NO-UNDO. DEF VAR XAgr AS CHAR NO-UNDO. FileName = SESSION:TEMP-DIR + 'Artikel.csv'. SYSTEM-DIALOG GET-FILE FileName CREATE-TEST-FILE INITIAL-DIR SESSION:TEMP-DIR TITLE 'Dateiname für den Export' USE-FILENAME UPDATE ok. IF NOT ok THEN RETURN. DISABLE Btn_Excel WITH FRAME {&FRAME-NAME}. DISABLE Btn_Start WITH FRAME {&FRAME-NAME}. DISABLE Btn_Ende WITH FRAME {&FRAME-NAME}. DO TRANSACTION WITH FRAME {&FRAME-NAME}: ASSIGN {&List-1}. iLager = INTEGER(CB_Lager:SCREEN-VALUE). FIND Listen WHERE RECID(Listen) = ARecid. FIND LiDruck WHERE RECID(LiDruck) = BRecid. ASSIGN Breite = F_Zeichen Listen.Sort = F_Sort Listen.ProgWahl = F_Sort LiDruck.Listtzz = F_TZZ LiDruck.Listkzz = F_KZZ LiDruck.Listfzz = F_FZZ LiDruck.Listlq = F_LQ LiDruck.ListCopy = F_KOPIE LiDruck.Schacht = F_SCHACHT LiDruck.Listdru = XSchrift.Schname LiDruck.Listbild = Schrift.Schbild. IF LiDruck.ListCopy = 0 THEN LiDruck.ListCopy = 1. ASSIGN {&List-2}. IF VNr[01] = 0 AND BNr[01] = 0 THEN BNr[01] = 999999. IF VNr[01] > BNr[01] THEN BNr[01] = VNr[01]. IF VNr[02] = 0 AND BNr[02] = 0 THEN BNr[02] = 99. IF VNr[02] > BNr[02] THEN BNr[02] = VNr[02]. IF VNr[03] = 0 AND BNr[03] = 0 THEN BNr[03] = 99. IF VNr[03] > BNr[03] THEN BNr[03] = VNr[03]. DISPLAY {&List-2} WITH FRAME {&FRAME-NAME}. ASSIGN LiDruck.ProgWahl = Listen.ProgWahl LiDruck.Listprog = TRIM(F_Programm) + STRING(Listen.ProgWahl,'99'). RELEASE Listen . RELEASE LiDruck. END. FIND Listen WHERE RECID(Listen) = ARecid NO-LOCK. FIND LiDruck WHERE RECID(LiDruck) = BRecid NO-LOCK. FIND Steuer WHERE Steuer.Firma = GVFirma NO-LOCK NO-ERROR. VSort = Listen.Sort. VArtnr = Listen.VNr[01]. BArtnr = Listen.BNr[01]. VWgr = Listen.VNr[02]. BWgr = Listen.BNr[02]. VPreis_Grp = Listen.VNr[03]. BPreis_Grp = Listen.BNr[03]. FExklusive = Listen.VFl[01]. VPG = 0. VMax = 0. XpreisGrp = ''. FOR EACH Tabel USE-INDEX Tabel-k1 WHERE Tabel.Firma = GVFirma AND Tabel.RecArt = 'PREGRP' AND Tabel.CodeC = '' AND Tabel.Sprcd = 0 NO-LOCK: VMax = VMax + 1. VPG[VMax] = Tabel.CodeI. XPreisGrp = XPreisGrp + Tabel.Bez1 + ";". END. /* ---------------------------------------------------------------------- */ /* Sort Artikelnummer */ /* ---------------------------------------------------------------------- */ IF VSort = 1 THEN DO: OUTPUT TO VALUE(FileName). PUT CONTROL 'Artnr' ";" 'Inhalt' ";" 'Jahr' ";" 'Suchbe' ";" 'Bez1' ";" 'Bez2' ";" 'Kleingebinde' ";" 'Verkaufsgebinde' ";" 'Grossgebinde' ";" 'WarenGrp' ";" 'ProdukteGrp' ";" 'ArtikelGrp' ";" 'RabattGrp' ";" 'BonusGrp' ";" 'Region' ";" 'Farbe' ";" 'Traubensorte' ";" 'Leihartikel' ";" 'Lagerhaltung' ";" 'Skontober' ";" 'Netto' ";" 'MWST' ";" 'Gewicht' ";" 'AlkoholGeh' ";" 'Konto' ";" 'Herkunfstland' ";" 'Strichcode' ";" 'WHK_Code' ";" 'Ausverkauft' ";" 'Min.Marge' ";" 'Preisliste' ";" 'Bestand' ";" XPreisGrp ";" 'Lager' CHR(10). FOR EACH BArtst USE-INDEX Artst-k1 WHERE BArtst.Firma = GVFirma AND BArtst.Artnr >= VArtnr AND BArtst.Artnr <= BArtnr AND BArtst.Wg_Grp >= VWgr AND BArtst.Wg_Grp <= BWgr AND BArtst.Aktiv = TRUE NO-LOCK, FIRST ArtLager NO-LOCK WHERE ArtLager.Firma = BArtst.Firma AND ArtLager.Artnr = BArtst.Artnr AND ArtLager.Inhalt = BArtst.Inhalt AND ArtLager.Jahr = BArtst.Jahr AND ArtLager.Lager = iLager BREAK BY BArtst.Wg_Grp BY BArtst.Prod_Grp BY BArtst.Art_Grp BY BArtst.Artnr BY BArtst.Inhalt BY BArtst.Jahr : i5 = 0. IF FIRST-OF ( BArtst.Wg_Grp ) THEN DO: FIND WarenGrp USE-INDEX WarenGrp-k1 WHERE WarenGrp.Firma = GVFirma AND WarenGrp.Wgr = BArtst.Wg_Grp NO-LOCK NO-ERROR. IF AVAILABLE WarenGrp THEN VZeile = WarenGrp.Bez1. ELSE VZeile = FILL('?', 20). PUT CONTROL VZeile CHR(10). XWgr = STRING(BArtst.Wg_Grp,"999 ") + VZeile. i5 = 1. END. IF FIRST-OF ( BArtst.Prod_Grp ) THEN DO: FIND ProdGrp USE-INDEX ProdGrp-k1 WHERE ProdGrp.Firma = GVFirma AND ProdGrp.Wgr = BArtst.Wg_Grp AND ProdGrp.Prod_Grp = BArtst.Prod_Grp NO-LOCK NO-ERROR. IF AVAILABLE ProdGrp THEN VZeile = ProdGrp.Bez1. ELSE VZeile = FILL('?', 20). PUT CONTROL VZeile CHR(10). XPro = STRING(BArtst.Prod_Grp,"999 ") + VZeile. i5 = 2. END. IF FIRST-OF ( BArtst.Art_Grp ) THEN DO: FIND ArtikGrp USE-INDEX ArtikGrp-k1 WHERE ArtikGrp.Firma = GVFirma AND ArtikGrp.Wgr = BArtst.Wg_Grp AND ArtikGrp.Prod_Grp = BArtst.Prod_Grp AND ArtikGrp.Art_Grp = BArtst.Art_Grp NO-LOCK NO-ERROR. IF AVAILABLE ArtikGrp THEN VZeile = ArtikGrp.Bez1. ELSE VZeile = FILL('?', 20). IF VZeile BEGINS "-" THEN VZeile = ''. PUT CONTROL VZeile CHR(10). XAgr = STRING(BArtst.Art_Grp,"999 ") + VZeile. i5 = 3. END. VZeile = ''. IF i5 > 0 THEN DO: PUT CONTROL CHR(10). i5 = 0. END. FIND Artbez USE-INDEX Artbez-k1 WHERE Artbez.Firma = BArtst.Firma AND Artbez.Artnr = BArtst.Artnr AND Artbez.Inhalt = BArtst.Inhalt AND Artbez.Jahr = BArtst.Jahr AND Artbez.Sprcd = 1 NO-LOCK. PUT CONTROL STRING(BArtst.Artnr ,"999999") ";" STRING(BArtst.Inhalt ,"9999") ";" STRING(BArtst.Jahr ,"9999") ";" BArtst.Suchbe ";" Artbez.Bez1 ";" Artbez.Bez2 ";" BArtst.KGeb_Cd ";" BArtst.VGeb_Cd ";" BArtst.GGeb_Cd ";" XWgr ";" XPro ";" XAgr ";" STRING(BArtst.Rab_Grp ,"999") ";" STRING(BArtst.Bonus_Grp ,"999") ";" STRING(BArtst.Reg_Grp ,"999") ";" STRING(BArtst.Farbe ,"999") ";" STRING(BArtst.Traub_Grp ,"999") ";" STRING(BArtst.Leih_Art ,"J/N") ";" STRING(BArtst.Lager ,"J/N") ";" STRING(BArtst.Sk_Ber ,"J/N") ";" STRING(BArtst.Netto ,"J/N") ";" STRING(BArtst.WC ,"99") ";" STRING(BArtst.Gewicht ,"zzz9.999") ";" STRING(BArtst.Alk_Gehalt,"zz9.999") ";" BArtst.Konto ";" BArtst.Herk_Lkz ";" BArtst.Strichcode ";" BArtst.WHK_Code ";" STRING(BArtst.Ausverk ,"9") ";" STRING(BArtst.Min_Marge ,"zz9.99") ";" STRING(BArtst.Preisliste,"J/N") ";" STRING(ArtLager.Bestand ,"zzz,zz9") ";". DO ix = 1 TO VMax: FIND LAST ArtPreis USE-INDEX ArtPreis-k1 WHERE ArtPreis.Firma = BArtst.Firma AND ArtPreis.Artnr = BArtst.Artnr AND ArtPreis.Inhalt = BArtst.Inhalt AND ArtPreis.Jahr = BArtst.Jahr AND ArtPreis.Preis_Grp = VPG[ix] AND ArtPreis.Aktion = FALSE AND ArtPreis.Ab_Datum <= TODAY NO-LOCK NO-ERROR. Rundbetr = 0. IF AVAILABLE ArtPreis THEN DO: IF FExklusive THEN Rundbetr = ArtPreis.VK_Netto. ELSE Rundbetr = ArtPreis.VK_Brutto. END. PUT CONTROL STRING(Rundbetr ,"zz,zz9.999") ";". END. PUT CONTROL TRIM(STRING(ArtLager.Lager,'>>9')). PUT CONTROL CHR(10). IF LAST-OF ( BArtst.Art_Grp ) THEN DO: PUT CONTROL CHR(10) CHR(10). END. END. /* FOR EACH */ OUTPUT CLOSE. END. /* Sort Artikelnummer */ ENABLE Btn_Excel WITH FRAME {&FRAME-NAME}. ENABLE Btn_Start WITH FRAME {&FRAME-NAME}. ENABLE Btn_Ende WITH FRAME {&FRAME-NAME}. APPLY 'CHOOSE' TO Btn_Ende IN FRAME {&FRAME-NAME}. RETURN NO-APPLY. */ END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE LIBILD B-table-Win PROCEDURE LIBILD : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ { v8/libild.i } END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE LISTTIT1 B-table-Win PROCEDURE LISTTIT1 : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ { v8/listtit1.i } END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE LISTTIT2 B-table-Win PROCEDURE LISTTIT2 : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ { v8/listtit2.i } END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-display-fields B-table-Win PROCEDURE local-display-fields : /*------------------------------------------------------------------------------ Purpose: Override standard ADM method Notes: ------------------------------------------------------------------------------*/ RUN dispatch IN THIS-PROCEDURE ( INPUT 'display-fields':U ) . DISPLAY {&List-1} WITH FRAME {&FRAME-NAME}. IF ARecid > -1 THEN DO: FIND Listen WHERE RECID(Listen) = ARecid NO-LOCK. DISPLAY {&List-2} WITH FRAME {&FRAME-NAME}. END. ENABLE {&List-2} WITH FRAME {&FRAME-NAME}. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-hide B-table-Win PROCEDURE local-hide : /*------------------------------------------------------------------------------ Purpose: Override standard ADM method Notes: ------------------------------------------------------------------------------*/ DO TRANSACTION: FIND Listen WHERE RECID(Listen) = ARecid. Listen.Listfl = ''. END. RUN dispatch IN THIS-PROCEDURE ( INPUT 'hide':U ) . END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-initialize B-table-Win PROCEDURE local-initialize : /*------------------------------------------------------------------------------ Purpose: Override standard ADM method Notes: ------------------------------------------------------------------------------*/ DEFINE BUFFER BListen FOR Listen. DEFINE VARIABLE VListnr LIKE Listen.Listnr. DEFINE VARIABLE VRecid AS RECID. F_USER = DYNAMIC-FUNCTION('getDBUser':U) NO-ERROR. QOpen = FALSE. FInit = TRUE. FOpen = FALSE. DO WITH FRAME {&FRAME-NAME}: iLager = DYNAMIC-FUNCTION('getBenLager':U) NO-ERROR. RUN COMBO_LAGER ( CB_Lager:HANDLE ). CB_Lager:SCREEN-VALUE = STRING(iLager,'999999'). END. RUN dispatch IN THIS-PROCEDURE ( INPUT 'initialize':U ) . RUN OPEN_XSCHRIFT. VProgname = TRIM(F_USER) + '!' + TRIM(F_Programm). FIND FIRST Listen USE-INDEX Listen-k1 WHERE Listen.Firma = GVFirma AND Listen.Progname = VProgname AND Listen.Listfl = '' NO-LOCK NO-ERROR. REPEAT TRANSACTION: IF NOT AVAILABLE Listen THEN DO: FIND LAST BListen USE-INDEX Listen-k1 WHERE BListen.Firma = GVFirma NO-LOCK NO-ERROR. IF AVAILABLE BListen THEN VListnr = BListen.Listnr + 1. ELSE VListnr = 1. CREATE Listen. ASSIGN Listen.Firma = GVFirma Listen.Listnr = VListnr Listen.Progname = VProgname Listen.Listfl = '' Listen.Jahr = GVJahr Listen.Sprcd = GVSprcd Listen.Sort = 1 Listen.ProgWahl = 1. END. ARecid = RECID(Listen). FIND LiDruck USE-INDEX LiDruck-k1 WHERE LiDruck.Firma = GVFirma AND LiDruck.Listnr = Listen.Listnr AND LiDruck.ProgWahl = Listen.ProgWahl NO-LOCK NO-ERROR. IF NOT AVAILABLE LiDruck THEN DO: CREATE LiDruck. ASSIGN LiDruck.Firma = GVFirma LiDruck.Listnr = Listen.Listnr LiDruck.ProgWahl = Listen.ProgWahl LiDruck.Listprog = TRIM(F_Programm) + STRING(Listen.ProgWahl,'99') LiDruck.ListCopy = 1 LiDruck.Schacht = 0 LiDruck.Listlq = FALSE. END. BRecid = RECID(LiDruck). FIND Listen WHERE RECID(Listen) = ARecid. Listen.Listfl = 'A'. RELEASE Listen. RELEASE LiDruck. LEAVE. END. /* TRANSACTION */ FIND Listen WHERE RECID(Listen) = ARecid NO-LOCK. FIND LiDruck WHERE RECID(LiDruck) = BRecid NO-LOCK. FOpen = TRUE. ASchname = LiDruck.ListDru. ASchbild = LiDruck.ListBild. DO WHILE TRUE WITH FRAME {&FRAME-NAME}: IF NUM-RESULTS('Br_Druckername':U) = ? THEN LEAVE. IF NUM-RESULTS('Br_Druckername':U) = 0 THEN LEAVE. FIND FIRST XSchrift WHERE XSchrift.Schname = ASchname NO-LOCK NO-ERROR. IF AVAILABLE XSchrift THEN VRecid = RECID(XSchrift). ELSE DO: GET FIRST Br_Druckername. VRecid = RECID(XSchrift). END. REPOSITION Br_Druckername TO RECID(VRecid). ASchname = XSchrift.Schname. RUN dispatch IN THIS-PROCEDURE ('open-query':U). IF NUM-RESULTS('Br_Schriftbild':U) = ? THEN LEAVE. IF NUM-RESULTS('Br_Schriftbild':U) = 0 THEN LEAVE. FIND FIRST BSchrift WHERE BSchrift.Schname = ASchname AND BSchrift.Schbild = ASchbild NO-LOCK NO-ERROR. IF AVAILABLE BSchrift THEN VRecid = RECID(BSchrift). ELSE DO: GET FIRST Br_Schriftbild. VRecid = RECID(Schrift). END. REPOSITION Br_Schriftbild TO RECID(VRecid). ASchbild = Schrift.Schbild. LEAVE. END. RUN LIBILD. F_Zeichen = Breite. F_Sort = Listen.Sort. F_TZZ = LiDruck.Listtzz. F_KZZ = LiDruck.Listkzz. F_FZZ = LiDruck.Listfzz. F_LQ = LiDruck.Listlq. F_KOPIE = LiDruck.ListCopy. F_SCHACHT = LiDruck.Schacht. OBreite = Breite. RUN dispatch IN THIS-PROCEDURE ('display-fields':U). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-open-query B-table-Win PROCEDURE local-open-query : /*------------------------------------------------------------------------------ Purpose: Override standard ADM method Notes: ------------------------------------------------------------------------------*/ IF FOpen = FALSE THEN RETURN NO-APPLY. DO WITH FRAME {&FRAME-NAME}: IF QOpen = TRUE THEN DO: CLOSE QUERY Br_Schriftbild. END. QOpen = FALSE. OPEN QUERY Br_Schriftbild FOR EACH Schrift USE-INDEX Schrift-k1 WHERE Schrift.Schname = ASchname NO-LOCK. Br_Schriftbild:SET-REPOSITIONED-ROW(6, "ALWAYS"). QOpen = TRUE. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-row-changed B-table-Win PROCEDURE local-row-changed : /*------------------------------------------------------------------------------ Purpose: Override standard ADM method Notes: ------------------------------------------------------------------------------*/ RUN dispatch IN THIS-PROCEDURE ( INPUT 'row-changed':U ) . OPEN QUERY Br_Schriftbild FOR EACH Schrift WHERE Schrift.Schname = XSchrift.Schname NO-LOCK. IF AVAILABLE LiDruck THEN DO: FIND BSchrift WHERE BSchrift.Schname = LiDruck.ListDru AND BSchrift.Schbild = LiDruck.ListBild NO-LOCK NO-ERROR. IF AVAILABLE BSchrift THEN DO: REPOSITION Br_Schriftbild TO RECID RECID(BSchrift) NO-ERROR. END. END. APPLY 'VALUE-CHANGED' TO BROWSE Br_Schriftbild. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-view B-table-Win PROCEDURE local-view : /*------------------------------------------------------------------------------ Purpose: Override standard ADM method Notes: ------------------------------------------------------------------------------*/ RUN dispatch IN THIS-PROCEDURE ( INPUT 'view':U ) . IF ARecid < 0 THEN RETURN. FIND Listen WHERE RECID(Listen) = ARecid NO-LOCK. RUN dispatch IN THIS-PROCEDURE ('display-fields':U). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE OPEN_XSCHRIFT B-table-Win PROCEDURE OPEN_XSCHRIFT : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DO WITH FRAME {&FRAME-NAME}: FOR EACH XSchrift: DELETE XSchrift. END. AltSchname = ''. FOR EACH Schrift NO-LOCK: IF Schrift.Schname = AltSchname THEN NEXT. CREATE XSchrift. BUFFER-COPY Schrift TO XSchrift. AltSchname = Schrift.Schname. END. OPEN QUERY Br_Druckername FOR EACH XSchrift NO-LOCK. Br_Druckername:SET-REPOSITIONED-ROW(6, "ALWAYS"). END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records B-table-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 "Schrift"} {src/adm/template/snd-list.i "XSchrift"} /* 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 B-table-Win PROCEDURE state-changed : /* ----------------------------------------------------------- Purpose: Parameters: Notes: -------------------------------------------------------------*/ DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE NO-UNDO. DEFINE INPUT PARAMETER p-state AS CHARACTER NO-UNDO. CASE p-state: /* Object instance CASEs can go here to replace standard behavior or add new cases. */ {src/adm/template/bstates.i} END CASE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME