Skip to content

Instantly share code, notes, and snippets.

@patrickTingen

patrickTingen/wOrderingTest.w

Created January 26, 2018 09:05
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save patrickTingen/7d07326cb8e8decc93a9ac036d41fc49 to your computer and use it in GitHub Desktop.
Save patrickTingen/7d07326cb8e8decc93a9ac036d41fc49 to your computer and use it in GitHub Desktop.
Download ZIP
Order of selection in multi-select browse
Raw
wOrderingTest.w
&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 GUI
&ANALYZE-RESUME
/* Connected Databases
*/
&Scoped-define WINDOW-NAME wOrdering
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS wOrdering
/*------------------------------------------------------------------------
File:
Description:
Input Parameters:
<none>
Output Parameters:
<none>
Author:
Created:
------------------------------------------------------------------------*/
/* 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 --- */
/* Local Variable Definitions --- */
DEFINE TEMP-TABLE ttLine NO-UNDO
FIELD ttText AS CHARACTER.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
/* ******************** 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
&Scoped-define BROWSE-NAME brTest
/* Internal Tables (found by Frame, Query & Browse Queries) */
&Scoped-define INTERNAL-TABLES ttLine
/* Definitions for BROWSE brTest */
&Scoped-define FIELDS-IN-QUERY-brTest ttLine.ttText
&Scoped-define ENABLED-FIELDS-IN-QUERY-brTest
&Scoped-define SELF-NAME brTest
&Scoped-define QUERY-STRING-brTest FOR EACH ttLine
&Scoped-define OPEN-QUERY-brTest OPEN QUERY {&SELF-NAME} FOR EACH ttLine.
&Scoped-define TABLES-IN-QUERY-brTest ttLine
&Scoped-define FIRST-TABLE-IN-QUERY-brTest ttLine
/* Definitions for FRAME DEFAULT-FRAME */
/* Standard List Definitions */
&Scoped-Define ENABLED-OBJECTS brTest btnShow fcKeys
&Scoped-Define DISPLAYED-OBJECTS fcKeys
/* Custom List Definitions */
/* List-1,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 getKeyList wOrdering
FUNCTION getKeyList RETURNS CHARACTER
( /* parameter-definitions */ ) FORWARD.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* *********************** Control Definitions ********************** */
/* Define the widget handle for the window */
DEFINE VAR wOrdering AS WIDGET-HANDLE NO-UNDO.
/* Definitions of the field level widgets */
DEFINE BUTTON btnShow
LABEL "Show order"
SIZE 14 BY 1.14.
DEFINE VARIABLE fcKeys AS CHARACTER FORMAT "X(256)":U
LABEL "Keys"
VIEW-AS FILL-IN NATIVE
SIZE 21 BY 1 NO-UNDO.
/* Query definitions */
&ANALYZE-SUSPEND
DEFINE QUERY brTest FOR
ttLine SCROLLING.
&ANALYZE-RESUME
/* Browse definitions */
DEFINE BROWSE brTest
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS brTest wOrdering _FREEFORM
QUERY brTest DISPLAY
ttLine.ttText FORMAT "x(20)"
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
WITH NO-ROW-MARKERS SEPARATORS MULTIPLE SIZE 32 BY 9.29 FIT-LAST-COLUMN.
/* ************************ Frame Definitions *********************** */
DEFINE FRAME DEFAULT-FRAME
brTest AT ROW 1.24 COL 2 WIDGET-ID 200
btnShow AT ROW 1.95 COL 44 WIDGET-ID 2
fcKeys AT ROW 3.86 COL 42 COLON-ALIGNED WIDGET-ID 4
WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 1 ROW 1
SIZE 71.4 BY 9.91 WIDGET-ID 100.
/* *********************** 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 wOrdering ASSIGN
HIDDEN = YES
TITLE = "Ordering"
HEIGHT = 9.95
WIDTH = 71.8
MAX-HEIGHT = 29.05
MAX-WIDTH = 141.4
VIRTUAL-HEIGHT = 29.05
VIRTUAL-WIDTH = 141.4
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 */
&ANALYZE-RESUME
/* *********** Runtime Attributes and AppBuilder Settings *********** */
&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW wOrdering
VISIBLE,,RUN-PERSISTENT */
/* SETTINGS FOR FRAME DEFAULT-FRAME
FRAME-NAME */
/* BROWSE-TAB brTest 1 DEFAULT-FRAME */
ASSIGN
fcKeys:READ-ONLY IN FRAME DEFAULT-FRAME = TRUE.
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(wOrdering)
THEN wOrdering:HIDDEN = no.
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME
/* Setting information for Queries and Browse Widgets fields */
&ANALYZE-SUSPEND _QUERY-BLOCK BROWSE brTest
/* Query rebuild information for BROWSE brTest
_START_FREEFORM
OPEN QUERY {&SELF-NAME} FOR EACH ttLine.
_END_FREEFORM
_Query is NOT OPENED
*/ /* BROWSE brTest */
&ANALYZE-RESUME
/* ************************ Control Triggers ************************ */
&Scoped-define SELF-NAME wOrdering
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL wOrdering wOrdering
ON END-ERROR OF wOrdering /* Ordering */
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 wOrdering wOrdering
ON WINDOW-CLOSE OF wOrdering /* Ordering */
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 BROWSE-NAME brTest
&Scoped-define SELF-NAME brTest
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL brTest wOrdering
ON MOUSE-SELECT-CLICK OF brTest IN FRAME DEFAULT-FRAME
DO:
fcKeys:SCREEN-VALUE = getKeyList().
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define SELF-NAME btnShow
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL btnShow wOrdering
ON CHOOSE OF btnShow IN FRAME DEFAULT-FRAME /* Show order */
DO:
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE cStr AS CHARACTER NO-UNDO.
DO WITH FRAME {&FRAME-NAME}:
do i = 1 to brTest:num-selected-rows:
brTest:fetch-selected-row(i).
cStr = cStr + ttLine.ttText + "~n".
END.
MESSAGE cStr
VIEW-AS ALERT-BOX INFO BUTTONS OK.
END.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&UNDEFINE SELF-NAME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK wOrdering
/* *************************** 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 enable_UI.
RUN init-object.
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 wOrdering _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.
------------------------------------------------------------------------------*/
/* Delete the WINDOW we created */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(wOrdering)
THEN DELETE WIDGET wOrdering.
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 wOrdering _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.
------------------------------------------------------------------------------*/
DISPLAY fcKeys
WITH FRAME DEFAULT-FRAME IN WINDOW wOrdering.
ENABLE brTest btnShow fcKeys
WITH FRAME DEFAULT-FRAME IN WINDOW wOrdering.
{&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME}
VIEW wOrdering.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE init-object wOrdering
PROCEDURE init-object :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DO i = 1 TO 10:
CREATE ttLine.
ASSIGN ttLine.ttText = "Nr " + STRING(i).
END.
{&OPEN-QUERY-{&BROWSE-NAME}}
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* ************************ Function Implementations ***************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getKeyList wOrdering
FUNCTION getKeyList RETURNS CHARACTER
( /* parameter-definitions */ ) :
/* Return a list of special keys pressed
*/
DEFINE VARIABLE L-KBSTATE AS MEMPTR NO-UNDO.
DEFINE VARIABLE L-RETURNVALUE AS INT64 NO-UNDO.
DEFINE VARIABLE L-SHIFTLIST AS CHARACTER NO-UNDO.
SET-SIZE(L-KBSTATE) = 256.
/* Get the current state of the keyboard */
RUN GetKeyboardState(GET-POINTER-VALUE(L-KBSTATE), OUTPUT L-RETURNVALUE).
IF GET-BITS(GET-BYTE(L-KBSTATE, 1 + 16), 8, 1) = 1 THEN
L-SHIFTLIST = TRIM(L-SHIFTLIST + ",SHIFT",",").
IF GET-BITS(GET-BYTE(L-KBSTATE, 1 + 17), 8, 1) = 1 THEN
L-SHIFTLIST = TRIM(L-SHIFTLIST + ",CTRL",",").
IF GET-BITS(GET-BYTE(L-KBSTATE, 1 + 18), 8, 1) = 1 THEN
L-SHIFTLIST = TRIM(L-SHIFTLIST + ",ALT",",").
SET-SIZE(L-KBSTATE) = 0.
RETURN L-SHIFTLIST. /* Function return value. */
END FUNCTION. /* getKeyList */
/* This procedure causes problems:
* using datatype LONG causes problems on 64 bit systems
* using datatype INT64 causes problems on 32 bit systems
*/
&IF PROVERSION BEGINS '10' &THEN
/* 32 bit */
&GLOBAL-DEFINE return-type LONG
&ELSEIF PROCESS-ARCHITECTURE = 32 &THEN
/* 32 bit */
&GLOBAL-DEFINE return-type LONG
&ELSE
/* 64 bit */
&GLOBAL-DEFINE return-type INT64
&ENDIF
PROCEDURE GetKeyboardState EXTERNAL "user32.dll":
DEFINE INPUT PARAMETER KBState AS {&return-type}. /* memptr */
DEFINE RETURN PARAMETER RetVal AS LONG. /* bool */
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment