home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Share Gallery 1
/
share_gal_1.zip
/
share_gal_1
/
LA
/
LA010.ZIP
/
EXTPROC1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-05-20
|
2KB
|
133 lines
Procedure Window(Win: Integer);
Begin
TextBackground(Wtab[Win,2]);
If Wtab[Win,3] = 78 Then
TextColor(Wtab[Win,1])
Else
TextColor(Wtab[Win,1] + Blink);
MinX:= Wtab[Win,4];
MinY:= Wtab[Win,5];
MaxX:= Wtab[Win,6];
MaxY:= Wtab[Win,7];
X:= MinX-1;
Y:= MinY;
XY:= (Y-1)*80+X;
GotoXY(X,Y);
End;
Procedure BackTab;
Begin
Sound(Tone);
Delay(40);
NoSound;
Entry_Field:= Entry_Field - 1;
If Entry_Field < 1 Then Entry_Field:= Windows;
Window(Entry_Field);
X:= MaxX;
Y:= MaxY;
XY:= (Y-1)*80+X;
GotoXY(X,Y);
End;
Procedure Tab; Forward;
Procedure Rt1;
Var
EF: Integer; { End of Field }
Begin
EF:= (MaxY-1)*80 + MaxX;
X:= X + 1;
If X > 80 Then Begin
X:= 1;
Y:= Y + 1;
End;
GotoXY(X,Y);
XY:= (Y-1)*80+X;
If XY > EF Then Begin
Tab;
GotoXY(X,Y);
End;
End;
Procedure LT1;
Var
BF: Integer; { beginning of field }
Begin
X:= X - 1;
Bf:= (MinY-1)*80 + MinX;
If X < 1 Then
Begin
X:= 80;
Y:= Y - 1;
End;
GotoXY(X,Y);
XY:= (Y-1)*80+X;
If XY < BF Then BackTab;
End;
Procedure Tab;
Begin
Sound(Tone);
Delay(40);
NoSound;
Entry_Field:= Entry_Field + 1;
If Entry_Field > Windows Then Entry_Field:= 1;
Window(Entry_Field);
Rt1;
End;
Procedure Write_It_In_A_Field (AnyString: Str255);
Begin
For i:= 1 to Length(AnyString) Do Begin
ScrBuf[XY]:= Copy (AnyString, i, 1);
Write (Copy (AnyString, i, 1));
XY:= XY+1;
End;
End; { Procedure Write_It_In_A_Field }
Procedure Blank_Fields;
Var
LOF: Integer; { Length_Of_Field }
Begin
Entry_Field:= 0;
Tone:= 0;
For k:= 0 to Windows Do Begin
Tab;
LOF:= ((MaxY-1)*80 + MaxX) - ((MinY-1)*80 + MinX) + 1;
For i:= 1 to LOF Do Begin
ScrBuf[XY]:= Chr(32);
Write(Chr(32));
XY:= XY+1;
End;
End;
End;
Procedure Banner_Line;
Begin
GotoXY(2,25);
TextColor(Black);
TextBackground(LightGray);
For i:= 1 to 78 Do Write(Chr(32));
GotoXY(2,25);
Write(' f1=Quit f2=Prev f3=Next f4=Del f5=Rec# f8=Backup f0=Accept Record #');
End; { procedure banner_line }