home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: Product
/
Product.zip
/
visilotu.zip
/
RENFLD.PRG
< prev
next >
Wrap
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