&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI ADM2 /* Procedure Description "This SmartPanel sends navigation messages to its NAVIGATION-TARGET. Its buttons have icons and are arranged horizontally." */ &ANALYZE-RESUME &Scoped-define WINDOW-NAME CURRENT-WINDOW &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS P-Win /********************************************************************* * Copyright (C) 2000 by Progress Software Corporation ("PSC"), * * 14 Oak Park, Bedford, MA 01730, and other contributors as listed * * below. All Rights Reserved. * * * * The Initial Developer of the Original Code is PSC. The Original * * Code is Progress IDE code released to open source December 1, 2000.* * * * The contents of this file are subject to the Possenet Public * * License Version 1.0 (the "License"); you may not use this file * * except in compliance with the License. A copy of the License is * * available as of the date of this notice at * * http://www.possenet.org/license.html * * * * Software distributed under the License is distributed on an "AS IS"* * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. You* * should refer to the License for the specific language governing * * rights and limitations under the License. * * * * Contributors: * * * *********************************************************************/ /*------------------------------------------------------------------------ File: adm2/dyntoolbar.w Description: SmartToolbar object Input Parameters: Output Parameters: Created: April 1999 -- Progress Version 9.1A ------------------------------------------------------------------------*/ /* This .W file was created with the Progress AppBuilder. */ /*----------------------------------------------------------------------*/ /* Create an unnamed pool to store all the widgets created by this procedure. This is a good default which assures that this procedure's triggers and internal procedures will execute in this procedure's storage, and that proper cleanup will occur on deletion of the procedure. */ CREATE WIDGET-POOL. /* *************************** Definitions ************************** */ /* Parameters Definitions --- */ &GLOB ADM-Panel-Type Toolbar /* tell smart.i that we can use the default destroyObject */ &SCOPED-DEFINE include-destroyobject /* Local Variable Definitions --- */ DEFINE VARIABLE ghMenu AS HANDLE NO-UNDO. DEFINE VARIABLE glResetRecord AS LOG NO-UNDO INIT FALSE. DEFINE VARIABLE FMutFlag AS LOG NO-UNDO INIT FALSE. DEFINE VARIABLE ProgName AS CHARACTER NO-UNDO. DEFINE VARIABLE Firma AS CHARACTER NO-UNDO. DEFINE TEMP-TABLE TView FIELD cView AS CHARACTER FIELD Aktiv AS LOG FIELD fA AS LOG FIELD fM AS LOG FIELD fE AS LOG FIELD fL AS LOG FIELD fS AS LOG INDEX TView-k1 AS PRIMARY cView. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK /* ******************** Preprocessor Definitions ******************** */ &Scoped-define PROCEDURE-TYPE toolbar &Scoped-define DB-AWARE no &Scoped-define ADM-SUPPORTED-LINKS Navigation-Source,TableIo-Source /* Name of designated FRAME-NAME and/or first browse and/or first query */ &Scoped-define FRAME-NAME Panel-Frame /* Custom List Definitions */ /* Box-Rectangle,List-2,List-3,List-4,List-5,List-6 */ /* _UIB-PREPROCESSOR-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Prototypes ********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD AssignBezeichnung P-Win FUNCTION AssignBezeichnung RETURNS LOGICAL ( ipFunkt AS CHARACTER, ipText AS CHARACTER ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD initializeMenu P-Win FUNCTION initializeMenu RETURNS LOGICAL ( ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD initializeToolBar P-Win FUNCTION initializeToolBar RETURNS LOGICAL ( /* parameter-definitions */ ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********************** Control Definitions ********************** */ /* ************************ Frame Definitions *********************** */ DEFINE FRAME Panel-Frame WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY SIDE-LABELS NO-UNDERLINE THREE-D AT COL 1 ROW 1 SIZE 67.2 BY 1.57. /* *********************** Procedure Settings ************************ */ &ANALYZE-SUSPEND _PROCEDURE-SETTINGS /* Settings for THIS-PROCEDURE Type: toolbar Allow: Basic Frames: 1 Add Fields to: Neither Other Settings: PERSISTENT-ONLY COMPILE */ /* 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 P-Win ASSIGN HEIGHT = 1.57 WIDTH = 67.2. /* END WINDOW DEFINITION */ */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB P-Win /* ************************* Included-Libraries *********************** */ {src/adm2/toolbar.i} /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********** Runtime Attributes and AppBuilder Settings *********** */ &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES /* SETTINGS FOR WINDOW P-Win NOT-VISIBLE,,RUN-PERSISTENT */ /* SETTINGS FOR FRAME Panel-Frame NOT-VISIBLE FRAME-NAME Size-to-Fit */ ASSIGN FRAME Panel-Frame:SCROLLABLE = FALSE FRAME Panel-Frame:HIDDEN = TRUE. /* _RUN-TIME-ATTRIBUTES-END */ &ANALYZE-RESUME /* Setting information for Queries and Browse Widgets fields */ &ANALYZE-SUSPEND _QUERY-BLOCK FRAME Panel-Frame /* Query rebuild information for FRAME Panel-Frame _Options = "NO-LOCK" _Query is NOT OPENED */ /* FRAME Panel-Frame */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK P-Win /* *************************** Main Block *************************** */ EMPTY TEMP-TABLE TView. Progname = DYNAMIC-FUNCTION('makeProgname':U, THIS-PROCEDURE:FILE-NAME ) NO-ERROR. &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN RUN initializeObject. &ENDIF /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ********************** Internal Procedures *********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI P-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 Panel-Frame. IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE getWindowName P-Win PROCEDURE getWindowName : /** * @desc Procedure to retrieve the filename of the window (wxxxxx.w) * @returns file-name Filename of windowprocedure */ DEFINE VARIABLE hWin AS HANDLE NO-UNDO. ASSIGN hwin = DYNAMIC-FUNCTION('getContainerSource':U). RETURN hWin:FILE-NAME. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE onChoose P-Win PROCEDURE onChoose : /*------------------------------------------------------------------------------ Purpose: Super Override Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER pcAction AS CHARACTER NO-UNDO. DEFINE VARIABLE wHandle AS HANDLE NO-UNDO. DEFINE VARIABLE cTableIO AS CHARACTER NO-UNDO. DEFINE VARIABLE hTableIO AS HANDLE NO-UNDO. DEFINE VARIABLE hSource AS HANDLE NO-UNDO. DEFINE VARIABLE cFields AS CHARACTER NO-UNDO. DEFINE VARIABLE cValues AS CHARACTER NO-UNDO. DEFINE VARIABLE cQueryPos AS CHARACTER NO-UNDO. DEFINE VARIABLE iAktiv AS INTEGER NO-UNDO. DEFINE VARIABLE iFehler AS INTEGER NO-UNDO. DEFINE VARIABLE fAktiv AS LOG NO-UNDO. DEFINE VARIABLE FAbbruch AS LOG NO-UNDO. DEFINE VARIABLE Ja AS LOG NO-UNDO. DEFINE VARIABLE cTabelle AS CHARACTER NO-UNDO. DEFINE VARIABLE hFocus AS HANDLE NO-UNDO. DEFINE VARIABLE cView AS CHARACTER NO-UNDO. DEFINE VARIABLE cBerecht AS CHARACTER NO-UNDO. DEFINE VARIABLE fNavi AS LOG NO-UNDO. DEFINE VARIABLE cAction AS CHARACTER NO-UNDO. wHandle = FOCUS:PARENT NO-ERROR. DO WHILE VALID-HANDLE( wHandle ): IF wHandle:TYPE = 'WINDOW' THEN LEAVE. wHandle = wHandle:PARENT. END. fNavi = FALSE. IF pcAction = 'Next' THEN fNavi = TRUE. IF pcAction = 'Prev' THEN fNavi = TRUE. IF pcAction = 'First' THEN fNavi = TRUE. IF pcAction = 'Last' THEN fNavi = TRUE. IF fNavi THEN DO: cAction = SUBSTITUTE('ACTION-&1', pcAction). END. DO WHILE TRUE: IF fNavi THEN LEAVE. cTableIO = DYNAMIC-FUNCTION('getTableIOTarget':U) NO-ERROR. IF cTableIO = ? OR cTableIO = '' THEN DO: RUN MELDUNG ( 8014 ). RETURN. END. hTableIO = WIDGET-HANDLE(cTableIO) NO-ERROR. IF NOT VALID-HANDLE(hTableIO) THEN RETURN. LEAVE. END. FMutFlag = DYNAMIC-FUNCTION('getMutflag':U, INPUT Progname ) NO-ERROR. DO WHILE FMutFlag: IF fNavi THEN RETURN NO-APPLY. IF pcAction = 'ADD' THEN RETURN NO-APPLY. IF pcAction = 'COPY' THEN RETURN NO-APPLY. IF pcAction = 'DELETE' THEN RETURN NO-APPLY. LEAVE. END. DO WHILE NOT FMutFlag: IF pcAction = 'SAVE' THEN RETURN NO-APPLY. IF pcAction = 'UNDO' THEN RETURN NO-APPLY. IF pcAction = 'CANCEL' THEN RETURN NO-APPLY. LEAVE. END. IF NOT fNavi THEN DO: cView = ENTRY(1, hTableIO:FILE-NAME, '.'). FIND FIRST TView USE-INDEX TView-k1 WHERE TView.cView = cView NO-LOCK NO-ERROR. IF NOT AVAILABLE TView THEN DO: RUN PRUEFEN_BERECHTIGUNG ( INPUT cView, OUTPUT cBerecht ) NO-ERROR. CREATE TView. TView.cView = cView. IF ENTRY(1, cBerecht, CHR(01)) BEGINS 'j' THEN TView.fA = TRUE . ELSE TView.fA = FALSE. IF ENTRY(2, cBerecht, CHR(01)) BEGINS 'j' THEN TView.fM = TRUE . ELSE TView.fM = FALSE. IF ENTRY(3, cBerecht, CHR(01)) BEGINS 'j' THEN TView.fE = TRUE . ELSE TView.fE = FALSE. IF ENTRY(4, cBerecht, CHR(01)) BEGINS 'j' THEN TView.fL = TRUE . ELSE TView.fL = FALSE. IF ENTRY(5, cBerecht, CHR(01)) BEGINS 'j' THEN TView.fS = TRUE . ELSE TView.fS = FALSE. IF TView.fA = FALSE AND TView.fM = FALSE AND TView.fE = FALSE AND TView.fL = FALSE AND TView.fS = FALSE THEN TView.Aktiv = FALSE. ELSE TView.Aktiv = TRUE . END. IF NOT TView.Aktiv THEN RETURN NO-APPLY. END. DO WHILE NOT FMutFlag: CASE pcAction: WHEN 'ADD' THEN DO: IF TView.fE = FALSE THEN RETURN NO-APPLY. END. WHEN 'COPY' THEN DO: IF TView.fE = FALSE THEN RETURN NO-APPLY. END. WHEN 'DELETE' THEN DO: IF TView.fL = FALSE THEN RETURN NO-APPLY. END. WHEN 'UPDATE' THEN DO: IF TView.fM = FALSE THEN RETURN NO-APPLY. END. END. LEAVE. END. DO WHILE TRUE: IF FMutFlag THEN LEAVE. IF pcAction = 'Next' THEN LEAVE. IF pcAction = 'Prev' THEN LEAVE. IF pcAction = 'First' THEN LEAVE. IF pcAction = 'Last' THEN LEAVE. IF pcAction = 'ADD' THEN LEAVE. IF pcAction = 'CANCEL' THEN LEAVE. hSource = DYNAMIC-FUNCTION('getTableIOTarget':U) NO-ERROR. IF NOT VALID-HANDLE(hSource) THEN LEAVE. hSource = DYNAMIC-FUNCTION('getDataSource':U IN hSource) NO-ERROR. IF NOT VALID-HANDLE(hSource) THEN LEAVE. cQueryPos = DYNAMIC-FUNCTION('getQueryPosition':U IN hSource) NO-ERROR. IF cQueryPos = 'NoRecordAvailable' THEN DO: RUN MELDUNG (8009) NO-ERROR. IF VALID-HANDLE(wHandle) THEN APPLY 'U1' TO wHandle. RETURN NO-APPLY. END. cFields = DYNAMIC-FUNCTION('getDataColumns':U IN hSource ) NO-ERROR. iAktiv = LOOKUP('Aktiv', cFields, ','). IF iAktiv = 0 THEN LEAVE. IF hSource:NAME BEGINS 'd-benutzer' THEN LEAVE. cValues = DYNAMIC-FUNCTION('colValues':U IN hSource, 'Aktiv') NO-ERROR. IF NOT ENTRY(2, cValues, CHR(01)) BEGINS 'n' THEN fAktiv = TRUE. ELSE fAktiv = FALSE. IF fAktiv AND pcAction <> 'DELETE' THEN LEAVE. IF NOT fAktiv AND pcAction = 'DELETE' THEN RETURN NO-APPLY. IF fAktiv THEN iFehler = 8010. ELSE iFehler = 8011. ja = DYNAMIC-FUNCTION('ANTWORT_NEIN':U, INPUT iFehler ) NO-ERROR. IF NOT Ja THEN RETURN NO-APPLY. cTabelle = DYNAMIC-FUNCTION('getTables':U IN hSource) NO-ERROR. IF cTabelle = ? THEN RETURN NO-APPLY. IF cTabelle = '' THEN RETURN NO-APPLY. IF INDEX(cTabelle, 'Adresse') > 0 THEN LEAVE. IF TView.fE = FALSE THEN RETURN NO-APPLY. IF fAktiv THEN RUN INAKTIVIEREN IN hSource NO-ERROR. ELSE RUN REAKTIVIEREN IN hSource NO-ERROR. IF RETURN-VALUE = 'LOESCHEN' THEN LEAVE. RETURN NO-APPLY. END. CASE pcAction: WHEN 'SAVE' THEN DO: hFocus = FOCUS. DO WHILE VALID-HANDLE(hFocus): IF hFocus:TYPE <> 'FILL-IN' AND hFocus:TYPE <> 'COMBO-BOX' THEN LEAVE. APPLY 'LEAVE' TO hFocus. LEAVE. END. IF VALID-HANDLE(hTableIO) THEN DO: ERROR-STATUS:ERROR = FALSE. RUN TEST_EINGABEN IN hTableIO ( OUTPUT Ja ) NO-ERROR. IF ERROR-STATUS:ERROR THEN Ja = TRUE. END. IF NOT Ja THEN RETURN NO-APPLY. END. END CASE. DYNAMIC-FUNCTION('setFlagabbruch':U, INPUT FALSE, INPUT Progname) NO-ERROR. RUN SUPER( INPUT pcAction ). FAbbruch = DYNAMIC-FUNCTION('getFlagabbruch':U, INPUT Progname) NO-ERROR. IF FAbbruch THEN DO: DYNAMIC-FUNCTION('setFlagabbruch':U, INPUT FALSE, INPUT Progname) NO-ERROR. IF pcAction = 'SAVE' THEN RETURN. pcAction = 'CANCEL'. RUN SUPER ( INPUT pcAction ). END. CASE pcAction: WHEN 'ADD' THEN DYNAMIC-FUNCTION('setMutFlag':U, INPUT TRUE , INPUT Progname) NO-ERROR. WHEN 'COPY' THEN DYNAMIC-FUNCTION('setMutFlag':U, INPUT TRUE , INPUT Progname) NO-ERROR. WHEN 'UPDATE' THEN DYNAMIC-FUNCTION('setMutFlag':U, INPUT TRUE , INPUT Progname) NO-ERROR. WHEN 'SAVE' THEN DYNAMIC-FUNCTION('setMutFlag':U, INPUT FALSE, INPUT Progname) NO-ERROR. WHEN 'UNDO' THEN DYNAMIC-FUNCTION('setMutFlag':U, INPUT TRUE , INPUT Progname) NO-ERROR. WHEN 'CANCEL' THEN DYNAMIC-FUNCTION('setMutFlag':U, INPUT FALSE, INPUT Progname) NO-ERROR. END CASE. CASE pcAction: WHEN 'ADD' OR WHEN 'COPY' OR WHEN 'UPDATE' THEN DYNAMIC-FUNCTION('sensitizeActions':U, 'SAVE,RESET,UndoChange', TRUE) NO-ERROR. END CASE. PUBLISH 'NAVIGATION' ( INPUT cAction ). IF VALID-HANDLE(wHandle) THEN APPLY 'U1' TO wHandle. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setBreite P-Win PROCEDURE setBreite : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipBreite AS DECIMAL NO-UNDO. DO WITH FRAME {&FRAME-NAME}: RUN resizeObject ( INPUT 20, INPUT ipBreite ). END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setProgname P-Win PROCEDURE setProgname : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipProgramm AS CHARACTER NO-UNDO. DEFINE VARIABLE cProgramm AS CHARACTER NO-UNDO. cProgramm = ENTRY(1, ipProgramm, '.') NO-ERROR. IF cProgramm = ? OR cProgramm = '' THEN cProgramm = ipProgramm. Progname = cProgramm. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Implementations ***************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION AssignBezeichnung P-Win FUNCTION AssignBezeichnung RETURNS LOGICAL ( ipFunkt AS CHARACTER, ipText AS CHARACTER ) : /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ DYNAMIC-FUNCTION('assignActionCaption':U, ipFunkt, ipText) NO-ERROR. RETURN (IF ERROR-STATUS:ERROR THEN FALSE ELSE TRUE). END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION initializeMenu P-Win FUNCTION initializeMenu RETURNS LOGICAL ( ) : /*------------------------------------------------------------------------------ Purpose: Create the menus for the toolbar Notes: This function is defined locally, but will skip the default behavior if there is a super defined AND it returns true. buildMenu() is always called! so it should not be part of the super procedure. ------------------------------------------------------------------------------*/ DEFINE VARIABLE lOverridden AS LOG NO-UNDO. /* Allow a super-procedure to override the default toolbar */ lOverridden = SUPER() NO-ERROR. /* not (true) for unknown */ IF NOT (lOverridden = TRUE) THEN DO: insertMenu("":U,"File,Navigation":U,NO,?). insertMenu("File":U, "Add,Update,Copy,Delete,RULE,":U + "save,reset,cancel,RULE,Transaction,":U + "RULE,Function,RULE,Exit":U, YES, /* expand children */ ?). END. /* build the menubar */ buildMenu(""). RETURN TRUE. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION initializeToolBar P-Win FUNCTION initializeToolBar RETURNS LOGICAL ( /* parameter-definitions */ ) : /*------------------------------------------------------------------------------ Purpose: Creates the toolbar for the toolbar Notes: This function is defined locally, but will skip the default behavior if there is a super defined AND it returns true. ------------------------------------------------------------------------------*/ DEFINE VARIABLE lOverridden AS LOG NO-UNDO. /* Allow a super-procedure to override the default toolbar */ lOverridden = SUPER() NO-ERROR. /* not (true) for unknown */ IF NOT (lOverridden = TRUE) THEN DO: createToolBar ("Tableio,RULE,Transaction,RULE,Navigation,RULE,Function,RULE"). END. RETURN TRUE. /* Function return value. */ END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME