OS/2 Shareware BBS: Product/Product.zip/visilotu.zip/RENFLD.PRG

Text File | 1995-08-31 | 9KB | 353 lines

!.HEADER
!
!
! Program Name     - RENFLD.PRG
!
! Program Function - Program Task for the Sample Lotus Notes Query application
!                    This program provides a dialog allowing the user to
!                    modify the names of the Visualizer columns to be created
!                    when querying the Lotus Notes database.
!
!
! Called by        - LNQMAIN.PRG
!
! Calls            - <none>
!
!.spec winsize MAX MAX
!.spec textcol 0 17
!.HEADER
!
! DEFINITION
! Some ASL commands can be placed outside of the normal block
! structure. This block is provided to allow such commands to
! be accomodated
!
! Assign boolean variables
!
DECLARE TASK NUMERIC yes = 1
DECLARE TASK NUMERIC no  = 0
!
DECLARE TASK CHAR[4] ThisTask = A.System.ThisTask
!
! ON SELECT
! This block is triggered whenever the user selects a control
! or menu entry.
!
ON SELECT
DO
  CASE A.System.Object
    !
    WHEN "T.W_renfld.STD_PUSH"
    DO
      CASE A.System.Boxnumber
        WHEN 1                                    ! button marked 'Rename'
        DO
          !
          ! need to validate names


          DEFINE (?pNewNames)[0]                  ! reset the caller's vector
          COPY NewNames,(?pNewNames)              ! and copy ours into it

          LET T..W_RenFld'VISIBLE = No

        END
        !
        WHEN 2                                    ! button marked 'Clear'
        DO
          !
          DEFINE NewNames[0]                      ! reset our vector
          COPY (?pNewNames),NewNames              ! and copy caller's

        END
        !
        WHEN 3                                    ! button marked 'Cancel'
        DO
          LET T..W_RenFld'VISIBLE = No

        END
        !
        WHEN 4                                    ! button marked 'Help'
        DO
          ! help button
          NOTHING
        END
        !
      END
    END
    !
    WHEN "T.W_renfld.LIST1"
    DO
      ! list box set for single select mode
    END
  END
END
!
! ON DATA
! This block responds to controls which can accept data entry.
! It is executed whenever the cursor leaves the control after
! data has been changed. This is normally used to provide input
! validation.
!
ON DATA
DO
  CASE A.System.Object
    !
    WHEN "T.W_RenFld.LIST1"
    DO
      IF A.System.PositionY = 0
        RETURN

      LET ValidName = Valid_ASL_Name(A.System.BoxValue)

      IF ValidName \=""
      DO
        ERROR 10001,ValidName

        LET ValidNames = No

        CALL T.W_RenFld.LIST1'REFRESH()
        RETURN
      END


      LET AlreadyExists = FIND(NewNames,A.System.BoxValue)

      IF AlreadyExists > 0 & A.System.BoxNumber \= AlreadyExists
      DO
        ERROR 10001,STRING(
         "The column ^ already exists. The new name has been reset.",
         A.System.BoxValue)

        CALL T.W_RenFld.LIST1'REFRESH()
        RETURN
      END

      LET NewNames[A.System.BoxNumber] =
       A.System.BoxValue

      CALL T.W_RenFld.LIST1'UNLOCK(A.System.BoxNumber)

    END
  END
END
!
! ON START
! This block is executed when the program is initially invoked.
! It is normally used to initialize variables needed during
! program execution and to open the main window of the
! application.
!
ON START(pOldNames,pNewNames,pSelected,pOwnerWindow)
DO
  DECLARE GLOBAL POINTER pOldNames                  ! pointer to Original column names vector
  DECLARE GLOBAL POINTER pNewNames                  ! pointer to Modified column names vector
  DECLARE GLOBAL POINTER pSelected                  ! pointer to vector for ordering of columns
  DECLARE GLOBAL POINTER pOwnerWindow               ! pointer to ownerwindow
  !
  ! Open the object store holding the user library
  !
  OPEN OBJECTSTORE MyLib,
   NAME ="UserLib.A95",
   LOCATION = S.Control.Path


  LET ValidNames = Yes
  !
  ! Call procedure to define data for list control(s)
  !
  CALL List_Define

  COPY (?pNewNames),NewNames                      ! copy vectors from caller
  COPY (?pOldNames),OldNames
  !
  OPEN WINDOW W_renfld, , "I.Windows.renfld",
   VISIBLE     = No,
   OWNERWINDOW = (?pOwnerWindow)

  !
  ! assign the default push button
  !
  LET T.W_renfld.STD_PUSH[0]'DEFAULT = 1
  !
  ! assign the help button
  !
  LET T.W_renfld.STD_PUSH[0]'HELPBUTTON = 4
  !
  ! assign the column titles for list controlLIST1
  MODIFY T.W_renfld.LIST1,
   COLTITLE1="Title_1",
   ORDERDATA = pSelected                          ! set order for columns in listbox

  LET T..W_renfld'VISIBLE=Yes

END
!
! ON QUIT
! This block is executed when the user uses Close in the
! system menu.
! For a secondary window this would imply, 'shut the window'.
! For a primary window the implication is, 'close the
! Application'.
!
ON QUIT
DO
  CASE A.System.Object

    WHEN "T..W_renfld"                            ! primary window
      LET T..W_RenFld'VISIBLE = No

    OTHERWISE
      SHUT ?A.System.Object

  END
END
!
! ON ENTER
! This block is executed when the user hits the enter key.
! This is normally coded to be equivalent to selecting
! the default push button (often the OK button).
!
ON ENTER
DO
  IF A.System.Object = "T..W_renfld"
  DO
    LET A.System.BoxNumber = T.W_renfld.Std_Push[0]'DEFAULT
    LET A.System.Object = POINTER(T.W_renfld.Std_Push[0])
    RUN PROGRAM ThisTask, SELECT
  END
END
!
! ERROR event
! This block is executed when there is a run-time error.
! You can trap errors here or allow the error message provided
! to identify the error and stop the program.
!

ON ERROR
DO
  DECLARE CHAR[7] ans
  DECLARE NUMERIC i
  !
  ! Message to identify failing module and line
  !
  LET ans = DIALOG("FTB7004", 0,
   A.System.ErrorModule,
   A.System.ErrorLine)

  DO i = 1 : A.System.ErrorNumber[0]'ENTRIES
    IF ans = "CANCEL"
      TERMINATE
      !
      ! Display system message corresponding to error
      !
    LET ans = DIALOG ("FTB" || A.System.Errornumber[i], 0,
     A.System.ErrorInfo[i])
  END

  STOP
END
!
! ON STOP
! This block is executed when the program is terminated.
! You should use the block to carry out any housekeeping
! required before closing
!
ON STOP
DO
  !
  STOP
END
!
! Construct the arrays needed to support list controls
!
PROCEDURE List_Define
DO
  !
  ! Define data to handle list 'T.W_renfld.LIST1'
  !
  DEFINE RColumns[0]                              ! REFERENCE vector
  DEFINE RLayout[0]                               ! EXPRESSION vector
  !
  ! fill the EXPRESSION vector
  !
  INSERT RLayout[0]="WIDTH=100 SEPARATOR=YES JUST=LEFT READONLY=YES"
  INSERT RLayout[0]="WIDTH=100 SEPARATOR=YES JUST=LEFT READONLY=NO"
  !
  ! Initialise the referred vectors. These are the vectors
  ! which will contain the data to be displayed
  !
  DEFINE OldName[0]
  DEFINE NewName[0]
  !
  ! fill the REFERENCE vector to point to these vectors
  !
  INSERT RColumns[0] = "OldNames"
  INSERT RColumns[0] = "NewNames"
  !
  ! create and fill the titles vector
  !
  DEFINE Title_1[0]
  INSERT Title_1[0] = "Old name"
  INSERT Title_1[0] = "New name"
END
!
! ON OPEN
! The OPEN event is signalled whenever the user 'double clicks'
! or opens a LIST control
!
ON OPEN
DO
  IF A.System.Object = "T.W_renfld.LIST1"
  DO
    !
  END
END
! Add your code for this Event below.

ON QUEUE
DO
  DEFINE NewNames[0]
  DEFINE OldNames[0]

  COPY (?pNewNames),NewNames                      ! copy vectors from caller
  COPY (?pOldNames),OldNames


  LET T..W_RenFld'VISIBLE = Yes
END
!
! User specified procedures may have up to 20 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE Valid_ASL_Name(pName)
DO
  DECLARE LOCAL NULL CHARACTER[*] pName
  DECLARE LOCAL CHARACTER[*]      MsgText
  DECLARE LOCAL CHARACTER[37]     ValidChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"

  CASE
    WHEN LENGTH(pName) > 20
      LET MsgText = STRING(
       "The variable name ^ is too long.",
       pName)

    WHEN SCAN(pName,ValidChars,,,"\=","1")>0
      LET MsgText = STRING(
       "The variable name ^ contains invalid characters and has been reset.",
       pName,)

    WHEN NOVALUE(pName)
    DO
      LET MsgText = "Blank column names are not allowed and has been reset."
    END

    OTHERWISE
      LET MsgText = ""
  END

  RETURN MsgText
END