P
Patrick Tingen
Guest
Check the below program. Save it as a .w file and open it in the appbuilder while connected to the sports (not sports2k) database. Please note that it takes quite some code to handle the user interface when you create windows like this. Too bad Progress does not have a /simple/ method to create crud screens. &Scoped-define WINDOW-NAME C-Win /*----------------------------------------------------------------------- File : customerDiscount.w Desc : Set the customer discount. Demo program to show how to use selection list. 8-1-2020 Patrick Tingen ------------------------------------------------------------------------*/ CREATE WIDGET-POOL. /* ******************** Preprocessor Definitions ******************** */ &Scoped-define PROCEDURE-TYPE Window &Scoped-define DB-AWARE no /* Name of designated FRAME-NAME and/or first browse and/or first query */ &Scoped-define FRAME-NAME DEFAULT-FRAME /* Standard List Definitions */ &Scoped-Define ENABLED-OBJECTS selCustomers btnUpdate &Scoped-Define DISPLAYED-OBJECTS selCustomers fiDiscount /* Custom List Definitions */ /* List-1,List-2,List-3,List-4,List-5,List-6 */ /* *********************** Control Definitions ********************** */ /* Define the widget handle for the window */ DEFINE VAR C-Win AS WIDGET-HANDLE NO-UNDO. /* Definitions of the field level widgets */ DEFINE BUTTON btnCancel AUTO-END-KEY DEFAULT LABEL "Cancel" SIZE 15 BY 1.14 BGCOLOR 8 . DEFINE BUTTON btnSave LABEL "Save" SIZE 15 BY 1.14. DEFINE BUTTON btnUpdate LABEL "Update" SIZE 15 BY 1.14. DEFINE VARIABLE fiDiscount AS INTEGER FORMAT ">9":U INITIAL 0 LABEL "Discount" VIEW-AS FILL-IN SIZE 6 BY 1 NO-UNDO. DEFINE VARIABLE selCustomers AS CHARACTER VIEW-AS SELECTION-LIST SINGLE SORT SCROLLBAR-VERTICAL SIZE 39 BY 13.33 NO-UNDO. /* ************************ Frame Definitions *********************** */ DEFINE FRAME DEFAULT-FRAME selCustomers AT ROW 1.24 COL 2 NO-LABEL WIDGET-ID 2 btnUpdate AT ROW 4 COL 64 WIDGET-ID 8 fiDiscount AT ROW 4.1 COL 53 COLON-ALIGNED WIDGET-ID 4 btnCancel AT ROW 6.48 COL 47 WIDGET-ID 10 btnSave AT ROW 6.48 COL 64 WIDGET-ID 6 WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY SIDE-LABELS NO-UNDERLINE THREE-D AT COL 1 ROW 1 SIZE 80 BY 13.95 DEFAULT-BUTTON btnSave CANCEL-BUTTON btnCancel WIDGET-ID 100. /* *********************** Procedure Settings ************************ */ /* Settings for THIS-PROCEDURE Type: Window Allow: Basic,Browse,DB-Fields,Window,Query Other Settings: COMPILE */ /* ************************* Create Window ************************** */ IF SESSION
ISPLAY-TYPE = "GUI":U THEN CREATE WINDOW C-Win ASSIGN HIDDEN = YES TITLE = "Customer discount" HEIGHT = 14.05 WIDTH = 80 MAX-HEIGHT = 16 MAX-WIDTH = 80 VIRTUAL-HEIGHT = 16 VIRTUAL-WIDTH = 80 RESIZE = yes 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 */ /* *********** Runtime Attributes and AppBuilder Settings *********** */ /* SETTINGS FOR WINDOW C-Win VISIBLE,,RUN-PERSISTENT */ /* SETTINGS FOR FRAME DEFAULT-FRAME FRAME-NAME */ /* SETTINGS FOR BUTTON btnCancel IN FRAME DEFAULT-FRAME NO-ENABLE */ /* SETTINGS FOR BUTTON btnSave IN FRAME DEFAULT-FRAME NO-ENABLE */ /* SETTINGS FOR FILL-IN fiDiscount IN FRAME DEFAULT-FRAME NO-ENABLE */ IF SESSIONISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win) THEN C-Win:HIDDEN = no. /* ************************ Control Triggers ************************ */ &Scoped-define SELF-NAME C-Win ON END-ERROR OF C-Win /* Customer discount */ OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO: IF THIS-PROCEDUREERSISTENT THEN RETURN NO-APPLY. END. ON WINDOW-CLOSE OF C-Win /* Customer discount */ DO: /* This event will close the window and terminate the procedure. */ APPLY "CLOSE":U TO THIS-PROCEDURE. RETURN NO-APPLY. END. &Scoped-define SELF-NAME btnCancel ON CHOOSE OF btnCancel IN FRAME DEFAULT-FRAME /* Cancel */ OR 'RETURN' OF fiDiscount OR 'end-error' OF fiDiscount DO: fiDiscount:SENSITIVE = FALSE. btnSave:SENSITIVE = FALSE. btnUpdate:SENSITIVE = TRUE. btnCancel:SENSITIVE = FALSE. APPLY 'value-changed' TO selCustomers. APPLY 'entry' TO selCustomers. RETURN NO-APPLY. END. &Scoped-define SELF-NAME btnSave ON CHOOSE OF btnSave IN FRAME DEFAULT-FRAME /* Save */ OR 'RETURN' OF fiDiscount DO: DEFINE BUFFER bCust FOR customer. FIND bCust EXCLUSIVE-LOCK WHERE bCust.cust-num = INTEGER(selCustomers:SCREEN-VALUE) NO-ERROR. IF AVAILABLE bCust THEN bCust.discount = INTEGER(fiDiscount:SCREEN-VALUE). fiDiscount:SENSITIVE = FALSE. btnSave:SENSITIVE = FALSE. btnUpdate:SENSITIVE = TRUE. btnCancel:SENSITIVE = FALSE. APPLY 'entry' TO selCustomers. RETURN NO-APPLY. END. &Scoped-define SELF-NAME btnUpdate ON CHOOSE OF btnUpdate IN FRAME DEFAULT-FRAME /* Update */ OR DEFAULT-ACTION OF selCustomers OR 'return' OF selCustomers DO: fiDiscount:SENSITIVE = TRUE. btnSave:SENSITIVE = TRUE. btnUpdate:SENSITIVE = FALSE. btnCancel:SENSITIVE = TRUE. APPLY 'entry' TO fiDiscount. END. &Scoped-define SELF-NAME selCustomers ON VALUE-CHANGED OF selCustomers IN FRAME DEFAULT-FRAME DO: DEFINE BUFFER bCust FOR customer. FIND bCust NO-LOCK WHERE bCust.cust-num = INTEGER(selCustomers:SCREEN-VALUE) NO-ERROR. fiDiscount:SCREEN-VALUE = STRING(IF AVAILABLE bCust THEN bCust.discount ELSE 0). END. &UNDEFINE SELF-NAME /* *************************** Main Block *************************** */ /* Set CURRENT-WINDOW: this will parent dialog-boxes and frames. */ ASSIGN CURRENT-WINDOW = {&WINDOW-NAME} THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}. /* 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 fillCustomers(selCustomers:HANDLE). RUN enable_UI. /* Select the first customer in the list */ selCustomers:SCREEN-VALUE = ENTRY(2,selCustomers:LIST-ITEM-PAIRS). APPLY 'value-changed' TO selCustomers. IF NOT THIS-PROCEDUREERSISTENT THEN WAIT-FOR CLOSE OF THIS-PROCEDURE. END. /* ********************** Internal Procedures *********************** */ 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 SESSIONISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win) THEN DELETE WIDGET C-Win. IF THIS-PROCEDUREERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE. END PROCEDURE. 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 selCustomers fiDiscount WITH FRAME DEFAULT-FRAME IN WINDOW C-Win. ENABLE selCustomers btnUpdate WITH FRAME DEFAULT-FRAME IN WINDOW C-Win. {&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME} VIEW C-Win. END PROCEDURE. PROCEDURE fillCustomers : /* Fill selection list with customers */ DEFINE INPUT PARAMETER phList AS HANDLE NO-UNDO. DEFINE BUFFER bCust FOR customer. phList:LIST-ITEM-PAIRS = ?. FOR EACH bCust NO-LOCK: phList:ADD-LAST(bCust.name, STRING(bCust.cust-num)). END. END PROCEDURE.
Continue reading...
ISPLAY-TYPE = "GUI":U THEN CREATE WINDOW C-Win ASSIGN HIDDEN = YES TITLE = "Customer discount" HEIGHT = 14.05 WIDTH = 80 MAX-HEIGHT = 16 MAX-WIDTH = 80 VIRTUAL-HEIGHT = 16 VIRTUAL-WIDTH = 80 RESIZE = yes 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 */ /* *********** Runtime Attributes and AppBuilder Settings *********** */ /* SETTINGS FOR WINDOW C-Win VISIBLE,,RUN-PERSISTENT */ /* SETTINGS FOR FRAME DEFAULT-FRAME FRAME-NAME */ /* SETTINGS FOR BUTTON btnCancel IN FRAME DEFAULT-FRAME NO-ENABLE */ /* SETTINGS FOR BUTTON btnSave IN FRAME DEFAULT-FRAME NO-ENABLE */ /* SETTINGS FOR FILL-IN fiDiscount IN FRAME DEFAULT-FRAME NO-ENABLE */ IF SESSIONISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win) THEN C-Win:HIDDEN = no. /* ************************ Control Triggers ************************ */ &Scoped-define SELF-NAME C-Win ON END-ERROR OF C-Win /* Customer discount */ OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO: IF THIS-PROCEDUREERSISTENT THEN RETURN NO-APPLY. END. ON WINDOW-CLOSE OF C-Win /* Customer discount */ DO: /* This event will close the window and terminate the procedure. */ APPLY "CLOSE":U TO THIS-PROCEDURE. RETURN NO-APPLY. END. &Scoped-define SELF-NAME btnCancel ON CHOOSE OF btnCancel IN FRAME DEFAULT-FRAME /* Cancel */ OR 'RETURN' OF fiDiscount OR 'end-error' OF fiDiscount DO: fiDiscount:SENSITIVE = FALSE. btnSave:SENSITIVE = FALSE. btnUpdate:SENSITIVE = TRUE. btnCancel:SENSITIVE = FALSE. APPLY 'value-changed' TO selCustomers. APPLY 'entry' TO selCustomers. RETURN NO-APPLY. END. &Scoped-define SELF-NAME btnSave ON CHOOSE OF btnSave IN FRAME DEFAULT-FRAME /* Save */ OR 'RETURN' OF fiDiscount DO: DEFINE BUFFER bCust FOR customer. FIND bCust EXCLUSIVE-LOCK WHERE bCust.cust-num = INTEGER(selCustomers:SCREEN-VALUE) NO-ERROR. IF AVAILABLE bCust THEN bCust.discount = INTEGER(fiDiscount:SCREEN-VALUE). fiDiscount:SENSITIVE = FALSE. btnSave:SENSITIVE = FALSE. btnUpdate:SENSITIVE = TRUE. btnCancel:SENSITIVE = FALSE. APPLY 'entry' TO selCustomers. RETURN NO-APPLY. END. &Scoped-define SELF-NAME btnUpdate ON CHOOSE OF btnUpdate IN FRAME DEFAULT-FRAME /* Update */ OR DEFAULT-ACTION OF selCustomers OR 'return' OF selCustomers DO: fiDiscount:SENSITIVE = TRUE. btnSave:SENSITIVE = TRUE. btnUpdate:SENSITIVE = FALSE. btnCancel:SENSITIVE = TRUE. APPLY 'entry' TO fiDiscount. END. &Scoped-define SELF-NAME selCustomers ON VALUE-CHANGED OF selCustomers IN FRAME DEFAULT-FRAME DO: DEFINE BUFFER bCust FOR customer. FIND bCust NO-LOCK WHERE bCust.cust-num = INTEGER(selCustomers:SCREEN-VALUE) NO-ERROR. fiDiscount:SCREEN-VALUE = STRING(IF AVAILABLE bCust THEN bCust.discount ELSE 0). END. &UNDEFINE SELF-NAME /* *************************** Main Block *************************** */ /* Set CURRENT-WINDOW: this will parent dialog-boxes and frames. */ ASSIGN CURRENT-WINDOW = {&WINDOW-NAME} THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}. /* 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 fillCustomers(selCustomers:HANDLE). RUN enable_UI. /* Select the first customer in the list */ selCustomers:SCREEN-VALUE = ENTRY(2,selCustomers:LIST-ITEM-PAIRS). APPLY 'value-changed' TO selCustomers. IF NOT THIS-PROCEDUREERSISTENT THEN WAIT-FOR CLOSE OF THIS-PROCEDURE. END. /* ********************** Internal Procedures *********************** */ 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 SESSIONISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win) THEN DELETE WIDGET C-Win. IF THIS-PROCEDUREERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE. END PROCEDURE. 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 selCustomers fiDiscount WITH FRAME DEFAULT-FRAME IN WINDOW C-Win. ENABLE selCustomers btnUpdate WITH FRAME DEFAULT-FRAME IN WINDOW C-Win. {&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME} VIEW C-Win. END PROCEDURE. PROCEDURE fillCustomers : /* Fill selection list with customers */ DEFINE INPUT PARAMETER phList AS HANDLE NO-UNDO. DEFINE BUFFER bCust FOR customer. phList:LIST-ITEM-PAIRS = ?. FOR EACH bCust NO-LOCK: phList:ADD-LAST(bCust.name, STRING(bCust.cust-num)). END. END PROCEDURE.Continue reading...