home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
mbug
/
mbug027.arc
/
TTGEN2.INC
< prev
next >
Wrap
Text File
|
1979-12-31
|
6KB
|
201 lines
PROCEDURE displayform;
BEGIN
GotoXY(1,4);
Writeln(' Animal Number : _____ Name : ____________________ Sex : _ ');
Writeln(' Born : __ ___ 19__ Current Age : ');
Writeln(' Died : __ ___ 19__ ');
Writeln(' Sire : ');
Writeln(' Dam : ');
Writeln(' ');
Writeln(' Comment 1 : ________________________________________ ');
Writeln(' Comment 2 : ________________________________________ ');
Writeln(' Comment 3 : ________________________________________ ');
Writeln(' The following is used for Females only. ');
Writeln('Date of Last Mating : __ ___ 19__ Sire : ');
Writeln(' ');
END;
PROCEDURE display_Animal(rab : Animal_rec);
{Displays the Animals information in the correct place on the form}
var
yy,ww,dd : integer;
ok : boolean;
BEGIN
WITH rab DO
BEGIN
dis(23,4, ear_no);
dis(47,4, name);
dis(76,4, sex);
dis(23,5, Date_Born);
yy := 0;
ww := 0;
dd := 0;
verify_date(Date_Born,ok);
if ok then
begin
verify_date(Date_Died,ok);
if ok then age(Date_Born,Date_Died,yy,ww,dd)
else age(Date_Born,Date_Today,yy,ww,dd);
gotoxy(54,5);
if yy > 0 then write(YY:2,' Years ',ww:2,' Weeks ',dd:2,' Days')
else write(ww:2,' Weeks ',dd:2,' Days');
end;
dis(23,6, Date_Died);
dis(23,7, sire);
dis(23,8, dam);
dis(23,10, Comment_1);
dis(23,11, Comment_2);
dis(23,12, Comment_3);
if sex = 'F' then
begin
yy := 0;
ww := 0;
dd := 0;
dis(23,14, Date_Mated);
dis(57,14, Partner);
verify_date(Date_Mated,ok);
if ok then
begin
age(Date_Mated,Date_Today,yy,ww,dd);
if ww < 12 then
begin
dd := dd + (ww * 7);
gotoxy(30,15);
write(dd ,' Days');
end;
end;
end;
END;
END;
PROCEDURE f_table;
{This routine print the numbers along the command line. It only
prints those number which have a name beside them.}
VAR
kx,i : INTEGER;
ch : str1;
BEGIN
kx := 2;
FOR i := 1 TO 6 DO
BEGIN
str(i,ch); {Converts i to a char so it can be printed by DIS}
IF (Animal_table[i].ear_no <> '')
THEN
BEGIN
GotoXY(1,i+18);
ClrEOL;
WITH Animal_table[i] DO
Write(ch,' ',name ,' ':26-Length(name),Ear_No,' ': 14-Length(Ear_No),sex);
dis(kx,17,ch);
END
ELSE
BEGIN
dis(kx,17,' '); {Delete number if Animal has been deleted}
GotoXY(1,i+18);
ClrEOL;
Write(ch);
END;
kx := kx + 4;
END;
END;
PROCEDURE Animals_table(no : INTEGER; Animal : Animal_rec);
BEGIN
Animal_table[no] := Animal;
f_table;
END;
PROCEDURE update_Animal_Table(Animal : Animal_rec);
{Read through the 6 Animals in the table and see if its record number
matches the one that has just been edited. If it does then print the
new information in its place. The record number is used as it is the
only thing that cannot be change in the edit routine.}
VAR
i,l : INTEGER;
BEGIN
FOR i := 1 TO 6 DO
IF Animal.Rec_No = Animal_table[i].Rec_No
THEN
BEGIN
Animals_table(i,Animal);
END;
END;
PROCEDURE InputStr(VAR S : AnyStr;
K,X,Y : INTEGER;
Term : CharSet;
VAR TC : CHAR);
CONST
UnderScore = '_';
VAR
Ch : CHAR;
P : INTEGER;
BEGIN
P := 0;
GotoXY(X + 1,Y + 1);
Write(S,ConstStr(UnderScore,K - Length(S)));
REPEAT
GotoXY(X + P + 1,Y + 1);
Read(Kbd,Ch);
CASE Ch OF
#32..#126 : IF P < K
THEN
BEGIN
IF Length(S) = K
THEN
Delete(S,K,1);
P := P + 1;
Insert(Ch,S,P);
Write(Copy(S,P,K));
END
ELSE Beep;
^S : IF P > 0
THEN
P := P - 1
ELSE Beep;
^D : IF P < Length(S)
THEN
P := P + 1
ELSE Beep;
^A : P := 0;
^F : P := Length(S);
^G : IF P < Length(S)
THEN
BEGIN
Delete(S,P + 1,1);
Write(Copy(S,P + 1,K),UnderScore);
END;
^H,#127 : IF P > 0
THEN
BEGIN
Delete(S,P,1);
Write(^H,Copy(S,P,K),UnderScore);
P := P - 1;
END
ELSE Beep;
^Y : BEGIN
Write(ConstStr(UnderScore,Length(S) - P));
Delete(S,P + 1,K);
END;
ELSE
IF NOT (Ch IN Term)
THEN Beep;
END; {of case}
UNTIL (Ch IN Term) OR (P = K);
P := Length(S);
GotoXY(X + P + 1,Y + 1);
Write('' :K - P);
IF (P = K)
THEN
CASE Ch OF
^M,^E,^Z,#27 : ;
ELSE ch := ^X;
END;
TC := ch;
END;