&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI &ANALYZE-RESUME &Scoped-define WINDOW-NAME winMain &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS winMain /*------------------------------------------------------------------------ File: Description: Input Parameters: Output Parameters: Author: Created: ------------------------------------------------------------------------*/ /* 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 vInitialise AS LOGICAL INITIAL TRUE NO-UNDO. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK /* ******************** Preprocessor Definitions ******************** */ &Scoped-define PROCEDURE-TYPE Window /* Name of first Frame and/or Browse and/or first Query */ &Scoped-define FRAME-NAME frmMain /* Standard List Definitions */ &Scoped-Define ENABLED-OBJECTS cmbDatabase lvDir lvTitle btnOk btnClose &Scoped-Define DISPLAYED-OBJECTS cmbDatabase lvDir lvTitle /* Custom List Definitions */ /* WidgetList,List-2,List-3,List-4,List-5,List-6 */ &Scoped-define WidgetList cmbDatabase lvDir lvTitle btnOk /* _UIB-PREPROCESSOR-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Prototypes ********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD DBList winMain FUNCTION DBList RETURNS CHARACTER ( INPUT ipCurrent AS CHAR ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********************** Control Definitions ********************** */ /* Define the widget handle for the window */ DEFINE VAR winMain AS WIDGET-HANDLE NO-UNDO. /* Definitions of the field level widgets */ DEFINE BUTTON btnClose LABEL "Close" SIZE 15 BY 1.14 BGCOLOR 8 . DEFINE BUTTON btnOk LABEL "OK" SIZE 15 BY 1.14. DEFINE VARIABLE cmbDatabase AS CHARACTER FORMAT "X(256)":U LABEL "Database" VIEW-AS COMBO-BOX SORT INNER-LINES 5 LIST-ITEMS " " SIZE 30 BY 1 NO-UNDO. DEFINE VARIABLE lvDir AS CHARACTER FORMAT "X(256)":U LABEL "Target Directory" VIEW-AS FILL-IN NATIVE SIZE 30 BY 1 NO-UNDO. DEFINE VARIABLE lvTitle AS CHARACTER FORMAT "X(256)":U LABEL "Title" VIEW-AS FILL-IN NATIVE SIZE 30 BY 1 NO-UNDO. /* ************************ Frame Definitions *********************** */ DEFINE FRAME frmMain cmbDatabase AT ROW 1.48 COL 18 COLON-ALIGNED lvDir AT ROW 2.67 COL 18 COLON-ALIGNED lvTitle AT ROW 3.86 COL 18 COLON-ALIGNED btnOk AT ROW 5.52 COL 28 btnClose AT ROW 5.52 COL 44 WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY SIDE-LABELS NO-UNDERLINE THREE-D AT COL 1 ROW 1 SIZE 60 BY 6.19 DEFAULT-BUTTON btnOk. /* *********************** Procedure Settings ************************ */ &ANALYZE-SUSPEND _PROCEDURE-SETTINGS /* Settings for THIS-PROCEDURE Type: Window Allow: Basic,Browse,DB-Fields,Window,Query Other Settings: COMPILE */ &ANALYZE-RESUME _END-PROCEDURE-SETTINGS /* ************************* Create Window ************************** */ &ANALYZE-SUSPEND _CREATE-WINDOW IF SESSION:DISPLAY-TYPE = "GUI":U THEN CREATE WINDOW winMain ASSIGN HIDDEN = YES TITLE = "Generate HTML Schema" HEIGHT = 6.19 WIDTH = 60 MAX-HEIGHT = 6.19 MAX-WIDTH = 60 VIRTUAL-HEIGHT = 6.19 VIRTUAL-WIDTH = 60 RESIZE = no SCROLL-BARS = no STATUS-AREA = no BGCOLOR = ? FGCOLOR = ? KEEP-FRAME-Z-ORDER = yes THREE-D = yes MESSAGE-AREA = no SENSITIVE = yes. ELSE {&WINDOW-NAME} = CURRENT-WINDOW. /* END WINDOW DEFINITION */ &ANALYZE-RESUME /* *************** Runtime Attributes and UIB Settings ************** */ &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES /* SETTINGS FOR WINDOW winMain VISIBLE,,RUN-PERSISTENT */ /* SETTINGS FOR FRAME frmMain */ /* SETTINGS FOR BUTTON btnOk IN FRAME frmMain 1 */ /* SETTINGS FOR COMBO-BOX cmbDatabase IN FRAME frmMain 1 */ /* SETTINGS FOR FILL-IN lvDir IN FRAME frmMain 1 */ /* SETTINGS FOR FILL-IN lvTitle IN FRAME frmMain 1 */ IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(winMain) THEN winMain:HIDDEN = no. /* _RUN-TIME-ATTRIBUTES-END */ &ANALYZE-RESUME /* ************************ Control Triggers ************************ */ &Scoped-define SELF-NAME winMain &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL winMain winMain ON END-ERROR OF winMain /* Generate HTML Schema */ OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO: /* This case occurs when the user presses the "Esc" key. In a persistently run window, just ignore this. If we did not, the application would exit. */ IF THIS-PROCEDURE:PERSISTENT THEN RETURN NO-APPLY. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL winMain winMain ON ENTRY OF winMain /* Generate HTML Schema */ DO: DBList(cmbDatabase). IF NUM-DBS = 0 THEN DO: DISABLE {&WidgetList} WITH FRAME {&FRAME-NAME}. END. ELSE DO: ENABLE {&WidgetList} WITH FRAME {&FRAME-NAME}. END. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL winMain winMain ON WINDOW-CLOSE OF winMain /* Generate HTML Schema */ DO: /* This event will close the window and terminate the procedure. */ APPLY "CLOSE":U TO THIS-PROCEDURE. RETURN NO-APPLY. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME btnClose &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnClose winMain ON CHOOSE OF btnClose IN FRAME frmMain /* Close */ DO: APPLY "WINDOW-CLOSE":U TO {&WINDOW-NAME}. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME btnOk &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnOk winMain ON CHOOSE OF btnOk IN FRAME frmMain /* OK */ DO: ASSIGN {&DISPLAYED-OBJECTS}. IF lvTitle = "" THEN ASSIGN lvTitle = CAPS(cmbDatabase) + " Database Definition". ASSIGN lvDir = RIGHT-TRIM(lvDir, "\/") FILE-INFO:FILE-NAME = lvDir. IF INDEX(FILE-INFO:FILE-TYPE, "D") = 0 THEN DO: MESSAGE lvDir "is not a valid directory." VIEW-AS ALERT-BOX ERROR. APPLY "ENTRY":U TO lvDir. RETURN NO-APPLY. END. SESSION:SET-WAIT-STATE("GENERAL"). RUN Schema.p (lvDir, lvTitle). SESSION:SET-WAIT-STATE(""). END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME cmbDatabase &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL cmbDatabase winMain ON VALUE-CHANGED OF cmbDatabase IN FRAME frmMain /* Database */ DO: ASSIGN {&SELF-NAME}. DELETE ALIAS "DICTDB". CREATE ALIAS "DICTDB" FOR DATABASE VALUE({&SELF-NAME}). END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &UNDEFINE SELF-NAME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK winMain /* *************************** Main Block *************************** */ /* Set CURRENT-WINDOW: this will parent dialog-boxes and frames. */ ASSIGN CURRENT-WINDOW = {&WINDOW-NAME} THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME} lvDir = SESSION:TEMP-DIR. /* The CLOSE event can be used from inside or outside the procedure to */ /* terminate it. */ ON CLOSE OF THIS-PROCEDURE RUN disable_UI. /* Best default for GUI applications is... */ PAUSE 0 BEFORE-HIDE. /* Now enable the interface and wait for the exit condition. */ /* (NOTE: handle ERROR and END-KEY so cleanup code will always fire. */ MAIN-BLOCK: DO ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK: RUN enable_UI. IF NOT THIS-PROCEDURE:PERSISTENT THEN WAIT-FOR CLOSE OF THIS-PROCEDURE. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ********************** Internal Procedures *********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI winMain _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. ------------------------------------------------------------------------------*/ /* Delete the WINDOW we created */ IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(winMain) THEN DELETE WIDGET winMain. 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 winMain _DEFAULT-ENABLE PROCEDURE enable_UI : /*------------------------------------------------------------------------------ Purpose: ENABLE the User Interface Parameters: Notes: Here we display/view/enable the widgets in the user-interface. In addition, OPEN all queries associated with each FRAME and BROWSE. These statements here are based on the "Other Settings" section of the widget Property Sheets. ------------------------------------------------------------------------------*/ DISPLAY cmbDatabase lvDir lvTitle WITH FRAME frmMain IN WINDOW winMain. ENABLE cmbDatabase lvDir lvTitle btnOk btnClose WITH FRAME frmMain IN WINDOW winMain. {&OPEN-BROWSERS-IN-QUERY-frmMain} VIEW winMain. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Implementations ***************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION DBList winMain FUNCTION DBList RETURNS CHARACTER ( INPUT ipCurrent AS CHAR ) : /*------------------------------------------------------------------------------ Purpose: Notes: ------------------------------------------------------------------------------*/ DEF VAR vDBNum AS INT NO-UNDO. DO WITH FRAME {&FRAME-NAME}: cmbDatabase:LIST-ITEMS = "". DO vDBNum = 1 TO NUM-DBS: IF ipCurrent = "" THEN ASSIGN ipCurrent = LDBNAME(vDBNum). cmbDatabase:ADD-LAST(LDBNAME(vDBNum)). END. IF ipCurrent <> "" THEN ASSIGN cmbDatabase:SCREEN-VALUE = ipCurrent. END. RETURN "". /* Function return value. */ END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME