The form definition file is the same as in
Example 1.
SCHEMA shop
MAIN
DEFINE custarr DYNAMIC ARRAY OF RECORD LIKE customer.*
DEFINE op CHAR(1)
DEFINE i INTEGER
DATABASE shop
OPEN FORM f1 FROM "custlist"
DISPLAY FORM f1
DECLARE c1 CURSOR FOR
SELECT id, fname, lname FROM customer ORDER BY id
LET i = 1
FOREACH c1 INTO custarr[i].*
LET i = i + 1
END FOREACH
CALL custarr.deleteElement(custarr.getLength())
INPUT ARRAY custarr FROM sr_cust.*
ATTRIBUTES(WITHOUT DEFAULTS, UNBUFFERED)
BEFORE DELETE
IF op == "N" THEN -- No real SQL delete for new inserted rows
IF NOT mbox_yn("List",
"Are you sure you want to delete this record?",
"question") THEN
CANCEL DELETE -- Keeps row in list
END IF
WHENEVER ERROR CONTINUE
DELETE FROM customer
WHERE ID = custarr[arr_curr()].id
WHENEVER ERROR STOP
IF SQLCA.SQLCODE<0 THEN
ERROR "Could not delete the record from database!"
CANCEL DELETE -- Keeps row in list
END IF
END IF
AFTER DELETE
IF op == "N" THEN
MESSAGE "Record has been deleted successfully"
ELSE
LET op = "N"
END IF
AFTER FIELD fname
IF custarr[arr_curr()].fname MATCHES "*@#$%^&()*" THEN
ERROR "This field contains invalid characters"
NEXT FIELD CURRENT
END IF
ON ROW CHANGE
-- Warning: ON ROW CHANGE can occur if the SQL INSERT failed...
IF op != "I" THEN LET op = "M" END IF
BEFORE INSERT
LET op = "T"
-- (not the best way to get a unique sequence number!)
SELECT MAX(ID)+1 INTO custarr[arr_curr()].id FROM customer
IF custarr[arr_curr()].id IS NULL THEN
LET custarr[arr_curr()].id = 1
END IF
AFTER INSERT
LET op = "I"
BEFORE ROW
LET op = "N"
AFTER ROW
IF int_flag THEN EXIT INPUT END IF
IF op == "M" OR op == "I" THEN
IF custarr[arr_curr()].fname IS NULL
OR custarr[arr_curr()].lname IS NULL
OR custarr[arr_curr()].fname ==
custarr[arr_curr()].lname THEN
ERROR "First name and last name are equal..."
NEXT FIELD fname
END IF
END IF
IF op == "I" THEN
WHENEVER ERROR CONTINUE
INSERT INTO customer (id, fname, lname)
VALUES ( custarr[arr_curr()].* )
WHENEVER ERROR STOP
IF SQLCA.SQLCODE<0 THEN
ERROR "Could not insert the record into database!"
NEXT FIELD CURRENT
ELSE
MESSAGE "Record has been inserted successfully"
END IF
END IF
IF op == "M" THEN
WHENEVER ERROR CONTINUE
UPDATE customer SET
fname = custarr[arr_curr()].fname,
lname = custarr[arr_curr()].lname
WHERE id = custarr[arr_curr()].id
WHENEVER ERROR STOP
IF SQLCA.SQLCODE<0 THEN
ERROR "Could not update the record in database!"
NEXT FIELD CURRENT
ELSE
MESSAGE "Record has been updated successfully"
END IF
END IF
END INPUT
END MAIN
FUNCTION mbox_yn(title,message,icon)
DEFINE title, message, icon STRING
DEFINE r SMALLINT
MENU title ATTRIBUTES(STYLE='dialog',IMAGE=icon,COMMENT=message)
COMMAND "Yes" LET r=TRUE
COMMAND "No" LET r=FALSE
END MENU
RETURN r
END FUNCTION