home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
mbug
/
mbug027.arc
/
GENERAL1.INC
< prev
next >
Wrap
Text File
|
1979-12-31
|
2KB
|
115 lines
PROCEDURE Initialize( VAR Animal : Animal_rec);
BEGIN
WITH Animal DO
BEGIN
Rec_No := -1;
Ear_No := '';
Name := '';
Sex := 'M';
Date_Born := '__ ___ 19__';
Date_died := '__ ___ 19__';
Sire := '!000M';
Dam := '!000F';
Comment_1 := '';
Comment_2 := '';
Comment_3 := '';
Date_Mated := '__ ___ 19__';
Partner := '';
END;
END;
PROCEDURE dis(x,y : INTEGER; s : anystr);
BEGIN
GotoXY(x,y);
GotoXY(x,y);
Write(s);
END;
PROCEDURE DisDate;
BEGIN
dis(2,2,Date_Today);
END;
FUNCTION UpcaseStr(S : Str80) : Str80;
(* UpcaseStr converts a string to upper case *)
VAR
P : INTEGER;
BEGIN
FOR P := 1 TO Length(S) DO
S[P] := UpCase(S[P]);
UpcaseStr := S;
END;
PROCEDURE Beep;
(* Beep sounds the terminal bell or beeper *)
BEGIN
Write(^G);
END;
FUNCTION ConstStr(C : CHAR; N : INTEGER) : Str80;
(* ConstStr returns a string with N characters of value C *)
VAR
S : STRING[80];
BEGIN
IF N < 0
THEN
N := 0;
S[0] := Chr(N);
FillChar(S[1],N,C);
ConstStr := S;
END;
PROCEDURE Select( x,y : INTEGER;
Prompt : Str80;
Term : CharSet;
VAR TC : CHAR );
VAR
Ch : CHAR;
BEGIN
GotoXY(x,y);
Write(Prompt,'?' );
ClrEOL;
REPEAT
Read(Kbd,Ch);
TC := UpCase(Ch);
IF NOT (TC IN Term)
THEN
Beep;
UNTIL TC IN Term;
Write(Ch);
END;
PROCEDURE ClearFrame;
(* ClearFrame clears the display frame, I.E. Lines 3 to 14 *)
VAR
I : INTEGER;
BEGIN
GotoXY(1,4);
FOR I := 4 TO 15 DO
BEGIN
GotoXY(1,I);
ClrEOL ;
END;
END;
PROCEDURE fillup(VAR s : str5);
CONST
zeroes = '00000';
VAR
i : INTEGER;
BEGIN
s := copy(zeroes,1,5 - Length(s)) + s;
END;
PROCEDURE Line(J : INTEGER);
BEGIN
GotoXY(1,j);
Write(constStr(chr(129),79));
GotoXY(1,j+2);
Write(constStr(chr(128),79));
END;