The TYPEOF$ function may be used to identify the type of
an object.
X$=TYPEOF$(instance_name)
In this example, X$ will contain the type name of the given instance.
This is useful when either passing an anonymous class or to determine
if a type is derived from a particular class.
The IS A operator may be used to categorize an instance.
IF Obj_name IS A Class_name THEN ...
If the object is either of the specified class or derived from
it, the IS A operator returns a nonzero (TRUE) value.
For example:
TYPE Tbase
INTEGER A
END TYPE
TYPE Tderived EXTENDS Tbase
INTEGER Q
END TYPE
!
DIM Derived:Tderived,Base:Tbase
DISP "Base is of type ";TYPEOF$(Base)
DISP "Inst is of type ";TYPEOF$(Derived)
DISP "Base is a Tbase =";Base IS A Tbase
DISP "Base is a Tderived =";Base IS A Tderived
DISP "Derived is a Tbase =";Derived IS A Tbase
DISP "Derived is a Tderived =";Derived IS A Tderived
STOP
Even though TYPEOF$ and IS A are available in
Eloquence, you are encouraged to use class methods instead of
non-class independent functions or subprograms which, in turn,
check for different types.
Data base integration
Classes may be used with your Eloquence databases.
The IN DATA SET ... DEFINE TYPE statement will
define a class from the data base schema at runtime.
The
PACK USING,
IN DATA SET LIST, and
IN DATA SET ... USE
commands also support classes.
For example:
DBOPEN(Db$,"",1,S(*))
...
IN DATA SET "CUSTOMER" DEFINE TYPE Tcust
NEW Cust:Tcust
IN DATA SET "CUSTOMER" USE STRUCT Cust
...
DBGET(Db$,"CUSTOMER",7,S(*),"@",Buf$,Key$)
...
Alternatively, a class may also be defined in the program
and then used with the database:
TYPE Tcust
DIM No$[6]
DIM Name$[30]
...
END TYPE
DIM Cust:Tcust
!
DBOPEN(Db$,"",1,S(*))
...
IN DATA SET "CUSTOMER" USE STRUCT Cust
...
DBGET(Db$,"CUSTOMER",7,S(*),"@",Buf$,Key$)
...
XPACK and XUNPACK
The XPACK and XUNPACK statements can operate on
an object.
With these commands, the object is treated as a list of variables.
The XPACK statement packs each member variable in a buffer.
The XUNPACK statement unpacks to an object if
it is passed as an argument to XUNPACK and if
the name of the member variable matches the name in the buffer.
Example programs
This section demonstrates how user defined types might be used
to enhance or replace the current usage of the COMmon block.
! common block
EXPORT TYPE Tglobal
INTEGER Iv
DIM Xv$[18]
INTEGER A(1:2)
END TYPE
!
COM Global:Tglobal
READ STRUCT Global
DATA 123,"COMMON",1,2
!
PRINT "Global.Iv=";Global.Iv
PRINT "Global.Xv$=";Global.Xv$
PRINT "Global.A(*)=";Global.A(1);Global.A(2)
CALL Sub
STOP
!
SUB Sub
COM Global:Tglobal
PRINT "Global.Iv=";Global.Iv
PRINT "Global.Xv$=";Global.Xv$
PRINT "Global.A(*)=";Global.A(1);Global.A(2)
SUBEND
The following example "Custex" demonstrates the use of object-oriented techniques.
! This defines the Custex type. It contains a database name and the dialog name.
! Any member variables are availabe methods.
!
TYPE Custex
DIM Dlg$[40]
DIM Db$[40]
END TYPE
!
! We'll define two label types, each responsible for a particular
! layout. The second one has an additional member (a label counter).
!
TYPE Label
END TYPE
TYPE Label2 EXTENDS Label
INTEGER Cnt
END TYPE
!
ON ERROR CALL Error
!
! Let the user choose which layout should be used,
! then invoke the Cutex Main method.
!
NEW A AS Custex
POPUP BOX "[Label Type][Please choose the|Output layout][Line|Label|Cancel]",R
SELECT R
CASE 1
NEW L AS Label
CASE 2
NEW L AS Label2
CASE ELSE
GOTO Done
END SELECT
CALL A.Main("SAMPLE",STRUCT L)
DELETE A
Done:!
STOP
!
! Handle any kind of failure
!
SUB Error
OFF ERROR
PRINT ERRM$
PRINT ERRMSG$(ERRN)
STOP
SUBEND
!
! This is Custy Main method.
! It knows nothing about how to print.
! It simply calls the Print method of the Out object.
!
SUB Custex:Main(Db$,STRUCT Out)
INTEGER S(1:10)
DIM Buf$[1024]
!
THIS.Db$=" "&Db$
DBOPEN (THIS.Db$,"",9,S(*))
DBASE IS THIS.Db$
IN DATA SET "CUSTOMERS" DEFINE TYPE Cust_t
NEW Cust AS Cust_t
IN DATA SET "CUSTOMERS" USE STRUCT Cust
!
DLG LOAD "Custex.dlg"
THIS.Dlg$="Cust"
WHILE FNTHIS.Search
DISP CHR$(146)&CHR$(175)&CHR$(185)&CHR$(148); ! Clear screen
REFRESH ON ! DLG to see screen buffer
LOOP
DBGET (THIS.Db$,"CUSTOMERS",5,S(*),"@",Buf$,"")
EXIT IF S(1)
CALL Out.Print(STRUCT Cust)
END LOOP
END WHILE
DLG DEL THIS.Dlg$
SUBEND
!
! The Custex Search method handles the matchcode dialog.
! It uses the dialog name contained in the Class.
!
DEF FNCustex:Search
DIM Mcode$[18]
INTEGER Rc,S(1:10)
!
LOOP
DLG DO THIS.Dlg$&".Mcode",Rc
IF Rc=1 THEN RETURN 0
!
DLG GET .Dlg$&".Mcode.content",Mcode$
!
DBFIND (.Db$,"CUSTOMERS",2,S(*),"IMATCHCODE",Mcode$)
IF S(1)=0 THEN RETURN 1
END LOOP
FNEND
!
! This is the Print method of the first Label type
! responsible for layout #1.
!
SUB Label:Print(STRUCT R)
WITH R
PRINT USING "6A,X,30A";.Custno$,.Name1$
END WITH
SUBEND
!
! This is the Print method of the second Label2 type
! responsible for layout #2.
!
SUB Label2:Print(STRUCT R)
THIS.Cnt=THIS.Cnt+1
WITH R
PRINT "-------------------------------------"
PRINT "| #";THIS.Cnt;" ";.Custno$;TAB(36);" |"
PRINT "| ";.Name1$;TAB(36);" |"
PRINT "| ";.Name2$;TAB(36);" |"
PRINT "-------------------------------------"
END WITH
SUBEND
This is the accompanying Custex.dlg file:
Dialog Cust {
.w = 40
.h = 7
.x = -1
.y = -1
.title = "Customer search"
Statictext Prompt {
.x = 2
.y = 2
.text = "Matchcode"
}
Edittext Mcode {
.x = 2
.y = 3
.w = 18
}
Pushbutton OK {
.x = 20
.y = 5
.w = 8
.text = "OK"
.rule = 2
}
Pushbutton Cancel {
.x = 30
.y = 5
.w = 8
.text = "Cancel"
.rule = 1
}
}
