FWD » Core Development » User Interface

/**

 Setup initial state before running a test or a group of tests.

 */

PROCEDURE testInit PRIVATE:

   DEFINE INPUT PARAMETER iFrame AS HANDLE NO-UNDO. // Inner frame handle

   DEFINE INPUT PARAMETER oFrame AS HANDLE NO-UNDO. // Outer frame handle

   DEFAULT-WINDOW:HEIGHT-PIXELS = 500.

   DEFAULT-WINDOW:MAX-HEIGHT-PIXELS = 500.

   DEFAULT-WINDOW:VIRTUAL-HEIGHT-PIXELS = 500.

   // SET window wide enough to accomodate all buttons

   DEFAULT-WINDOW:WIDTH-PIXELS = 800.

   iFrame:HEIGHT-PIXELS = 300.

   iFrame:VIRTUAL-HEIGHT-PIXELS = 300.

   RUN testFrameAtts(iFrame, 300, 300, "Internal Frame Reset").

   oFrame:HEIGHT-PIXELS = 350.

   oFrame:VIRTUAL-HEIGHT-PIXELS = 350.

   RUN testFrameAtts(oFrame, 350, 350, "Outer Frame Reset").

END.

PROCEDURE assert PRIVATE:

   DEFINE INPUT PARAMETER val AS LOGICAL NO-UNDO.      // The result

   DEFINE INPUT PARAMETER msg AS CHARACTER NO-UNDO.    // Where description to report error

   IF (NOT val) THEN

      MESSAGE "Assertion error: " msg VIEW-AS ALERT-BOX ERROR.

END.

PROCEDURE assertIntEquals PRIVATE:

   DEFINE INPUT PARAMETER val AS INTEGER NO-UNDO.      // The result

   DEFINE INPUT PARAMETER expected AS INTEGER NO-UNDO. // The expected value

   DEFINE INPUT PARAMETER msg AS CHARACTER NO-UNDO.    // Where description to report error

   IF (val <> expected) THEN

      MESSAGE "Assertion error: " msg " expected: " expected " got: " val VIEW-AS ALERT-BOX ERROR.

END.

/** Test DEFAULT-WINDOW attributes: HEIGHT-PIXELS, MAX-HEIGHT-PIXELS, VIRTUAL-HEIGHT-PIXELS */

PROCEDURE testWindowAtts PRIVATE:

   DEFINE INPUT PARAMETER wp AS INTEGER NO-UNDO. // Expected window height pixels

   DEFINE INPUT PARAMETER mxwp AS INTEGER NO-UNDO. // Expected window max height pixels

   DEFINE INPUT PARAMETER vwp AS INTEGER NO-UNDO. // Expected window virtual height pixels

   RUN assertIntEquals(DEFAULT-WINDOW:HEIGHT-PIXELS, wp, "window height").

   RUN assertIntEquals(DEFAULT-WINDOW:MAX-HEIGHT-PIXELS, mxwp, "window max height").

   RUN assertIntEquals(DEFAULT-WINDOW:VIRTUAL-HEIGHT-PIXELS, vwp, "window virt height").

END.

/** Test frame attributes: HEIGHT-PIXELS, VIRTUAL-HEIGHT-PIXELS */

PROCEDURE testFrameAtts PRIVATE:

   DEFINE INPUT PARAMETER hFrame AS HANDLE NO-UNDO. // Frame handle

   DEFINE INPUT PARAMETER wp AS INTEGER NO-UNDO. // Expected frame height pixels

   DEFINE INPUT PARAMETER vwp AS INTEGER NO-UNDO. // Expected frame virtual height pixels

   DEFINE INPUT PARAMETER msg AS CHARACTER NO-UNDO. // Test ID

   RUN assertIntEquals(hFrame:HEIGHT-PIXELS, wp, msg + " height").

   RUN assertIntEquals(hFrame:VIRTUAL-HEIGHT-PIXELS, vwp, msg + " virt height").

END.

/**

 * Tests for setting window:MAX-HEIGHT-PIXELS

 */

PROCEDURE testWindowMaxHeight PRIVATE:

   // #5809

   MESSAGE "MHP 1".

   DEFAULT-WINDOW:MAX-HEIGHT-PIXELS = 350.

   RUN testWindowAtts(300, 350, 400).

   MESSAGE "MHP 2".

   DEFAULT-WINDOW:MAX-HEIGHT-PIXELS = 300.

   RUN testWindowAtts(300, 300, 400).

   MESSAGE "MHP 3".

   DEFAULT-WINDOW:MAX-HEIGHT-PIXELS = 250.

   RUN testWindowAtts(250, 250, 400).

   MESSAGE "MHP 4".

   DEFAULT-WINDOW:MAX-HEIGHT-PIXELS = 0.

   RUN testWindowAtts(124, 0, 400).

END.

/**

 * Tests for setting outer frame HEIGHT-PIXELS

 */

PROCEDURE testOuterFrameHeight PRIVATE:

   DEFINE INPUT PARAMETER hFrame AS HANDLE NO-UNDO. // Frame handle

   DEFINE INPUT PARAMETER realized AS LOGICAL NO-UNDO. // Is frame realized?

   // Check initial values

   RUN testFrameAtts(hFrame, 350, 350, "OFH 0").

   // Reduce the HEIGHT, the VIRTUAL-HEIGHT should NOT change

   hFrame:HEIGHT-PIXELS = 150.

   RUN testFrameAtts(hFrame, 150, 350, "OFH 1").

   // Restore the HEIGHT to initial value

   hFrame:HEIGHT-PIXELS = 350.

   RUN testFrameAtts(hFrame, 350, 350, "OFH 2").

   // Try to make it bigger than the window

   hFrame:HEIGHT-PIXELS = 600.

   IF realized THEN

      RUN testFrameAtts(hFrame, 500, 600, "OFH 3"). // If realized, height is limited by window height

   ELSE

      RUN testFrameAtts(hFrame, 600, 600, "OFH 3"). // If unrealized, no limiting by window sizes

   hFrame:HEIGHT-PIXELS = 0 NO-ERROR.

   RUN assertIntEquals(ERROR-STATUS:GET-NUMBER(1), 4084, "outerFrame:HEIGHT-PIXELS = 0").

   IF realized THEN

      RUN testFrameAtts(hFrame, 500, 600, "OFH 4"). // Frame height restricted by window virt height

   ELSE

      RUN testFrameAtts(hFrame, 600, 600, "OFH 4").

END.

/**

 * Tests for setting inner frame HEIGHT-PIXELS

 */

PROCEDURE testInnerFrameHeight PRIVATE:

   DEFINE INPUT PARAMETER hFrame AS HANDLE NO-UNDO. // Frame handle

   DEFINE INPUT PARAMETER realized AS LOGICAL NO-UNDO. // Is frame realized?

   // Check initial values

   RUN testFrameAtts(hFrame, 300, 300, "IFW 0").

   // Reduce the HEIGHT, the VIRTUAL-HEIGHT should NOT change

   hFrame:HEIGHT-PIXELS = 150.

   RUN testFrameAtts(hFrame, 150, 300, "IFW 1").

   // Restore the HEIGHT to initial value

   hFrame:HEIGHT-PIXELS = 300.

   RUN testFrameAtts(hFrame, 300, 300, "IFW 2").

   // Try to make it bigger than the window

   hFrame:HEIGHT-PIXELS = 600.

   IF realized THEN

      RUN testFrameAtts(hFrame, 500, 600, "IFW 3").

   ELSE

      RUN testFrameAtts(hFrame, 600, 600, "IFW 3"). // If unrealized, no limiting by window sizes

   // Setting size to zero: an error is reported, no changes occurs

   hFrame:HEIGHT-PIXELS = 0 NO-ERROR.

   RUN assertIntEquals(ERROR-STATUS:GET-NUMBER(1), 4084, "innerFrame:HEIGHT-PIXELS = 0").

   IF realized THEN

      RUN testFrameAtts(hFrame, 500, 600, "IFW 4"). // Frame height restricted by window virt height

   ELSE

      RUN testFrameAtts(hFrame, 600, 600, "IFW 4").

END.

/** Buttons */

DEFINE BUTTON bWindowHeightPixels LABEL "Window Height Pixels".

DEFINE BUTTON bWindowMaxHeightPixels LABEL "Window Max Height Pixels".

DEFINE BUTTON bWindowVirtualHeightPixels LABEL "Window Virtual Height Pixels".

DEFINE BUTTON bInnerFrameHeightPixels LABEL "Inner Frame Height Pixels".

DEFINE BUTTON bInnerFrameVirtualHeightPixels LABEL "Inner Frame Virtual Height Pixels".

DEFINE BUTTON bInnerFrameLeftPixels LABEL "Inner Frame Left".

DEFINE BUTTON bOuterFrameHeightPixels LABEL "Outer Frame Height Pixels".

DEFINE BUTTON bOuterFrameVirtualHeightPixels LABEL "Outer Frame Virtual Height Pixels".

DEFINE BUTTON bOuterFrameLeftPixels LABEL "Outer Frame Left".

DEFINE BUTTON bOuterFrameHeightChars LABEL "Outer Frame Height Chars".

DEFINE BUTTON bOuterFrameVirtualHeightChars LABEL "Outer Frame Virtual Height Chars".

DEFINE BUTTON bOuterFrameLeftChars LABEL "Outer Frame Left".

DEFINE BUTTON bButtonHeightPixels LABEL "Button Height Pixels".

DEFINE BUTTON bRunTests LABEL "RunTests".

DEFINE VARIABLE bFramesScrollable AS LOGICAL NO-UNDO VIEW-AS TOGGLE-BOX LABEL "FramesScrollable".

/** Print all related values */

DEFINE BUTTON bPrint LABEL "Print Heights".

DEFINE FRAME innerFrame 

   bWindowHeightPixels            AT X 5 Y 5 NO-LABEL

   bWindowMaxHeightPixels         AT X 5 Y 30 NO-LABEL

   bWindowVirtualHeightPixels     AT X 5 Y 55 NO-LABEL

   bInnerFrameHeightPixels        AT X 5 Y 90 NO-LABEL

   bInnerFrameVirtualHeightPixels AT X 5 Y 115 NO-LABEL

   bInnerFrameLeftPixels          AT X 5 Y 140 NO-LABEL

   bOuterFrameHeightPixels        AT X 205 Y 5 NO-LABEL

   bOuterFrameVirtualHeightPixels AT X 205 Y 30 NO-LABEL

   bOuterFrameLeftPixels          AT X 205 Y 55 NO-LABEL

   bOuterFrameHeightChars        AT X 205 Y 90  NO-LABEL

   bOuterFrameVirtualHeightChars AT X 205 Y 115 NO-LABEL

   bOuterFrameLeftChars          AT X 205 Y 140 NO-LABEL

   bButtonHeightPixels           AT X 405 Y 5  NO-LABEL

   bPrint                        AT X 405 Y 30 NO-LABEL

   bFramesScrollable             AT X 405 Y 55 NO-LABEL

   bRunTests                     AT X 405 Y 80 NO-LABEL

   WITH

      SIZE-PIXELS 600 BY 300

      SCROLLABLE

   .

DEFINE FRAME outerFrame 

   WITH

      SCROLLABLE

      SIZE-PIXELS 600 BY 350

      .

FRAME innerFrame:FRAME = FRAME outerFrame:HANDLE.

// Note: we set virtual height to the value explicitly here to workaround a bug #5809, issue 4

// In 4gl this happens automatically when the frame is realized.

// Remove this assignmens as soon the #5809 issue 4 is fixed.

FRAME innerFrame:VIRTUAL-HEIGHT-PIXELS = 300.

FRAME outerFrame:VIRTUAL-HEIGHT-PIXELS = 350.

// Run tests on un-realized window/frame

RUN testWindowAtts(462, 462, 462).

RUN testInit(FRAME innerFrame:HANDLE, FRAME outerFrame:HANDLE).

// Test inner frame before outer frame

RUN testInnerFrameHeight(FRAME innerFrame:HANDLE, FALSE).

RUN testOuterFrameHeight(FRAME outerFrame:HANDLE, FALSE).

ENABLE ALL WITH FRAME innerFrame.

ENABLE ALL WITH FRAME outerFrame.

// FIXME In FWD the outerFrame is automatically placed at 20 pixels along ther Y coordinate.

// Until this fixed, explicitly SET FRAME Y TO zero.

// RUN assertIntEquals(FRAME outerFrame:Y, 0, "outerFrame Y").

// FRAME outerFrame:Y = 0.

bFramesScrollable:SCREEN-VALUE = "yes".

VIEW FRAME innerFrame.

RUN assertIntEquals(FRAME outerFrame:Y, 0, "outerFrame Y 4").

ON CHOOSE OF bWindowHeightPixels DO:

   DEFINE VARIABLE newValue AS INTEGER.

   newValue = ?.

   MESSAGE "New Window Height Pixels (" DEFAULT-WINDOW:HEIGHT-PIXELS "):" SET newValue.

   DEFAULT-WINDOW:HEIGHT-PIXELS = newValue.

END.

ON CHOOSE OF bWindowMaxHeightPixels DO:

   DEFINE VARIABLE newValue AS INTEGER.

   newValue = ?.

   MESSAGE "New Window Max Height Pixels (" DEFAULT-WINDOW:MAX-HEIGHT-PIXELS "):" SET newValue.

   DEFAULT-WINDOW:MAX-HEIGHT-PIXELS = newValue.

END.

ON CHOOSE OF bWindowVirtualHeightPixels DO:

   DEFINE VARIABLE newValue AS INTEGER.

   newValue = ?.

   MESSAGE "New Window Virtual Height Pixels ("

      DEFAULT-WINDOW:VIRTUAL-HEIGHT-PIXELS "):" SET newValue.

   DEFAULT-WINDOW:VIRTUAL-HEIGHT-PIXELS = newValue.

END.

ON CHOOSE OF bInnerFrameHeightPixels DO:

   DEFINE VARIABLE newValue AS INTEGER.

   newValue = ?.

   MESSAGE "New Inner Frame Height Pixels (" FRAME innerFrame:HEIGHT-PIXELS "):" SET newValue.

   FRAME innerFrame:HEIGHT-PIXELS = newValue.

END.

ON CHOOSE OF bInnerFrameVirtualHeightPixels DO:

   DEFINE VARIABLE newValue AS INTEGER.

   newValue = ?.

   MESSAGE "New Inner Frame Virtual Height Pixels (" FRAME innerFrame:VIRTUAL-HEIGHT-PIXELS "):" SET newValue.

   FRAME innerFrame:VIRTUAL-HEIGHT-PIXELS = newValue.

END.

ON CHOOSE OF bInnerFrameLeftPixels DO:

   DEFINE VARIABLE newValue AS INTEGER.

   newValue = ?.

   MESSAGE "New Inner Frame Left Pixels (" FRAME innerFrame:X "):" SET newValue.

   FRAME innerFrame:X = newValue.

END.

ON CHOOSE OF bOuterFrameHeightPixels DO:

   DEFINE VARIABLE newValue AS INTEGER.

   newValue = ?.

   MESSAGE "New Outer Frame Height Pixels (" FRAME outerFrame:HEIGHT-PIXELS "):" SET newValue.

   FRAME outerFrame:HEIGHT-PIXELS = newValue.

END.

ON CHOOSE OF bOuterFrameVirtualHeightPixels DO:

   DEFINE VARIABLE newValue AS INTEGER.

   newValue = ?.

   MESSAGE "New Outer Frame Virtual Height Pixels (" FRAME outerFrame:VIRTUAL-HEIGHT-PIXELS "):" SET newValue.

   FRAME outerFrame:VIRTUAL-HEIGHT-PIXELS = newValue.

END.

ON CHOOSE OF bOuterFrameLeftPixels DO:

   DEFINE VARIABLE newValue AS INTEGER.

   newValue = ?.

   MESSAGE "New Outer Frame Left Pixels (" FRAME outerFrame:X "):" SET newValue.

   FRAME outerFrame:X = newValue.

END.

ON CHOOSE OF bOuterFrameHeightChars DO:

   DEFINE VARIABLE newValue AS DECIMAL FORMAT ">>9.99999999".

   MESSAGE "New Outer Frame Height Chars (" FRAME outerFrame:HEIGHT-CHARS "):" SET newValue.

   FRAME outerFrame:HEIGHT-CHARS = newValue.

END.

ON CHOOSE OF bOuterFrameVirtualHeightChars DO:

   DEFINE VARIABLE newValue AS DECIMAL FORMAT ">>9.99999999".

   MESSAGE "New Outer Frame Virtual Height Chars (" FRAME outerFrame:VIRTUAL-HEIGHT-CHARS "):" SET newValue.

   FRAME outerFrame:VIRTUAL-HEIGHT-CHARS = newValue.

END.

ON CHOOSE OF bOuterFrameLeftChars DO:

   DEFINE VARIABLE newValue AS DECIMAL FORMAT ">>9.99999999".

   MESSAGE "New Outer Frame Left Chars (" FRAME outerFrame:X "):" SET newValue.

   FRAME outerFrame:X = newValue.

END.

ON CHOOSE OF bPrint DO:

   MESSAGE "IF X"  FRAME innerFrame:X SKIP

           "IF H"  FRAME innerFrame:HEIGHT-PIXELS SKIP

           "IF VH" FRAME innerFrame:VIRTUAL-HEIGHT-PIXELS SKIP

           "OF X"  FRAME outerFrame:X SKIP

           "OF H"  FRAME outerFrame:HEIGHT-PIXELS SKIP

           "OF VH" FRAME outerFrame:VIRTUAL-HEIGHT-PIXELS SKIP

           "OF HC"  FRAME outerFrame:HEIGHT-CHARS SKIP

           "OF VHC" FRAME outerFrame:VIRTUAL-HEIGHT-CHARS SKIP

           "W H"  DEFAULT-WINDOW:HEIGHT-PIXELS SKIP

           "W MH" DEFAULT-WINDOW:MAX-HEIGHT-PIXELS SKIP

           "W VH" DEFAULT-WINDOW:VIRTUAL-HEIGHT-PIXELS

           VIEW-AS ALERT-BOX.

END.

ON CHOOSE OF bButtonHeightPixels DO:

   DEFINE VARIABLE newValue AS INTEGER.

   newValue = ?.

   MESSAGE "New Button Height Pixels (" bButtonHeightPixels:HEIGHT-PIXELS "):" SET newValue.

   bButtonHeightPixels:HEIGHT-PIXELS = newValue.

END.

ON CHOOSE OF bRunTests DO:

   RUN testInit(FRAME innerFrame:HANDLE, FRAME outerFrame:HANDLE).

   RUN testOuterFrameHeight(FRAME outerFrame:HANDLE, TRUE).

   RUN testInit(FRAME innerFrame:HANDLE, FRAME outerFrame:HANDLE).

   RUN testOuterFrameHeight(FRAME outerFrame:HANDLE, TRUE).

END.

ON VALUE-CHANGED OF bFramesScrollable

DO:

   ASSIGN bFramesScrollable.

   FRAME outerFrame:SCROLLABLE = bFramesScrollable.

END.

WAIT-FOR GO OF FRAME innerFrame.