Was this helpful?
Confirm Procedure
The Confirm procedure asks users to confirm that they want to do a potentially dangerous action, such as trying to exit from the Employees frame or the Positions frame without saving any changes that have been made.
The following figure shows an example of the pop-up form generated by the Confirm procedure (as it appears on the Positions frame):
The 4GL Source Code
The following is the 4GL source code for the Confirm procedure:
/*

/*
** Procedure: confirm
** Source File: confirm.osq
** Description:
**
** Prompts the user to confirm that a potentially dangerous 
** action is to proceed. The prompting is done via the built-
** in frame look_up, which displays a popup like the following:
**
** +-------------------------------------------------------+
** |<question>                                             |
** +-------+-----------------------------------------------+
** |no     |<no>                                           |
** |yes    |<yes>                                          |
** +-------+-----------------------------------------------+
**** <question>, <no>, and <yes> are keyword parameters
** that you supply:
** <question> asks users if they really want to do the
** potentially dangerous action; <no> and <yes> provide
** explanations of the consequences of choosing 'no' or 'yes'.
**
** When the popup is displayed, the cursor is positioned on 'no'.
** The user can choose 'no' at this point by selecting
** 'Select', or choose 'yes' by scrolling down to it or
** hitting 'y' (which positions the cursor on the 'yes') and
** selecting 'Select'.
** The user can also select 'Cancel', which is equivalent to
** choosing 'no', no matter where the cursor is positioned.
**
** When you call this procedure, you can specify an
** explanation (<no> and/or <yes>) that occupies
** more than one line. To do this, embed
** a backslash character ('\') in the explanation at each
** point where a line break is to occur. The popup then
** displays blanks in the "choice" column of each continu-
** ation line. (The "choice" column is the left-hand column,
** which contains 'no' or 'yes' for non-continuation lines).
**
** The look_up frame allows the user to scroll into a 
** continuation line (and "choose" it by selecting 'Select').
** If the user does choose a continuation line, this procedure
** acts as if the 'no' or 'yes' above it had been chosen.
**
** If an explanation is longer than 1000 bytes, it is truncated
** on the right. If a piece of an explanation (delimited by 
** '\') is longer than 50 bytes (the size of the "explanation"
** attribute of the "choice_line" record type), it is .
** truncated on the right. If the question is longer than 57
** bytes, it too is truncated on the right.
**
** Returns:
**       'y' if the user chooses 'yes'.
**       'n' otherwise.
*/
procedure confirm (
  question = varchar(57) not null,
  no = varchar(1000) not null,
  yes = varchar(1000) not null,
) =
declare
  choice_array = array of choice_line,
  choice_index = integer not null,
  yes_index = integer not null,
  array_size = integer not null,
  fill_array = procedure returning integer not null,
begin
  yes_index = 1 + fill_array(starting_at = 1, explanation = no);
  array_size = fill_array(starting_at = yes_index,
    explanation = yes);

  choice_array[1].choice = 'no';
  choice_array[yes_index].choice = 'yes';
 
  choice_index = callframe look_up (
    ii_rows = array_size,
    ii_array = choice_array,
    ii_field1 = 'choice',
    ii_field2 = 'explanation',
    ii_title = question
  );

  /* If the user selected 'yes', look_up returns yes_index.
  ** If the user selected a blank choice below 'yes'
  ** (which represents a continuation of the explanation for
  ** 'yes'), look_up returns a value greater than yes_index.
  **
  ** If the user selected 'no', look_up returns 1.
  ** If the user selected a blank choice below 'no'
  ** (which represents a continuation of the explanation for 
  ** 'no'), look_up returns a value greater than 1 but less
  ** than yes_index.
  **
  ** If the user canceled the look_up operation,
  ** look_up returns 0 or a negative number.
  */
  if (choice_index >= yes_index) then
    return 'y';
  endif;
  return 'n';
end
/*
** Local procedure: fill_array
** Description:
**
** Fills rows of the array choice_array starting at the
** specified row. The "choice" attributes of the filled-in
** rows are set to ''. The "explanation" attributes of the
** filled-in rows are set to pieces of the specified
** explanation. (The pieces are separated by '\').
** As many rows are filled in as there are pieces in the
** specified explanation.
**
** Input parameters:
**    starting_at     the index of the first row to be filled in.
**    explanation     the explanation to be placed into the
**                    filled-in rows.
** Returns:
**    the index of the last row filled in.
*/
procedure fill_array (
  starting_at = integer not null,
  explanation = varchar(1000) not null,
) =
declare
  x = varchar(1000) not null,
  i = integer not null,
  b = integer not null,
 begin
  x = explanation;
  i = starting_at;
  b = locate(x, '\'); /* sets b to 1001 if no '\' found */
  while (b <= 1000) do
    choice_array[i].choice = '';
    choice_array[i].explanation = left(x, b - 1);
    x = right(x, length(x) - b);
    i = i + 1;
    b = locate(x, '\'); 
  /* sets b to 1001 if no '\' found */
  endwhile;
  choice_array[i].choice = '';
  choice_array[i].explanation = x;
  return i;
end
Last modified date: 08/28/2024