OS_Develop/dos_compilers
OS_Develop/dos_compilers
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Borland Turbo Pascal v5

Browse Source
This commit is contained in:
davidly 2024-07-02 06:16:37 -07:00
parent 696d36e282
commit 8d991454af
87 changed files with 139484 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

382
Borland Turbo Pascal v5/ARTY.PAS Normal file
View File

@ -0,0 +1,382 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
program Arty;
{ This program is a demonstration of the Borland Graphics Interface
(BGI) provided with Turbo Pascal 5.0.
To run this program you will need the following files:
TURBO.EXE (or TPC.EXE)
TURBO.TPL - The standard units
GRAPH.TPU - The Graphics unit
*.BGI - The graphics device drivers
Runtime Commands for ARTY
-------------------------
<B> - changes background color
<C> - changes drawcolor
<ESC> - exits program
Any other key pauses, then regenerates the drawing
Note: If a /H command-line parameter is specified, the highest
resolution mode will be used (if possible).
}
uses
Crt, Graph;
const
Memory = 100;
Windows = 4;
type
ResolutionPreference = (Lower, Higher);
ColorList = array [1..Windows] of integer;
var
Xmax,
Ymax,
ViewXmax,
ViewYmax : integer;
Line: array [1..Memory] of record
LX1,LY1: integer;
LX2,LY2: integer;
LColor : ColorList;
end;
X1,X2,Y1,Y2,
CurrentLine,
ColorCount,
IncrementCount,
DeltaX1,DeltaY1,DeltaX2,DeltaY2: integer;
Colors: ColorList;
Ch: char;
BackColor:integer;
GraphDriver, GraphMode : integer;
MaxColors : word;
MaxDelta : integer;
ChangeColors: Boolean;
procedure Frame;
begin
SetViewPort(0, 0, Xmax, Ymax-(TextHeight('M')+4)-1,ClipOn);
SetColor(MaxColors);
Rectangle(0, 0, Xmax-1, (Ymax-(TextHeight('M')+4)-1)-1);
SetViewPort(1, 1, Xmax-2, (Ymax-(TextHeight('M')+4)-1)-2,ClipOn);
end { Frame };
procedure FullPort;
{ Set the view port to the entire screen }
begin
SetViewPort(0, 0, Xmax, Ymax, ClipOn);
end; { FullPort }
procedure MessageFrame(Msg:string);
begin
FullPort;
SetColor(MaxColors);
SetTextStyle(DefaultFont, HorizDir, 1);
SetTextJustify(CenterText, TopText);
SetLineStyle(SolidLn, 0, NormWidth);
SetFillStyle(EmptyFill, 0);
Bar(0, Ymax-(TextHeight('M')+4), Xmax, Ymax);
Rectangle(0, Ymax-(TextHeight('M')+4), Xmax, Ymax);
OutTextXY(Xmax div 2, Ymax-(TextHeight('M')+2), Msg);
{ Go back to the main window }
Frame;
end { MessageFrame };
procedure WaitToGo;
var
Ch : char;
begin
MessageFrame('Press any key to continue... Esc aborts');
repeat until KeyPressed;
Ch := ReadKey;
if Ch = #27 then begin
CloseGraph;
Writeln('All done.');
Halt(1);
end
else
ClearViewPort;
MessageFrame('Press a key to stop action, Esc quits.');
end; { WaitToGo }
procedure TestGraphError(GraphErr: integer);
begin
if GraphErr <> grOk then begin
Writeln('Graphics error: ', GraphErrorMsg(GraphErr));
repeat until keypressed;
ch := readkey;
Halt(1);
end;
end;
procedure Init;
var
Err, I: integer;
StartX, StartY: integer;
Resolution: ResolutionPreference;
s: string;
begin
Resolution := Lower;
if paramcount > 0 then begin
s := paramstr(1);
if s[1] = '/' then
if upcase(s[2]) = 'H' then
Resolution := Higher;
end;
CurrentLine := 1;
ColorCount := 0;
IncrementCount := 0;
Ch := ' ';
GraphDriver := Detect;
DetectGraph(GraphDriver, GraphMode);
TestGraphError(GraphResult);
case GraphDriver of
CGA : begin
MaxDelta := 7;
GraphDriver := CGA;
GraphMode := CGAC1;
end;
MCGA : begin
MaxDelta := 7;
case GraphMode of
MCGAMed, MCGAHi: GraphMode := MCGAC1;
end;
end;
EGA : begin
MaxDelta := 16;
If Resolution = Lower then
GraphMode := EGALo
else
GraphMode := EGAHi;
end;
EGA64 : begin
MaxDelta := 16;
If Resolution = Lower then
GraphMode := EGA64Lo
else
GraphMode := EGA64Hi;
end;
HercMono : MaxDelta := 16;
EGAMono : MaxDelta := 16;
PC3270 : begin
MaxDelta := 7;
GraphDriver := CGA;
GraphMode := CGAC1;
end;
ATT400 : case GraphMode of
ATT400C1,
ATT400C2,
ATT400Med,
ATT400Hi :
begin
MaxDelta := 7;
GraphMode := ATT400C1;
end;
end;
VGA : begin
MaxDelta := 16;
end;
end;
InitGraph(GraphDriver, GraphMode, '');
TestGraphError(GraphResult);
SetTextStyle(DefaultFont, HorizDir, 1);
SetTextJustify(CenterText, TopText);
MaxColors := GetMaxColor;
BackColor := 0;
ChangeColors := TRUE;
Xmax := GetMaxX;
Ymax := GetMaxY;
ViewXmax := Xmax-2;
ViewYmax := (Ymax-(TextHeight('M')+4)-1)-2;
StartX := Xmax div 2;
StartY := Ymax div 2;
for I := 1 to Memory do with Line[I] do begin
LX1 := StartX; LX2 := StartX;
LY1 := StartY; LY2 := StartY;
end;
X1 := StartX;
X2 := StartX;
Y1 := StartY;
Y2 := StartY;
end; {init}
procedure AdjustX(var X,DeltaX: integer);
var
TestX: integer;
begin
TestX := X+DeltaX;
if (TestX<1) or (TestX>ViewXmax) then begin
TestX := X;
DeltaX := -DeltaX;
end;
X := TestX;
end;
procedure AdjustY(var Y,DeltaY: integer);
var
TestY: integer;
begin
TestY := Y+DeltaY;
if (TestY<1) or (TestY>ViewYmax) then begin
TestY := Y;
DeltaY := -DeltaY;
end;
Y := TestY;
end;
procedure SelectNewColors;
begin
if not ChangeColors then exit;
Colors[1] := Random(MaxColors)+1;
Colors[2] := Random(MaxColors)+1;
Colors[3] := Random(MaxColors)+1;
Colors[4] := Random(MaxColors)+1;
ColorCount := 3*(1+Random(5));
end;
procedure SelectNewDeltaValues;
begin
DeltaX1 := Random(MaxDelta)-(MaxDelta Div 2);
DeltaX2 := Random(MaxDelta)-(MaxDelta Div 2);
DeltaY1 := Random(MaxDelta)-(MaxDelta Div 2);
DeltaY2 := Random(MaxDelta)-(MaxDelta Div 2);
IncrementCount := 2*(1+Random(4));
end;
procedure SaveCurrentLine(CurrentColors: ColorList);
begin
with Line[CurrentLine] do
begin
LX1 := X1;
LY1 := Y1;
LX2 := X2;
LY2 := Y2;
LColor := CurrentColors;
end;
end;
procedure Draw(x1,y1,x2,y2,color:word);
begin
SetColor(color);
Graph.Line(x1,y1,x2,y2);
end;
procedure Regenerate;
var
I: integer;
begin
Frame;
for I := 1 to Memory do with Line[I] do begin
Draw(LX1,LY1,LX2,LY2,LColor[1]);
Draw(ViewXmax-LX1,LY1,ViewXmax-LX2,LY2,LColor[2]);
Draw(LX1,ViewYmax-LY1,LX2,ViewYmax-LY2,LColor[3]);
Draw(ViewXmax-LX1,ViewYmax-LY1,ViewXmax-LX2,ViewYmax-LY2,LColor[4]);
end;
WaitToGo;
Frame;
end;
procedure Updateline;
begin
Inc(CurrentLine);
if CurrentLine > Memory then CurrentLine := 1;
Dec(ColorCount);
Dec(IncrementCount);
end;
procedure CheckForUserInput;
begin
if KeyPressed then begin
Ch := ReadKey;
if Upcase(Ch) = 'B' then begin
if BackColor > MaxColors then BackColor := 0 else Inc(BackColor);
SetBkColor(BackColor);
end
else
if Upcase(Ch) = 'C' then begin
if ChangeColors then ChangeColors := FALSE else ChangeColors := TRUE;
ColorCount := 0;
end
else if Ch<>#27 then Regenerate;
end;
end;
procedure DrawCurrentLine;
var c1,c2,c3,c4: integer;
begin
c1 := Colors[1];
c2 := Colors[2];
c3 := Colors[3];
c4 := Colors[4];
if MaxColors = 1 then begin
c2 := c1; c3 := c1; c4 := c1;
end;
Draw(X1,Y1,X2,Y2,c1);
Draw(ViewXmax-X1,Y1,ViewXmax-X2,Y2,c2);
Draw(X1,ViewYmax-Y1,X2,ViewYmax-Y2,c3);
if MaxColors = 3 then c4 := Random(3)+1; { alternate colors }
Draw(ViewXmax-X1,ViewYmax-Y1,ViewXmax-X2,ViewYmax-Y2,c4);
SaveCurrentLine(Colors);
end;
procedure EraseCurrentLine;
begin
with Line[CurrentLine] do begin
Draw(LX1,LY1,LX2,LY2,0);
Draw(ViewXmax-LX1,LY1,ViewXmax-LX2,LY2,0);
Draw(LX1,ViewYmax-LY1,LX2,ViewYmax-LY2,0);
Draw(ViewXmax-LX1,ViewYmax-LY1,ViewXmax-LX2,ViewYmax-LY2,0);
end;
end;
procedure DoArt;
begin
SelectNewColors;
repeat
EraseCurrentLine;
if ColorCount = 0 then SelectNewColors;
if IncrementCount=0 then SelectNewDeltaValues;
AdjustX(X1,DeltaX1); AdjustX(X2,DeltaX2);
AdjustY(Y1,DeltaY1); AdjustY(Y2,DeltaY2);
if Random(5)=3 then begin
x1 := (x1+x2) div 2; { shorten the lines }
y2 := (y1+y2) div 2;
end;
DrawCurrentLine;
Updateline;
CheckForUserInput;
until Ch=#27;
end;
begin
Init;
Frame;
MessageFrame('Press a key to stop action, Esc quits.');
DoArt;
CloseGraph;
RestoreCrtMode;
Writeln('The End.');
end.


BIN
Borland Turbo Pascal v5/ATT.BGI Normal file
View File

Binary file not shown.

1422
Borland Turbo Pascal v5/BGIDEMO.PAS Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
Borland Turbo Pascal v5/BGIEXAMP.ARC Normal file
View File

Binary file not shown.

31
Borland Turbo Pascal v5/BGILINK.MAK Normal file
View File

@ -0,0 +1,31 @@
# Build sample program that uses FONTS.TPU and DRIVERS.TPU
bgilink.exe: drivers.tpu fonts.tpu
tpc bgilink /m
# Build unit with all fonts linked in
fonts.tpu: fonts.pas goth.obj litt.obj sans.obj trip.obj
tpc fonts
goth.obj: goth.chr
binobj goth.chr goth GothicFontProc
litt.obj: litt.chr
binobj litt.chr litt SmallFontProc
sans.obj: sans.chr
binobj sans.chr sans SansSerifFontProc
trip.obj: trip.chr
binobj trip.chr trip TriplexFontProc
# Build unit with all drivers linked in
drivers.tpu: drivers.pas cga.obj egavga.obj herc.obj pc3270.obj att.obj
tpc drivers
cga.obj: cga.bgi
binobj cga.bgi cga CGADriverProc
egavga.obj: egavga.bgi
binobj egavga.bgi egavga EGAVGADriverProc
herc.obj: herc.bgi
binobj herc.bgi herc HercDriverProc
pc3270.obj: pc3270.bgi
binobj pc3270.bgi pc3270 PC3270DriverProc
att.obj: att.bgi
binobj att.bgi att ATTDriverProc


126
Borland Turbo Pascal v5/BGILINK.PAS Normal file
View File

@ -0,0 +1,126 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
program BgiLink;
{ This program demonstrates how to link graphics driver and font files
into an EXE file. BGI graphic's drivers and fonts are kept in
separate disk files so they may be dynamically loaded at runtime.
However, sometimes it is preferable to place all auxiliary files
directly into an .EXE. This program, along with its make file
(BGILINK.MAK) and two units (DRIVERS.PAS and FONTS.PAS) links all
the drivers and fonts directly into BGILINK.EXE.
Have these 3 programs in the current drive or directory, or
have them available via a path (both are on Disk II):
MAKE.EXE - Make utility that will build BGILINK.EXE
BINOBJ.EXE - utility program to convert any file into an .OBJ file
Place in the current drive or directory the following files (all
are on Disk III):
BGILINK.PAS - this sample program
DRIVERS.PAS - Pascal unit that will link in all BGI drivers
FONTS.PAS - Pascal unit that will link in all BGI fonts
*.CHR - BGI font files
*.BGI - BGI driver files
BGILINK.MAK - "make" file that builds DRIVERS.TPU, FONT.TPU, and
finally BGILINK.EXE
DIRECTIONS:
1. Run MAKE on the BGILINK.MAK file by typing the following command
at a DOS prompt:
make -fBGIlink.mak
Using BINOBJ.EXE, this will first build .OBJ files out of the driver
files (*.BGI) and then call Turbo Pascal to compile DRIVERS.PAS.
Next, the font files (*.CHR) will be converted to .OBJs and
FONTS.PAS will be compiled. Finally, BGILINK.PAS will be compiled
(it uses DRIVERS.TPU and FONTS.TPU).
2. Run BGILINK.EXE. It contains all the drivers and all the fonts, so it
will run on any system with a graphics card supported by the Graph
unit (CGA, EGA, EGA 64 K, EGA monochrome, Hercules monochrome,
VGA, MCGA, IBM 3270 PC and AT&T 6400).
EXPLANATION
BGILINK.PAS uses DRIVERS.TPU and FONTS.TPU in its uses statement:
uses Drivers, Fonts;
Then, it "registers" the drivers it intends to use (in this case,
all of them, so it will run on any graphics card). Then it registers
all of the fonts it will use (again all of them, just for demonstration
purposes) and finally it does some very modest graphics.
You can easily modify BGILINK.PAS for your own use by commenting out
the calls to RegisterBGIdriver and RegisterBGIfont for drivers and
fonts that your program doesn't use.
For a detailed explanation of registering and linking drivers and fonts,
refer to the RegisterBGIdriver and RegisterBGIfont descriptions in
GRAPH.DOC (on Disk III).
}
uses Graph, { library of graphics routines }
Drivers, { all the BGI drivers }
Fonts; { all the BGI fonts }
var
GraphDriver, GraphMode, Error : integer;
procedure Abort(Msg : string);
begin
Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
Halt(1);
end;
begin
{ Register all the drivers }
if RegisterBGIdriver(@CGADriverProc) < 0 then
Abort('CGA');
if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
Abort('EGA/VGA');
if RegisterBGIdriver(@HercDriverProc) < 0 then
Abort('Herc');
if RegisterBGIdriver(@ATTDriverProc) < 0 then
Abort('AT&T');
if RegisterBGIdriver(@PC3270DriverProc) < 0 then
Abort('PC 3270');
{ Register all the fonts }
if RegisterBGIfont(@GothicFontProc) < 0 then
Abort('Gothic');
if RegisterBGIfont(@SansSerifFontProc) < 0 then
Abort('SansSerif');
if RegisterBGIfont(@SmallFontProc) < 0 then
Abort('Small');
if RegisterBGIfont(@TriplexFontProc) < 0 then
Abort('Triplex');
GraphDriver := Detect; { autodetect the hardware }
InitGraph(GraphDriver, GraphMode, ''); { activate graphics }
if GraphResult <> grOk then { any errors? }
begin
Writeln('Graphics init error: ', GraphErrorMsg(GraphDriver));
Halt(1);
end;
MoveTo(5, 5);
OutText('Drivers and fonts were ');
MoveTo(5, 20);
SetTextStyle(GothicFont, HorizDir, 4);
OutText('Built ');
SetTextStyle(SmallFont, HorizDir, 4);
OutText('into ');
SetTextStyle(TriplexFont, HorizDir, 4);
OutText('EXE ');
SetTextStyle(SansSerifFont, HorizDir, 4);
OutText('file!');
Rectangle(0, 0, GetX, GetY + TextHeight('file!') + 1);
Readln;
CloseGraph;
end.


BIN
Borland Turbo Pascal v5/BINOBJ.EXE Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/CGA.BGI Normal file
View File

Binary file not shown.

24
Borland Turbo Pascal v5/CIRCULAR.PAS Normal file
View File

@ -0,0 +1,24 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
program Circular;
{ Simple program that demonstrates newly-permitted circular
unit references via a USES clause in the implementation
section.
Note that it is NOT possible for the two units to
"USE" each other in their interface sections. It is possible
for AA's interface to use BB, and BB's implementation to use
AA, but this is tricky and depends on compilation order. We
won't document or recommend it.
}
uses
Crt, Display, Error;
begin
ClrScr;
WriteXY(1, 1, 'Upper left');
WriteXY(100, 100, 'Off the screen');
WriteXY(81 - Length('Back to reality'), 15, 'Back to reality');
end.


75
Borland Turbo Pascal v5/CPASDEMO.C Normal file
View File

@ -0,0 +1,75 @@
/* Copyright (c) 1985, 88 by Borland International, Inc.
This module demonstrates how to write Turbo C routines that
can be linked into a Turbo Pascal program. Routines in this
module call Turbo Pascal routines in CPASDEMO.PAS.
See the instructions in the file CPASDEMO.PAS on running
this demonstration program */
typedef unsigned int word;
typedef unsigned char byte;
typedef unsigned long longword;
extern void setcolor(byte newcolor); /* procedure defined in
Turbo Pascal program */
extern word factor; /* variable declared in Turbo Pascal program */
word sqr(int i)
{
setcolor(1);
return(i * i);
} /* sqr */
word hibits(word w)
{
setcolor(2);
return(w >> 8);
} /* hibits */
byte suc(byte b)
{
setcolor(3);
return(++b);
} /* suc */
byte upr(byte c)
{
setcolor(4);
return((c >= 'a') && (c <= 'z') ? c - 32 : c);
} /* upr */
char prd(char s)
{
setcolor(5);
return(--s);
} /* prd */
long lobits(long l)
{
setcolor(6);
return((longword)l & 65535);
} /* lobits */
void strupr(char far *s)
{
int counter;
for (counter = 1; counter <= s[0]; counter++) /* Note that the routine */
s[counter] = upr(s[counter]); /* skips Turbo Pascal's */
setcolor(7); /* length byte */
} /* strupr */
byte boolnot(byte b)
{
setcolor(8);
return(b == 0 ? 1 : 0);
} /* boolnot */
word multbyfactor(word w)
{
setcolor(9); /* note that this function accesses the Turbo Pascal */
return(w * factor); /* declared variable factor */
} /* multbyfactor */


126
Borland Turbo Pascal v5/CPASDEMO.PAS Normal file
View File

@ -0,0 +1,126 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
program CPASDEMO;
(*
This program demonstrates how to interface Turbo Pascal and Turbo C.
Turbo C is used to generate an .OBJ file (CPASDEMO.OBJ). Then
this .OBJ is linked into this Turbo Pascal program using the {$L}
compiler directive.
NOTES:
1. Data declared in the Turbo C module cannot be accessed from
the Turbo Pascal program. Shared data must be declared in
Pascal.
2. If the C functions are only used in the implementation section
of a unit, declare them NEAR. If they are declared in the
interface section of a unit, declare them FAR. Always compile
the Turbo C modules using the small memory model.
3. Turbo C runtime library routines cannot be used because their
modules do not have the correct segment names. However, if you have
the Turbo C runtime library source (available from Borland),
you can use individual library modules by recompiling
them using CTOPAS.BAT. If you do recompile them, make sure
that you include prototypes in your C module for all C
library functions that you use.
4. Some of the code that Turbo C generates are calls to internal
routines. These cannot be used without recompiling the relevant
parts of the Turbo C runtime library source code.
In order to run this demonstration program you will need the following
files:
TCC.EXE and TURBO.CFG or
TC.EXE and CTOPAS.TC
To run the demonstration program CPASDEMO.EXE do the following:
1. First create a CPASDEMO.OBJ file compatible with Turbo Pascal 5.0
using Turbo C.
a) If you are using the Turbo C integrated environment (TC.EXE)
then at the DOS prompt execute:
TC /CCTOPAS.TC CPASDEMO.C
then create the .OBJ file by pressing ALT-F9.
b) If you are using the Turbo C command line version (TCC.EXE)
then at the DOS prompt execute:
TCC CPASDEMO.C
Note: Use the same configuration file (TURBO.CFG or CTOPAS.TC)
when you create your own Turbo C modules for use with
Turbo Pascal 5.0
2. Compile and execute the Turbo Pascal program CPASDEMO.PAS
This simple program calls each of the functions defined in the Turbo C
module. Each of the Turbo C functions changes the current display color
by calling the Turbo Pascal procedure SetColor.
*)
uses Crt;
var
Factor : Word;
{$L CPASDEMO.OBJ} { link in the Turbo C-generated .OBJ module }
function Sqr(I : Integer) : Word; external;
{ Change the text color and return the square of I }
function HiBits(W : Word) : Word; external;
{ Change the text color and return the high byte of W }
function Suc(B : Byte) : Byte; external;
{ Change the text color and return B + 1 }
function Upr(C : Char) : Char; external;
{ Change the text color and return the upper case of C }
function Prd(S : ShortInt) : ShortInt; external;
{ Change the text color and return S - 1 }
function LoBits(L : LongInt) : LongInt; external;
{ Change the text color and return the low word of L }
procedure StrUpr(var S : string); external;
{ Change the text color and return the upper case of S - Note that the Turbo }
{ C routine must skip the length byte of the string. }
function BoolNot(B : Boolean) : Boolean; external;
{ Change the text color and return NOT B }
function MultByFactor(W : Word) : Word; external;
{ Change the text color and return W * Factor - note Turbo C's access of }
{ Turbo Pascal's global variable. }
procedure SetColor(NewColor : Byte); { A procedure that changes the current }
begin { display color by changing the CRT }
TextAttr := NewColor; { variable TextAttr }
end; { SetColor }
var
S : string;
begin
Writeln(Sqr(10)); { Call each of the functions defined }
Writeln(HiBits(30000)); { passing it the appropriate info. }
Writeln(Suc(200));
Writeln(Upr('x'));
Writeln(Prd(-100));
Writeln(LoBits(100000));
S := 'abcdefg';
StrUpr(S);
Writeln(S);
Writeln(BoolNot(False));
Factor := 100;
Writeln(MultbyFactor(10));
SetColor(LightGray);
end.


147
Borland Turbo Pascal v5/CRTDEMO.PAS Normal file
View File

@ -0,0 +1,147 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
program CrtDemo;
{ Example program that uses the Crt unit. Uses the following routines
from the Crt unit:
ClrScr
DelLine
GoToXY
InsLine
KeyPressed
ReadKey
TextBackground
TextColor
TextMode
WhereX
WhereY
Window
Write
WriteLn;
Also uses LastMode and WindMax variables from Crt unit.
1. Init routine:
- Save original video mode. On an EGA or VGA, use the 8x8 font
(43 lines on an EGA, 50 on VGA).
- Setup LastRow to preserve last line on screen for messages
(preserves last 2 lines in 40-column mode). Setup LastCol.
- Initialize the random number generator.
2. MakeWindow routine:
- Puts up random-sized, random-colored windows on screen.
3. Program body:
- Call Init
- Loop until Contrl-C is typed:
- Echo keystrokes (Turbo Pascal windows automatically wrap
and scroll).
- Support special keys:
<Ins> inserts a line at the cursor
<Del> deletes a line at the cursor
<Up>,
<Dn>,
<Right>,
<Left> position the cursor in the window
<Alt-R> generate random text until a key is pressed
<Alt-W> creates another random window
<ESC> exits the program
}
uses Crt;
var
OrigMode,LastCol,LastRow: Word;
Ch: Char;
Done: Boolean;
procedure Initialize;
{ Initialize the video mode, LastCol, LastRow, and the random number }
{ generator. Paint the help line. }
begin
CheckBreak:=False; { turn off Contrl-C checking }
OrigMode:=LastMode; { Remember original video mode }
TextMode(Lo(LastMode)+Font8x8); { use 43 or 50 lines on EGA/VGA }
LastCol:=Lo(WindMax)+1; { get last column, row }
LastRow:=Hi(WindMax)+1;
GoToXY(1,LastRow); { put message line on screen }
TextBackground(Black);
TextColor(White);
Write(' Ins-InsLine ',
'Del-DelLine ',
#27#24#25#26'-Cursor ',
'Alt-W-Window ',
'Alt-R-Random ',
'Esc-Exit');
Dec(LastRow,80 div LastCol); { don't write on message line }
Randomize; { init random number generator }
end; { Init }
procedure MakeWindow;
{ Make a random window, with random background and foreground colors }
var
X,Y,Width,Height: Word;
begin
Width:=Random(LastCol-2)+2; { random window size }
Height:=Random(LastRow-2)+2;
X:=Random(LastCol-Width)+1; { random position on screen }
Y:=Random(LastRow-Height)+1;
Window(X,Y,X+Width,Y+Height);
if OrigMode = Mono then
begin
TextBackground(White);
TextColor(Black);
ClrScr;
Window(X+1,Y+1,X+Width-1,Y+Height-1);
TextBackground(Black);
TextColor(White);
ClrScr;
end
else
begin
TextBackground(Random(8));
TextColor(Random(7)+9);
end;
ClrScr;
end; { MakeWindow }
procedure RandomText;
{ Generate random text until a key is pressed. Filter out }
{ control characters. }
begin
repeat
Write(Chr(Random(256-32)+32));
until KeyPressed;
end; { RandomText }
begin { program body }
Initialize;
MakeWindow;
Done:=False;
repeat
Ch:=ReadKey;
case Ch of
#0: { Function keys }
begin
Ch:=ReadKey;
case Ch of
#17: MakeWindow; { Alt-W }
#19: RandomText; { Alt-R }
#45: Done:=True; { Alt-X }
#72: GotoXY(WhereX,WhereY-1); { Up }
#75: GotoXY(WhereX-1,WhereY); { Left }
#77: GotoXY(WhereX+1,WhereY); { Right }
#80: GotoXY(WhereX,WhereY+1); { Down }
#82: InsLine; { Ins }
#83: DelLine; { Del }
end;
end;
#3: Done:=True; { Ctrl-C }
#13: WriteLn; { Enter }
#27: Done:=True; { Esc }
else
Write(Ch);
end;
until Done;
TextMode(OrigMode);
end.


BIN
Borland Turbo Pascal v5/CTOPAS.TC Normal file
View File

Binary file not shown.

239
Borland Turbo Pascal v5/DIRDEMO.PAS Normal file
View File

@ -0,0 +1,239 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
program DirDemo;
{ Demonstration program that shows how to use:
o Directory routines from DOS unit
o Procedural types (used by QuickSort)
Usage:
dirdemo [options] [directory mask]
Options:
-W Wide display
-N Sort by file name
-S Sort by file size
-T Sort by file date and time
Directory mask:
Path, Filename, wildcards, etc.
}
{$I-,S-}
{$M 8192,8192,655360}
uses Dos;
const
MaxDirSize = 512;
MonthStr: array[1..12] of string[3] = (
'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
type
DirPtr = ^DirRec;
DirRec = record
Attr: Byte;
Time: Longint;
Size: Longint;
Name: string[12];
end;
DirList = array[0..MaxDirSize - 1] of DirPtr;
LessFunc = function(X, Y: DirPtr): Boolean;
var
WideDir: Boolean;
Count: Integer;
Less: LessFunc;
Path: PathStr;
Dir: DirList;
function NumStr(N, D: Integer): String;
begin
NumStr[0] := Chr(D);
while D > 0 do
begin
NumStr[D] := Chr(N mod 10 + Ord('0'));
N := N div 10;
Dec(D);
end;
end;
{$F+}
function LessName(X, Y: DirPtr): Boolean;
begin
LessName := X^.Name < Y^.Name;
end;
function LessSize(X, Y: DirPtr): Boolean;
begin
LessSize := X^.Size < Y^.Size;
end;
function LessTime(X, Y: DirPtr): Boolean;
begin
LessTime := X^.Time > Y^.Time;
end;
{$F-}
procedure QuickSort(L, R: Integer);
var
I, J: Integer;
X, Y: DirPtr;
begin
I := L;
J := R;
X := Dir[(L + R) div 2];
repeat
while Less(Dir[I], X) do Inc(I);
while Less(X, Dir[J]) do Dec(J);
if I <= J then
begin
Y := Dir[I];
Dir[I] := Dir[J];
Dir[J] := Y;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then QuickSort(L, J);
if I < R then QuickSort(I, R);
end;
procedure GetCommand;
var
I,J: Integer;
Attr: Word;
S: PathStr;
D: DirStr;
N: NameStr;
E: ExtStr;
F: File;
begin
WideDir := False;
@Less := nil;
Path := '';
for I := 1 to ParamCount do
begin
S := ParamStr(I);
if S[1] = '-' then
for J := 2 to Length(S) do
case UpCase(S[J]) of
'N': Less := LessName;
'S': Less := LessSize;
'T': Less := LessTime;
'W': WideDir := True;
else
WriteLn('Invalid option: ', S[J]);
Halt(1);
end
else
Path := S;
end;
Path := FExpand(Path);
if Path[Length(Path)] <> '\' then
begin
Assign(F, Path);
GetFAttr(F, Attr);
if (DosError = 0) and (Attr and Directory <> 0) then
Path := Path + '\';
end;
FSplit(Path, D, N, E);
if N = '' then N := '*';
if E = '' then E := '.*';
Path := D + N + E;
end;
procedure FindFiles;
var
F: SearchRec;
begin
Count := 0;
FindFirst(Path, ReadOnly + Directory + Archive, F);
while (DosError = 0) and (Count < MaxDirSize) do
begin
GetMem(Dir[Count], Length(F.Name) + 10);
Move(F.Attr, Dir[Count]^, Length(F.Name) + 10);
Inc(Count);
FindNext(F);
end;
end;
procedure SortFiles;
begin
if (Count <> 0) and (@Less <> nil) then
QuickSort(0, Count - 1);
end;
procedure PrintFiles;
var
I, P: Integer;
Total: Longint;
T: DateTime;
N: NameStr;
E: ExtStr;
begin
WriteLn('Directory of ', Path);
if Count = 0 then
begin
WriteLn('No matching files');
Exit;
end;
Total := 0;
for I := 0 to Count-1 do
with Dir[I]^ do
begin
P := Pos('.', Name);
if P > 1 then
begin
N := Copy(Name, 1, P - 1);
E := Copy(Name, P + 1, 3);
end else
begin
N := Name;
E := '';
end;
Write(N, ' ': 9 - Length(N), E, ' ': 4 - Length(E));
if WideDir then
begin
if Attr and Directory <> 0 then
Write(' DIR')
else
Write((Size + 1023) shr 10: 3, 'k');
if I and 3 <> 3 then
Write(' ': 3)
else
WriteLn;
end else
begin
if Attr and Directory <> 0 then
Write('<DIR> ')
else
Write(Size: 8);
UnpackTime(Time, T);
WriteLn(T.Day: 4, '-',
MonthStr[T.Month], '-',
NumStr(T.Year mod 100, 2),
T.Hour: 4, ':',
NumStr(T.Min, 2));
end;
Inc(Total, Size);
end;
if WideDir and (Count and 3 <> 0) then WriteLn;
WriteLn(Count, ' files, ', Total, ' bytes, ',
DiskFree(Ord(Path[1])-64), ' bytes free');
end;
begin
GetCommand;
FindFiles;
SortFiles;
PrintFiles;
end.


27
Borland Turbo Pascal v5/DISPLAY.PAS Normal file
View File

@ -0,0 +1,27 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit Display;
{ Sample unit for CIRCULAR.PAS }
interface
procedure WriteXY(x, y : integer; s : string);
implementation
uses
Crt, Error;
procedure WriteXY(x, y : integer; s : string);
begin
if (x in [1..80]) and (y in [1..25]) then
begin
GoToXY(x, y);
Write(s);
end
else
ShowError('Invalid WriteXY coordinates');
end;
end.


94
Borland Turbo Pascal v5/DOC/CRT.DOC Normal file
View File

@ -0,0 +1,94 @@
{*******************************************************}
{ }
{ Turbo Pascal Version 5.0 }
{ CRT Interface Unit }
{ }
{ Copyright (C) 1987,88 Borland International }
{ }
{*******************************************************}
unit Crt;
{$D-,I-,S-}
interface
const
{ CRT modes }
BW40 = 0; { 40x25 B/W on Color Adapter }
CO40 = 1; { 40x25 Color on Color Adapter }
BW80 = 2; { 80x25 B/W on Color Adapter }
CO80 = 3; { 80x25 Color on Color Adapter }
Mono = 7; { 80x25 on Monochrome Adapter }
Font8x8 = 256; { Add-in for ROM font }
{ Mode constants for 3.0 compatibility }
C40 = CO40;
C80 = CO80;
{ Foreground and background color constants }
Black = 0;
Blue = 1;
Green = 2;
Cyan = 3;
Red = 4;
Magenta = 5;
Brown = 6;
LightGray = 7;
{ Foreground color constants }
DarkGray = 8;
LightBlue = 9;
LightGreen = 10;
LightCyan = 11;
LightRed = 12;
LightMagenta = 13;
Yellow = 14;
White = 15;
{ Add-in for blinking }
Blink = 128;
var
{ Interface variables }
CheckBreak: Boolean; { Enable Ctrl-Break }
CheckEOF: Boolean; { Enable Ctrl-Z }
DirectVideo: Boolean; { Enable direct video addressing }
CheckSnow: Boolean; { Enable snow filtering }
LastMode: Word; { Current text mode }
TextAttr: Byte; { Current text attribute }
WindMin: Word; { Window upper left coordinates }
WindMax: Word; { Window lower right coordinates }
{ Interface procedures }
procedure AssignCrt(var F: Text);
function KeyPressed: Boolean;
function ReadKey: Char;
procedure TextMode(Mode: Integer);
procedure Window(X1,Y1,X2,Y2: Byte);
procedure GotoXY(X,Y: Byte);
function WhereX: Byte;
function WhereY: Byte;
procedure ClrScr;
procedure ClrEol;
procedure InsLine;
procedure DelLine;
procedure TextColor(Color: Byte);
procedure TextBackground(Color: Byte);
procedure LowVideo;
procedure HighVideo;
procedure NormVideo;
procedure Delay(MS: Word);
procedure Sound(Hz: Word);
procedure NoSound;

152
Borland Turbo Pascal v5/DOC/DOS.DOC Normal file
View File

@ -0,0 +1,152 @@
{*******************************************************}
{ }
{ Turbo Pascal Version 5.0 }
{ DOS Interface Unit }
{ }
{ Copyright (C) 1987,88 Borland International }
{ }
{*******************************************************}
unit Dos;
{$D-,I-,S-}
interface
const
{ Flags bit masks }
FCarry = $0001;
FParity = $0004;
FAuxiliary = $0010;
FZero = $0040;
FSign = $0080;
FOverflow = $0800;
{ File mode magic numbers }
fmClosed = $D7B0;
fmInput = $D7B1;
fmOutput = $D7B2;
fmInOut = $D7B3;
{ File attribute constants }
ReadOnly = $01;
Hidden = $02;
SysFile = $04;
VolumeID = $08;
Directory = $10;
Archive = $20;
AnyFile = $3F;
type
{ String types }
ComStr = string[127]; { Command line string }
PathStr = string[79]; { Full file path string }
DirStr = string[67]; { Drive and directory string }
NameStr = string[8]; { File name string }
ExtStr = string[4]; { File extension string }
{ Registers record used by Intr and MsDos }
Registers = record
case Integer of
0: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Word);
1: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
end;
{ Typed-file and untyped-file record }
FileRec = record
Handle: Word;
Mode: Word;
RecSize: Word;
Private: array[1..26] of Byte;
UserData: array[1..16] of Byte;
Name: array[0..79] of Char;
end;
{ Textfile record }
TextBuf = array[0..127] of Char;
TextRec = record
Handle: Word;
Mode: Word;
BufSize: Word;
Private: Word;
BufPos: Word;
BufEnd: Word;
BufPtr: ^TextBuf;
OpenFunc: Pointer;
InOutFunc: Pointer;
FlushFunc: Pointer;
CloseFunc: Pointer;
UserData: array[1..16] of Byte;
Name: array[0..79] of Char;
Buffer: TextBuf;
end;
{ Search record used by FindFirst and FindNext }
SearchRec = record
Fill: array[1..21] of Byte;
Attr: Byte;
Time: Longint;
Size: Longint;
Name: string[12];
end;
{ Date and time record used by PackTime and UnpackTime }
DateTime = record
Year,Month,Day,Hour,Min,Sec: Word;
end;
var
{ Error status variable }
DosError: Integer;
function DosVersion: Word;
procedure Intr(IntNo: Byte; var Regs: Registers);
procedure MsDos(var Regs: Registers);
procedure GetDate(var Year,Month,Day,DayOfWeek: Word);
procedure SetDate(Year,Month,Day: Word);
procedure GetTime(var Hour,Minute,Second,Sec100: Word);
procedure SetTime(Hour,Minute,Second,Sec100: Word);
procedure GetCBreak(var Break: Boolean);
procedure SetCBreak(Break: Boolean);
procedure GetVerify(var Verify: Boolean);
procedure SetVerify(Verify: Boolean);
function DiskFree(Drive: Byte): Longint;
function DiskSize(Drive: Byte): Longint;
procedure GetFAttr(var F; var Attr: Word);
procedure SetFAttr(var F; Attr: Word);
procedure GetFTime(var F; var Time: Longint);
procedure SetFTime(var F; Time: Longint);
procedure FindFirst(Path: PathStr; Attr: Word; var F: SearchRec);
procedure FindNext(var F: SearchRec);
procedure UnpackTime(P: Longint; var T: DateTime);
procedure PackTime(var T: DateTime; var P: Longint);
procedure GetIntVec(IntNo: Byte; var Vector: Pointer);
procedure SetIntVec(IntNo: Byte; Vector: Pointer);
procedure SwapVectors;
procedure Keep(ExitCode: Word);
procedure Exec(Path: PathStr; ComLine: ComStr);
function DosExitCode: Word;
function FSearch(Path: PathStr; DirList: String): PathStr;
function FExpand(Path: PathStr): PathStr;
procedure FSplit(Path: PathStr; var Dir: DirStr;
var Name: NameStr; var Ext: ExtStr);
function EnvCount: Integer;
function EnvStr(Index: Integer): String;
function GetEnv(EnvVar: String): String;


453
Borland Turbo Pascal v5/DOC/HELPME!.DOC Normal file
View File

@ -0,0 +1,453 @@
TURBO PASCAL 5.0: ANSWERS TO COMMON QUESTIONS
---------------------------------------------
1. Can I build programs bigger than 64K?
The total size of a program's code is only limited by the
memory you have available; but each unit (module) can be
no larger than 64K, since it has to have its own code
segment.
The data segment is still no more than 64K, but the heap
is unlimited just as in 3.0. In fact, we've rewritten the
heap manager to make it much more efficient. There's no
waste when allocating memory (in 3.0, all blocks were
rounded up to a factor of 8), and you can install a heap
error routine that gets called if an allocation request
fails. All in all, 5.0's heap manager is much faster than
version 3.0.
2. Can Turbo Pascal run on generic MS-DOS machines?
TPC.EXE will run on generic machines when you use the /Q
option. The System, Overlay, Dos, and Printer standard
units will operate correctly on MS-DOS generic machines.
Generated .EXE's are MS-DOS compatible as long as you
don't use the special PC units (such as Crt, Graph, and
Graph3).
3. Does Turbo Pascal 5.0 support large integers?
Yes, TP 5.0 has virtually every incarnation of 8-, 16-, and
32-bit integers: shortint, integer, longint, byte, and
word.
4. Will the toolboxes for 4.0 work with 5.0?
Yes, all 4.0 versions of the toolboxes will work with
Turbo Pascal 5.0. In a few cases, minor changes to
compiler directives are recommended. Refer to the Turbo
Pascal README file for more information.
5. Does Turbo Pascal version 5.0 support conditional
compilation?
Yes, Turbo 5.0 includes conditional compilation support.
You use {$DEFINE ...} and {$UNDEF ...} for symbols and
{$IFDEF ...}. Using the {$IFOPT ...} conditional
directive, you can even test the settings of compiler
directives like R-, N+, and others. For the command-line
compiler, you can define symbols with the /D directive. In
the integrated compiler, you can also define symbols via
the Options/Compiler/Conditional Defines menu command.
6. How much of the 64K in the data segment is actually
available to my program?
The amount of data segment used by the run-time library
depends on which standard units you use in your program.
Here is the data segment usage (in bytes) for each unit:
UNIT Data Size
---- ---------
System 664
Overlay 10
Crt 20
Dos 6
Printer 256
Graph 1070
Turbo3 256
Graph3 0
=========
2282
The total size of the data segment is 65,520 bytes. If you
used only the System unit, the amount of data segment
space left over would be
65520 - 664 = 64856 bytes
7. What is the largest global data structure you can
allocate?
The maximum size of a single variable that can be
allocated on the heap is 65,521 bytes.
8. How do I find out how much code and data were generated by
the compiler for a program or unit?
If you are using the integrated environment, build your
program or unit and then use the Get Info command in the
Compile menu. This will bring up a window of information
that includes the size of code and data.
If you are using the command-line compiler, the size of
generated code and data is displayed on the screen at the
end of compilation.
9. Are the .OBJ files generated by Turbo C and Turbo
Assembler compatible with 5.0?
You can write Turbo C or Turbo Assembler routines and link
the .OBJ files into your Turbo Pascal programs by using
{$L} compiler directives. Turbo Pascal 5.0 generates .TPU
(Turbo Pascal Unit) files, not .OBJ files. We've made that
decision for many reasons:
A. TP 5.0's .TPU files are smaller than .OBJ's, and they
contain symbolic information important to the support
of Pascal's strict type conventions (types, constants,
etc.).
B. .TPU files allow "smart linking" - elimination of
unused code and data on a procedure-by-procedure
basis.
C. .TPU's allow built-in project management through
version 5.0's Make and Build commands.
D. .TPU's allow faster compilation speeds (34,000 lines
per minute on a PS/2 Model 60).
10. Will the $L compiler directive work for compiler object files
other than assembler?
That depends on the language. TURBO requires all the code
in the .OBJ to be in *one* CODE segment, and all the data
to be in *one* DATA segment. With assembly language that's
easy, but it may not work with some high-level language
compilers. You can use Turbo C to generate .OBJ files for
use by Turbo Pascal programs. An example, CPASDEMO.PAS is
included on the distribution disks.
11. Does the built-in linker eliminate unused data?
Yes. Unused code AND data are stripped when you compile to
disk.
12. If two units use a third unit, does the third unit get
included twice in my program?
No. All your units are "linked" together when you compile
your program. Only one copy of each procedure and function
used is generated. There is NO duplication of run-time
code. In fact, Turbo Pascal 5.0 has "smart linking," which
eliminates any unused code and data from the final .EXE.
13. What happens if you attempt to link another unit in which the
compiler directives are set differently?
Compiler directives are local to the unit they are
declared in. Thus, the compiler directives in one unit, or
in the main program, have no effect on the directives set
in another unit.
14. Can I create my own .TPL file?
Yes, but Turbo Pascal will only use the TURBO.TPL library
file. If you want to add your own units to the TURBO.TPL
file, you can use the unit mover program (TPUMOVER.EXE).
For example, you might want a customized version of
TURBO.TPL for each of the programs you're developing. A
corresponding configuration file for Turbo Pascal would
specify a different Turbo directory and thus fetch the
appropriate .TPL file for each of your projects.
15. What rules should I follow when writing an interrupt
handler?
The following is a list of rules to keep in mind when
writing an interrupt handler:
A. Use GetIntVec and SetIntVec to install/uninstall
interrupt handlers
B. Use the interrupt directive
C. Be careful about reentrancy. Don't use any calls to
DOS or to Turbo Pascal's overlay or heap management
routines in your interrupt handler
D. Interrupt procedures and functions must use the far
call model (use the {$F+} option)
E. Be proficient with the BIOS and assembly language
before attempting to write an interrupt handler
F. Make sure your interrupt handler is not in an
overlaid unit.
16. Does a procedure or function in a program have to be of a
near or far call model?
If you are using overlays or procedural variables, you
should probably turn {$F+} on for all units and the main
program (the extra overhead of always using far calls is
usually quite small).
Otherwise, Turbo Pascal automatically selects the correct
call model. A routine is always a near call model unless
1) it is declared in the interface section of a unit
2) you override the default call model by using the {$F+}
compiler option
You should also use the {$F+} option to override the
default call model if you are writing interrupt handlers,
error handlers, or exit procedures.
17. How do I write reentrant code in Turbo Pascal?
If a routine follows these rules, it is reentrant:
A. All data is allocated on the stack.
B. The routine doesn't use any global variables.
C. The routine can be interrupted at any time without
affecting the execution of the routine.
D. The routine doesn't call any other routines that are
not reentrant (e.g., DOS I/O).
18. What is the best approach to taking advantage of the new IEEE
floating-point types?
The new IEEE floating-point types are available when you
compile your program with {$N+} and you have a math
coprocessor; they are also available if you don't have a
coprocessor, but specify {N+,E+}. The 8087 emulator has
greater precision, but is significantly slower than the
fast, 6-byte, software-only reals. When developing
programs that will be compiled and run on machines without
the 8087 coprocessor, consider the trade-offs of speed
(built-in reals) vs. precision (8087 hardware/emulation)
and make the appropriate choice.
19. What type is Comp? What is it useful for?
The Comp type is a cross between an integer and a real
type and is available when 8087 code is generated {$N+}.
If no math coprocessor is available, specify {$N+,E+} and
the emulator will support the Comp type.
The compiler treats it as a real type without an exponent.
Thus Comp is useful when you need to store extremely large
numbers but don't need a decimal point. For example, you
might use variables of type Comp to store amounts in cents
and divide the value of the variable by 100 to determine
what the value in dollars and cents would be.
20. How many significant digits do the 8087 floating-point types
provide?
Type Digits of precision
-------- -------------------
single 7-8
double 15-16
extended 19-20
comp 19-20
21. Are the intermediate results of real number expressions
stored in the 8087 registers?
No. The user (8086) stack is used to store intermediate
results of real number expressions.
22. How does rounding work with IEEE floating point?
The 8087 math coprocessor uses a different method for
rounding numbers than what you may be used to. In order to
achieve a more even distribution of values, the 8087 uses
a method sometimes called "Banker's Rounding." This method
dictates that a number will always be rounded to the
nearest EVEN number. Note that this is quite different
than always rounding UP. Here are a couple of examples:
Round(0.5) = 0
Round(1.5) = 2
23. How do you do I/O redirection?
If you want to do DOS I/O redirection when running an .EXE
file generated by Turbo Pascal, DON'T use the Crt unit.
If you do, make sure you assign a text file variable to
the standard DOS output device.
Assign(Output,''); { assign a text file variable }
{ to a null file name }
ReWrite(Output); { do a rewrite here }
Any Write statement that does not specify a file variable
will be redirected to the DOS standard output file. You
can also Write(Output,...).
24. How do you go about upgrading version 3.0 programs with
lots of chain files?
Chaining is not possible with .EXE files. Control can be
passed to another program by use of the EXEC procedure in
the DOS unit. You can also use 5.0's overlay manager to
build very large programs.
25. Are overlays supported in 5.0?
Yes! See the example program OVRDEMO.PAS and refer to the
Turbo Pascal manual for information on overlays.
26. Is there any support in Turbo Pascal 5.0 for file and record
locking?
There's a standard variable in the System unit called
FileMode, which you can use to assign an open mode for use
in all subsequent Resets. There are no record-locking
routines implemented in the standard version, but they are
easily implemented through MsDos calls.
27. Does Turbo 5.0 support procedure parameters?
Yes. See PROCVAR.PAS, DIRDEMO.PAS, and refer to the
Reference Guide for a complete description.
28. Can you use identifiers other than scalar in the case statement?
As with Turbo Pascal 3.0 and 4.0, case statements allow
the following ordinal types: Char, Boolean, Integer, and
user-defined enumeration.
29. Is the run-time license policy the same as in version 3.0?
YES, there are no royalties!
30. What about a debugger, who has one for 5.0?
There is a built-in debugger in version 5.0. In addition,
you can use the Turbo Debugger on .EXE files generated by
Turbo Pascal 5.0. Finally, you can use any debugger that
can process .MAP files (see the Options/Linker menu).
31. C has static variables, is there anything similar in 5.0?
You can declare private global variables in the
implementation part of a unit. Such variables are only
visible within that unit. Like other globals, they retain
their values across calls.
Typed constant declarations declared within a procedure or
function also behave exactly like C's static variables.
They are local in scope but since they are allocated in
the data segment, they retain their values from call to
call.
32. What Turbo Pascal 3.0 code will cause the most problems
converting to version 5.0?
With our UPGRADE program (see appropriate Appendix in your
manual), it's not very difficult to port your code to 5.0.
It depends a lot on the type of programs you write.
The passing of parameters on the stack is done much more
efficiently now, so changes will have to be made to inline
machine code and assembly language. Most of the changes
are optional: using new types, breaking your program into
modules to take advantage of separate compilation. (The
UPGRADE program has a special option to help you "unitize"
your program too. It does all the "typing" for you.)
Some stricter type-checking is performed in version 5.0.
For example, the Dos unit now defines the often-seen
registers record type (AX, BX...); MsDos and Intr now take
this type. In this case, you can type-cast or change the
type identifier and recompile.
33. How do I use .BIN files provided by third-party vendors with
5.0?
We've included a utility on your distribution disk called
BINOBJ.EXE, which converts binary files into .OBJ files
that are linkable to your Turbo Pascal 5.0 programs. In
general this will only work if the binary files contain
data, not code. Contact your third-party vendor to see if
they also provide .OBJ versions of their programs.
34. Why does TURBO sometimes try to read from another drive
when I run it?
When you leave Turbo Pascal, it saves the name and path of
the file you were last editing in a pick list. The next
time you load Turbo, it checks this pick list and tries to
load the file you were last editing. If the file you were
last editing was in another drive, Turbo will try to read
from that drive. This also occurs if you have installed
another drive as your Turbo Directory.
35. Does Turbo Pascal 5.0 support EMS?
Yes, Turbo Pascal 5.0 will use up to 64K of EMS for
storing the edit buffer. In addition, you can instruct the
Overlay unit to place your overlaid units on EMS. Finally,
EMS.PAS on the distribution disk shows you how to access
EMS memory.
36. How can I allocate my own I/O buffer for a text file?
You can use the procedure SetTextBuf to allocate your own
text file buffer either in the data segment or on the
heap.
37. Why aren't the new settings used after I install TURBO.EXE
using the TINST.EXE program?
You probably have a .TP file in the current or Turbo
directory being loaded and the settings in the .TP file
override the settings installed by TINST. Delete the .TP
file.
38. Is the string size limit still 255 characters?
Yes, it's just like in 3.0; you can write your own
routines to handle greater than 255 character strings.
39. Can I still write to file 'Con' without changes?
The 'Con' file is gone, but you can still write to the
screen with a simple Write with no file variable. The file
system has been completely redesigned to allow you to
write your own text file device drivers. With these, you can
implement a Pascal-like text-file interface to any device,
such as serial ports, windowing systems, memory, etc.
40. What is constant merging?
For example, when you use the same string constant more
than once in a program block, the compiler only saves one
copy of this string. In the generated program, a pointer
is created that references the one copy of this string in
the generated .EXE file.
41. Have Turbo Pascal 3.0 run-time error codes changed in
Turbo Pascal 5.0?
Yes, error codes have changed; refer to Appendix I in the
Reference Guide. The Turbo3 unit contains a version 3.0
compatible IOResult function.
42. What books can I read that will help me with Turbo Pascal
5.0?
The Turbo Pascal Tutor is an excellent reference to Turbo
Pascal. Also, Osborne/McGraw Hill has a line of books
about Borland's products.


34
Borland Turbo Pascal v5/DOC/OVERLAY.DOC Normal file
View File

@ -0,0 +1,34 @@
{*******************************************************}
{ }
{ Turbo Pascal Version 5.0 }
{ Overlay Interface Unit }
{ }
{ Copyright (C) 1987,88 Borland International }
{ }
{*******************************************************}
unit Overlay;
{$D-,I-,S-}
interface
const
ovrOk = 0;
ovrError = -1;
ovrNotFound = -2;
ovrNoMemory = -3;
ovrIOError = -4;
ovrNoEMSDriver = -5;
ovrNoEMSMemory = -6;
var
OvrResult: Integer;
procedure OvrInit(FileName: String);
procedure OvrInitEMS;
procedure OvrSetBuf(Size: LongInt);
function OvrGetBuf: LongInt;
procedure OvrClearBuf;

19
Borland Turbo Pascal v5/DOC/PRINTER.DOC Normal file
View File

@ -0,0 +1,19 @@
{*******************************************************}
{ }
{ Turbo Pascal Version 5.0 }
{ Printer Interface Unit }
{ }
{ Copyright (C) 1987,88 Borland International }
{ }
{*******************************************************}
unit Printer;
{$D-,I-,S-}
interface
var
Lst: Text;

61
Borland Turbo Pascal v5/DOC/SYSTEM.DOC Normal file
View File

@ -0,0 +1,61 @@
{*******************************************************}
{ }
{ Turbo Pascal Runtime Library Version 5.0 }
{ System Unit }
{ }
{ Copyright (C) 1987,88 Borland International }
{ }
{*******************************************************}
unit System;
interface
const
OvrCodeList: Word = 0; { Overlay code segment list }
OvrHeapSize: Word = 0; { Initial overlay buffer size }
OvrDebugPtr: Pointer = nil; { Overlay debugger hook }
OvrHeapOrg: Word = 0; { Overlay buffer origin }
OvrHeapPtr: Word = 0; { Overlay buffer pointer }
OvrHeapEnd: Word = 0; { Overlay buffer end }
OvrLoadList: Word = 0; { Loaded overlays list }
OvrDosHandle: Word = 0; { Overlay DOS handle }
OvrEmsHandle: Word = 0; { Overlay EMS handle }
HeapOrg: Pointer = nil; { Heap origin }
HeapPtr: Pointer = nil; { Heap pointer }
FreePtr: Pointer = nil; { Free list pointer }
FreeMin: Word = 0; { Minimum free list size }
HeapError: Pointer = nil; { Heap error function }
ExitProc: Pointer = nil; { Exit procedure }
ExitCode: Integer = 0; { Exit code }
ErrorAddr: Pointer = nil; { Runtime error address }
PrefixSeg: Word = 0; { Program segment prefix }
StackLimit: Word = 0; { Stack pointer low limit }
InOutRes: Integer = 0; { I/O result buffer }
RandSeed: Longint = 0; { Random seed }
FileMode: Byte = 2; { File open mode }
Test8087: Byte = 0; { 8087 test result }
var
Input: Text; { Input standard file }
Output: Text; { Output standard file }
SaveInt00: Pointer; { Saved interrupt $00 }
SaveInt02: Pointer; { Saved interrupt $02 }
SaveInt1B: Pointer; { Saved interrupt $1B }
SaveInt23: Pointer; { Saved interrupt $23 }
SaveInt24: Pointer; { Saved interrupt $24 }
SaveInt34: Pointer; { Saved interrupt $34 }
SaveInt35: Pointer; { Saved interrupt $35 }
SaveInt36: Pointer; { Saved interrupt $36 }
SaveInt37: Pointer; { Saved interrupt $37 }
SaveInt38: Pointer; { Saved interrupt $38 }
SaveInt39: Pointer; { Saved interrupt $39 }
SaveInt3A: Pointer; { Saved interrupt $3A }
SaveInt3B: Pointer; { Saved interrupt $3B }
SaveInt3C: Pointer; { Saved interrupt $3C }
SaveInt3D: Pointer; { Saved interrupt $3D }
SaveInt3E: Pointer; { Saved interrupt $3E }
SaveInt3F: Pointer; { Saved interrupt $3F }
SaveInt75: Pointer; { Saved interrupt $75 }


334
Borland Turbo Pascal v5/DOC/THELP.DOC Normal file
View File

@ -0,0 +1,334 @@
TURBO HELP UTILITY
------------------
This file explains how to use THELP.COM. THELP is a
memory-resident utility that provides online help for Turbo
Pascal and Turbo C. If you are using Turbo Debugger, for
example, you can load THELP, then run the debugger and get
online help for Pascal or C while you are debugging.
Table of Contents
-----------------
1. Starting THELP
2. Command-line Options Summary
3. Detailed Explanation of Keys Used When THELP is Active
4. Detailed Explanation of Command-line Options
1. Starting THELP
------------------
Load THELP at the DOS command-line simply by typing THELP.
Make sure the Turbo help file (TURBO.HLP for Turbo Pascal,
TCHELP.TCH for TURBO C) is in the current directory or use the /F
commandline option described below.
Memory Usage - THELP requires about 8K bytes (+ 32K swap file);
40K with no swapping.
Default hotkey - The default hotkey is Numeric-Keypad-5 (scan
code 4ch, shift state 00h).
Paste speed - The default pasting speed is FAST. You'll have
to experiment if it pastes too quickly for your
editor. Note that you should turn off autoindent
in the integrated environment before using the
paste feature (Ctrl-Q I toggles autoindent).
If you are using SideKick Plus or SideKick 1.x, make sure you
load THELP before you load SideKick.
2. Command-line Options Summary
-------------------------------
USAGE: THELP [options]
Here is a summary of the command line options. If you use more
than one option, they must be separated by spaces.
/B Use BIOS for video
/C#xx Select color: #=color number, xx=hex color value
/Dname Full path for disk swapping (implies /S1)
/Fname Full path and filename of help file
/H,/?,? Display this help screen
/Kxxyy Change hotkey: xx=shift state, yy=scan code
/Lxx Force number of rows on screen: xx=25,43,50
/M+,/M- Display help text: on monochrome screen(+),
on default screen(-)
/Px Pasting speed: 0=slow, 1=medium, 2=fast
/R Send options to resident THELP
/Sx Default Swapping Mode: 1=Use Disk, 2=Use EMS,
3=No Swapping
/U Remove THELP from memory
/W Write Options to THELP.COM and exit
3. Detailed Explanation of Keys Used When THELP is Active
---------------------------------------------------------
Arrow keys: Move the highlight from item to item within the
current help screen.
PgUp/PgDn: Move from screen to screen if additional screens
are available.
ENTER: Select help entry for the item highlighted in the
current help screen.
ESC: End Help.
F1: Help Index. F1 from any help screen brings up
the Help Index.
ALT-F1: Displays in reverse order the last 20 screens you
have reviewed.
CTL-F1: Bring up help screen for THELP's hot keys.
F key: Select new help file. 'F' or 'f' brings up a
window that allows you to change help files on the
fly. Type in the complete path name of the new
help file, and it will be read into memory and
initialized to the help index of the new file
(Page 100). If the new file does not exist, or is
in an invalid format, THELP will beep twice, and
return you to the original file.
J key: Jump to specified help page number. 'J' or 'j'
brings up a window that allows you to jump to any
particular page (9999 max) in the help file. The
only editing key permitted in this window is
BackSpace. ESC aborts, CR (or four digits)
completes.
K key: Search help file for specified keyword. 'K' or 'k'
brings up a window in which you can enter a
keyword (40 characters max), and have THELP search
the help file for a match. If there is no matching
keyword in the current help file, THELP will beep
twice and return you to the original help screen.
I key: Paste highlighted keyword into application. 'I' or
'i' inserts the current highlighted keyword into
the keyboard buffer, and immediately pops down.
P key: Paste entire help screen into application. 'P' or
'p' inserts the entire current help page (as it
appears in the help window) into the current
application, and then immediately pops down.
Pasting can be interrupted with ^C or ^Break.
S Key: Save help screen to disk file (THELP.SAV). 'S' or
's' from any help screen saves the current help
page to the disk file THELP.SAV, in the current
directory. If the file already exists, the new
help information is appended to the end.
<Hotkey Combo>
Pressing the hotkey combination when using THELP
on a second monitor ends this session of the
resident help, but leaves the current help screen
on the monochrome monitor.
4. Detailed Explanation of Command-line Options
------------------------------------------------
/B -- Use BIOS for video
This option forces THELP to use Interrupt 10h BIOS video calls
for all writing to/reading from the video display. Normally, THELP
will write directly to video RAM. Note that the use of this
option negates the effect of the /M switch described below; the
alternate monitor may not be used if /B is in effect. This option
is enabled with '/B+', and disabled with '/B-' (enable is the
default).
/C#xx Select color: #=color number, xx=hex color value
There are eight possible colors, described as follows:
1 = Color Normal Text
2 = Monochrome Normal Text
3 = Color Possible reference pages; top/bottom description line
4 = Monochrome Possible reference pages; top/bottom description line
5 = Color Border Color
6 = Monochrome Border Color
7 = Color Current Reference Selection
8 = Monochrome Current Reference Selection
Any or all of these eight colors may be specified on the command
line.
The color numbers for a standard IBM-compatible Color Display are
as follows:
First Digit (Background) Second Digit (Foreground)
0 -- Black 0 -- Black
1 -- Blue 1 -- Blue
2 -- Green 2 -- Green
3 -- Cyan 3 -- Cyan
4 -- Red 4 -- Red
5 -- Magenta 5 -- Magenta
6 -- Brown 6 -- Brown
7 -- Grey 7 -- Grey
8 -- Intense Black
ORing the color value with 9 -- Intense Blue
Hex 80 produces a blinking A -- Intense Green
color unless blinking has been B -- Intense Cyan
disabled. C -- Intense Red
D -- Intense Magenta
E -- Intense Brown (Yellow)
F -- Intense Grey (White)
On Monochrome monitors, the attribute values can differ widely,
so some experimentation would be needed. Note that the monochrome
attributes are used in only two cases; when the current video
mode is 7, or when force mono is used (see the /M option)
/Dname -- Full path for disk swapping (implies /S1)
This option is used to override where THELP will place its swap
files when swapping to disk. A full path should be specified,
but a trailing '\' is not necessary. If no /D option is
specified, under DOS 3.x swap files are placed in the directory
where THELP.COM resides. Under DOS 2.x, swap files are placed by
default in C:\.
Using this option also sets the flag that forces disk swapping
instead of checking first for EMS.
/Fname -- Full path and filename of help file
The name that follows the /F option should be the full
drive/directory pathname of the help file to use; e.g.,
THELP /FC:\TP\TURBO.HLP
THELP /FC:\TURBOC\TCHELP.TCH
By default, THELP looks for the help file on the logged drive and
directory.
/H,/?,? -- Display help screen
This option displays a summary of THELP's command-line options
/Kxxyy -- Change hotkey: xx=shift state, yy=scan code
Virtually any shift state/scan code combination may be selected.
A quick summary of some common shift-states and scan codes
follows:
Shift States (may be OR'ed together)
right shift 01h
left shift 02h
control 04h
alt 08h
Scan Codes
A --- 1eh N --- 31h 0 --- 0bh F1 --- 3bh
B --- 30h O --- 18h 1 --- 02h F2 --- 3ch
C --- 2eh P --- 19h 2 --- 03h F3 --- 3dh
D --- 20h Q --- 10h 3 --- 04h F4 --- 3eh
E --- 12h R --- 13h 4 --- 05h F5 --- 3fh
F --- 21h S --- 1fh 5 --- 06h F6 --- 40h
G --- 22h T --- 14h 6 --- 07h F7 --- 41h
H --- 23h U --- 16h 7 --- 08h F8 --- 42h
I --- 17h V --- 2fh 8 --- 09h F9 --- 43h
J --- 24h W --- 11h 9 --- 0ah F10 --- 44h
K --- 25h X --- 2dh
L --- 26h Y --- 15h
M --- 32h Z --- 2ch
Enhanced Keyboards only (may not work with all computers,
keyboards)
F11 --- 57h
F12 --- 58h
/Lxx -- Force number of rows on screen: xx=25,43,50
Some video adapters do not correctly store the number of video
rows on the screen in the BIOS data location specified for the
IBM-PC. This option forces THELP to use the given value, rather
than the number the BIOS reports.
/M+,/M- -- Display help text: on monochrome screen(+),
on default screen(-)
For users with dual-monitor systems, this option may be used to
instruct THELP to bring up its display on the monochrome monitor,
rather than on the color monitor. This option is enabled with
'/M+', and disabled with '/M-' (enable is the default). Note that
/M is incompatible with /B (see above).
/Px -- Pasting speed: 0=slow, 1=medium, 2=fast
Some editors do not accept characters pasted into the keyboard
buffer as fast as THELP can put them there. By setting an
appropriate paste speed, virtually all possible configurations of
editors may be used. FAST speed pastes as many characters as will
fit on every timer tick; MEDIUM pastes up to four characters per
tick; and SLOW pastes a single character into the buffer ONLY
when the buffer is empty.
/R -- Send options to resident THELP
The /R option is used to pass parameters (like new colors, or new
hotkeys) to the resident portion of THELP. All THELP command-line
options may be sent to the resident portion except for the
swapping mode, which cannot be modified once THELP has been
initialized.
In combination with these options, you can create a batch file
that changes THELP's configuration as you change editors; i.e.:
THELP /M /P0 /FC:\TP\TURBO.HLP /R
Use mono monitor, slow pasting, and the Turbo Pascal help
file. Options are not saved to disk.
THELP /P2 /FC:\TC\TCHELP.TCH /R
Use default monitor, fast pasting, and the Turbo C help file.
Options are not saved to disk.
/Sx -- Default Swapping Mode: 1=Use Disk, 2=Use EMS,
3=No Swapping
If no '/S' parameter is used, THELP first tests to see if
Expanded Memory is available in the system. If so, and if enough
memory can be allocated, swapping is done to EMS. If EMS is not
available, disk swapping is used. See the /D parameter for
information on where the swap file will be written if disk
swapping is used.
/U -- Remove THELP from memory
This option is used to remove THELP from memory. If other TSRs
have been loaded after THELP, make sure to remove them before
removing THELP.
/W -- Write Options to THELP.COM and exit
The /W parameter is used to create a new version of THELP that
uses the options you desire as a default. All options, including
/S (but not /R) may be specified and made 'permanent'.


27
Borland Turbo Pascal v5/DOS_GT.PAS Normal file
View File

@ -0,0 +1,27 @@
type
regpack = record
ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
end;
procedure get_time( var tt : timetype );
var
recpack: registers;
ahigh: byte;
begin
ahigh := $2c;
with recpack do
begin
ax := ahigh shl 8;
end;
intr( $21, recpack );
with recpack do
begin
tt.h := cx shr 8;
tt.m := cx mod 256;
tt.s := dx shr 8;
tt.l := dx mod 256;
end;
end;

35
Borland Turbo Pascal v5/DRIVERS.PAS Normal file
View File

@ -0,0 +1,35 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit Drivers;
{ Sample unit to accompany BGILINK.PAS. This unit links the BGI graphics
driver into a single TPU file. This makes it easy to link the driver files
directly into an .EXE file. See BGILINK.PAS for more information.
}
interface
procedure ATTDriverProc;
procedure CgaDriverProc;
procedure EgaVgaDriverProc;
procedure HercDriverProc;
procedure PC3270DriverProc;
implementation
procedure ATTDriverProc; external;
{$L ATT.OBJ }
procedure CgaDriverProc; external;
{$L CGA.OBJ }
procedure EgaVgaDriverProc; external;
{$L EGAVGA.OBJ }
procedure HercDriverProc; external;
{$L HERC.OBJ }
procedure PC3270DriverProc; external;
{$L PC3270.OBJ }
end.


42
Borland Turbo Pascal v5/E.PAS Normal file
View File

@ -0,0 +1,42 @@
program e;
const
DIGITS = 200;
type
arrayType = array[ 0..DIGITS ] of integer;
var
high, n, x : integer;
a : arrayType;
begin
high := DIGITS;
x := 0;
n := high - 1;
while n > 0 do begin
a[ n ] := 1;
n := n - 1;
end;
a[ 1 ] := 2;
a[ 0 ] := 0;
while high > 9 do begin
high := high - 1;
n := high;
while 0 <> n do begin
a[ n ] := x MOD n;
x := 10 * a[ n - 1 ] + x DIV n;
n := n - 1;
end;
Write( x );
end;
writeln;
writeln( 'done' );
end.


BIN
Borland Turbo Pascal v5/EGAVGA.BGI Normal file
View File

Binary file not shown.

439
Borland Turbo Pascal v5/EMS.PAS Normal file
View File

@ -0,0 +1,439 @@
program Ems_Test;
{ *************************************************************
* This program shows you how to use the basic functions of *
* the LIM Expanded Memory Specification. Since it does not *
* use any of the LIM EMS 4.0 function calls, you can also *
* use it on systems with EMS versions less than 4.0 *
************************************************************* }
{ Written by:
Peter Immarco.
Thought Dynamics
Manhattan Beach, CA
Compuserve ID# 73770,123
*** Public Domain ***
Used by permission of the author.
}
{ This program does the following:
+------------------------------------------------------------+
| * Makes sure the LIM Expanded Memory Manager (EMM) has |
| been installed in memory |
| * Displays the version number of the EMM present in memory |
| * Determines if there are enough pages (16k blocks) of |
| memory for our test program's usage. It then displays |
| the total number of EMS pages present in the system, |
| and how many are available for our usage |
| * Requests the desired number of pages from the EMM |
| * Maps a logical page onto one of the physical pages given |
| to us |
| * Displays the base address of our EMS memory page frame |
| * Performs a simple read/write test on the EMS memory given|
| to us |
| * Returns the EMS memory given to us back to the EMM, and |
| exits |
+------------------------------------------------------------|}
{ All the calls are structured to return the result or error
code of the Expanded Memory function performed as an integer.
If the error code is not zero, which means the call failed,
a simple error procedure is called and the program terminates.}
uses Crt, Dos;
Type
ST3 = string[3];
ST80 = string[80];
ST5 = string[5];
Const
EMM_INT = $67;
DOS_Int = $21;
GET_PAGE_FRAME = $41;
GET_UNALLOCATED_PAGE_COUNT= $42;
ALLOCATE_PAGES = $43;
MAP_PAGES = $44;
DEALLOCATE_PAGES = $45;
GET_VERSION = $46;
STATUS_OK = 0;
{ We'll say we need 1 EMS page for our application }
APPLICATION_PAGE_COUNT = 1;
Var
Regs: Registers;
Emm_Handle,
Page_Frame_Base_Address,
Pages_Needed,
Physical_Page,
Logical_Page,
Offset,
Error_Code,
Pages_EMS_Available,
Total_EMS_Pages,
Available_EMS_Pages: Word;
Version_Number,
Pages_Number_String: ST3;
Verify: Boolean;
{ * --------------------------------------------------------- * }
{ The function Hex_String converts an Word into a four
character hexadecimal number(string) with leading zeroes. }
Function Hex_String(Number: Word): ST5;
Function Hex_Char(Number: Word): Char;
Begin
If Number<10 then
Hex_Char:=Char(Number+48)
else
Hex_Char:=Char(Number+55);
end; { Function Hex_Char }
Var
S: ST5;
Begin
S:='';
S:=Hex_Char( (Number shr 1) div 2048);
Number:=( ((Number shr 1) mod 2048) shl 1)+
(Number and 1) ;
S:=S+Hex_Char(Number div 256);
Number:=Number mod 256;
S:=S+Hex_Char(Number div 16);
Number:=Number mod 16;
S:=S+Hex_Char(Number);
Hex_String:=S+'h';
end; { Function Hex_String }
{ * --------------------------------------------------------- * }
{ The function Emm_Installed checks to see if the Expanded
Memory Manager (EMM) is loaded in memory. It does this by
looking for the string 'EMMXXXX0', which should be located
at 10 bytes from the beginning of the code segment pointed
to by the EMM interrupt, 67h }
Function Emm_Installed: Boolean;
Var
Emm_Device_Name : string[8];
Int_67_Device_Name : string[8];
Position : Word;
Regs : registers;
Begin
Int_67_Device_Name:='';
Emm_Device_Name :='EMMXXXX0';
with Regs do
Begin
{ Get the code segment pointed to by Interrupt 67h, the EMM
interrupt by using DOS call $35, 'get interrupt vector' }
AH:=$35;
AL:=EMM_INT;
Intr(DOS_int,Regs);
{ The ES pseudo-register contains the segment address pointed
to by Interrupt 67h }
{ Create an 8 character string from the 8 successive bytes
pointed to by ES:$0A (10 bytes from ES) }
For Position:=0 to 7 do
Int_67_Device_Name:=
Int_67_Device_Name+Chr(mem[ES:Position+$0A]);
Emm_Installed:=True;
{ Is it the EMM manager signature, 'EMMXXXX0'? then EMM is
installed and ready for use, if not, then the EMM manager
is not present }
If Int_67_Device_Name<>Emm_Device_Name
then Emm_Installed:=False;
end; { with Regs do }
end; { Function Emm_Installed }
{ * --------------------------------------------------------- * }
{ This function returns the total number of EMS pages present
in the system, and the number of EMS pages that are
available for our use }
Function EMS_Pages_Available
(Var Total_EMS_Pages,Pages_Available: Word): Word;
Var
Regs: Registers;
Begin
with Regs do
Begin
{ Put the desired EMS function number in the AH pseudo-
register }
AH:=Get_Unallocated_Page_Count;
intr(EMM_INT,Regs);
{ The number of EMS pages available is returned in BX }
Pages_Available:=BX;
{ The total number of pages present in the system is
returned in DX }
Total_EMS_Pages:=DX;
{ Return the error code }
EMS_Pages_Available:=AH
end;
end; { EMS_Pages_Available }
{ * --------------------------------------------------------- * }
{ This function requests the desired number of pages from the
EMM }
Function Allocate_Expanded_Memory_Pages
(Pages_Needed: Word; Var Handle: Word ): Word;
Var
Regs: Registers;
Begin
with Regs do
Begin
{ Put the desired EMS function number in the AH pseudo-
register }
AH:= Allocate_Pages;
{ Put the desired number of pages in BX }
BX:=Pages_Needed;
intr(EMM_INT,Regs);
{ Our EMS handle is returned in DX }
Handle:=DX;
{ Return the error code }
Allocate_Expanded_Memory_Pages:=AH;
end;
end; { Function Allocate_Expanded_Memory_Pages }
{ * --------------------------------------------------------- * }
{ This function maps a logical page onto one of the physical
pages made available to us by the
Allocate_Expanded_Memory_Pages function }
Function Map_Expanded_Memory_Pages
(Handle,Logical_Page,Physical_Page: Word): Word;
Var
Regs: Registers;
Begin
with Regs do
Begin
{ Put the desired EMS function number in the AH pseudo-
register }
AH:=Map_Pages;
{ Put the physical page number to be mapped into AL }
AL:=Physical_Page;
{ Put the logical page number to be mapped in BX }
BX:=Logical_Page;
{ Put the EMS handle assigned to us earlier in DX }
DX:=Handle;
Intr(EMM_INT,Regs);
{ Return the error code }
Map_Expanded_Memory_Pages:=AH;
end; { with Regs do }
end; { Function Map_Expanded_Memory_Pages }
{ * --------------------------------------------------------- * }
{ This function gets the physical address of the EMS page
frame we are using. The address returned is the segment
of the page frame. }
Function Get_Page_Frame_Base_Address
(Var Page_Frame_Address: Word): Word;
Var
Regs: Registers;
Begin
with Regs do
Begin
{ Put the desired EMS function number in the AH pseudo-
register }
AH:=Get_Page_Frame;
intr(EMM_INT,Regs);
{ The page frame base address is returned in BX }
Page_Frame_Address:=BX;
{ Return the error code }
Get_Page_Frame_Base_Address:=AH;
end; { Regs }
end; { Function Get_Page_Frame_Base_Address }
{ * --------------------------------------------------------- * }
{ This function releases the EMS memory pages allocated to
us, back to the EMS memory pool. }
Function Deallocate_Expanded_Memory_Pages
(Handle: Word): Word;
Var
Regs: Registers;
Begin
with Regs do
Begin
{ Put the desired EMS function number in the AH pseudo-register }
AH:=DEALLOCATE_PAGES;
{ Put the EMS handle assigned to our EMS memory pages in DX }
DX:=Emm_Handle;
Intr(EMM_INT,Regs);
{ Return the error code }
Deallocate_Expanded_Memory_Pages:=AH;
end; { with Regs do }
end; { Function Deallocate_Expanded_Memory_Pages }
{ * --------------------------------------------------------- * }
{ This function returns the version number of the EMM as
a 3 character string. }
Function Get_Version_Number(Var Version_String: ST3): Word;
Var
Regs: Registers;
Word_Part,Fractional_Part: Char;
Begin
with Regs do
Begin
{ Put the desired EMS function number in the AH pseudo-register }
AH:=GET_VERSION;
Intr(EMM_INT,Regs);
{ See if call was successful }
If AH=STATUS_OK then
Begin
{ The upper four bits of AH are the Word portion of the
version number, the lower four bits are the fractional
portion. Convert the Word value to ASCII by adding 48. }
Word_Part := Char( AL shr 4 + 48);
Fractional_Part:= Char( AL and $F +48);
Version_String:= Word_Part+'.'+Fractional_Part;
end; { If AH=STATUS_OK }
{ Return the function calls error code }
Get_Version_Number:=AH;
end; { with Regs do }
end; { Function Get_Version_Number }
{ * --------------------------------------------------------- * }
{ This procedure prints an error message passed by the caller,
prints the error code passed by the caller in hex, and then
terminates the program with the an error level of 1 }
Procedure Error(Error_Message: ST80; Error_Number: Word);
Begin
Writeln(Error_Message);
Writeln(' Error_Number = ',Hex_String(Error_Number) );
Writeln('EMS test program aborting.');
Halt(1);
end; { Procedure Error_Message }
{ * --------------------------------------------------------- * }
{ EMS_TEST }
{ This program is an example of the basic EMS functions that you
need to execute in order to use EMS memory with Turbo Pascal }
Begin
ClrScr;
Window(5,2,77,22);
{ Determine if the Expanded Memory Manager is installed, If
not, then terminate 'main' with an ErrorLevel code of 1. }
If not (Emm_Installed) then
Begin
Writeln('The LIM Expanded Memory Manager is not installed.');
Halt(1);
end;
{ Get the version number and display it }
Error_Code:= Get_Version_Number(Version_Number);
If Error_Code<>STATUS_OK then
Error('Error trying to get the EMS version number ',
Error_code)
else
Writeln('LIM Expanded Memory Manager, version ',
Version_Number,' is ready for use.');
Writeln;
{ Determine if there are enough expanded memory pages for this
application. }
Pages_Needed:=APPLICATION_PAGE_COUNT;
Error_Code:=
EMS_Pages_Available(Total_EMS_Pages,Available_EMS_Pages);
If Error_Code<>STATUS_OK then
Error('Error trying to determine the number of EMS pages available.',
Error_code);
Writeln('There are a total of ',Total_EMS_Pages,
' expanded memory pages present in this system.');
Writeln(' ',Available_EMS_Pages,
' of those pages are available for your usage.');
Writeln;
{ If there is an insufficient number of pages for our application,
then report the error and terminate the EMS test program }
If Pages_Needed>Available_EMS_Pages then
Begin
Str(Pages_Needed,Pages_Number_String);
Error('We need '+Pages_Number_String+
' EMS pages. There are not that many available.',
Error_Code);
end; { Pages_Needed>Available_EMS_Pages }
{ Allocate expanded memory pages for our usage }
Error_Code:= Allocate_Expanded_Memory_Pages(Pages_Needed,Emm_Handle);
Str(Pages_Needed,Pages_Number_String);
If Error_Code<>STATUS_OK then
Error('EMS test program failed trying to allocate '+Pages_Number_String+
' pages for usage.',Error_Code);
Writeln(APPLICATION_PAGE_COUNT,
' EMS page(s) allocated for the EMS test program.');
Writeln;
{ Map in the required logical pages to the physical pages
given to us, in this case just one page }
Logical_Page :=0;
Physical_Page:=0;
Error_Code:=
Map_Expanded_Memory_Pages(
Emm_Handle,Logical_Page,Physical_Page);
If Error_Code<>STATUS_OK then
Error('EMS test program failed trying to map '+
'logical pages onto physical pages.',Error_Code);
Writeln('Logical Page ',Logical_Page,
' successfully mapped onto Physical Page ',
Physical_Page);
Writeln;
{ Get the expanded memory page frame address }
Error_Code:= Get_Page_Frame_Base_Address(Page_Frame_Base_Address);
If Error_Code<>STATUS_OK then
Error('EMS test program unable to get the base Page'+
' Frame Address.',Error_Code);
Writeln('The base address of the EMS page frame is - '+
Hex_String(Page_Frame_Base_Address) );
Writeln;
{ Write a test pattern to expanded memory }
For Offset:=0 to 16382 do
Mem[Page_Frame_Base_Address:Offset]:=Offset mod 256;
{ Make sure that what is in EMS memory is what we just wrote }
Writeln('Testing EMS memory.');
Offset:=1;
Verify:=True;
while (Offset<=16382) and (Verify=True) do
Begin
If Mem[Page_Frame_Base_Address:Offset]<>Offset mod 256 then
Verify:=False;
Offset:=Succ(Offset);
end; { while (Offset<=16382) and (Verify=True) }
{ If it isn't report the error }
If not Verify then
Error('What was written to EMS memory was not found during '+
'memory verification test.',0);
Writeln('EMS memory test successful.');
Writeln;
{ Return the expanded memory pages given to us back to the
EMS memory pool before terminating our test program }
Error_Code:=Deallocate_Expanded_Memory_Pages(Emm_Handle);
If Error_Code<>STATUS_OK then
Error('EMS test program was unable to deallocate '+
'the EMS pages in use.',Error_Code);
Writeln(APPLICATION_PAGE_COUNT,
' page(s) deallocated.');
Writeln;
Writeln('EMS test program completed.');
end.


22
Borland Turbo Pascal v5/ERROR.PAS Normal file
View File

@ -0,0 +1,22 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit Error;
{ Sample unit for CIRCULAR.PAS }
interface
procedure ShowError(Msg : string);
implementation
uses
Crt, Display;
procedure ShowError(Msg : string);
begin
WriteXY(1, 25, 'Error: ' + Msg);
end;
end.


40
Borland Turbo Pascal v5/EXECDEMO.PAS Normal file
View File

@ -0,0 +1,40 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
program ExecDemo;
(*
Demonstration program that shows how to use the Dos
unit's Exec procedure to execute DOS commands (including
running other programs or batch files).
This program keeps prompting you for a DOS command until
you enter a blank line.
When using Exec, make sure you specify a {$M} directive
so the heap leaves some memory available for the child
process.
*)
{$M 8192,0,0} { Leave memory for child process }
uses Dos;
var
Command: string[127];
begin
repeat
Write('Enter DOS command: ');
ReadLn(Command);
if Command <> '' then
begin
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C ' + Command);
SwapVectors;
if DosError <> 0 then
WriteLn('Could not execute COMMAND.COM');
WriteLn;
end;
until Command = '';
end.


45
Borland Turbo Pascal v5/FIB8087.PAS Normal file
View File

@ -0,0 +1,45 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
{$N+,E+}
program Fib8087;
{
Sample program from P-335 in the Owner's Handbook that
demonstrates how to avoid 8087 stack overflow in recursive
functions that use the 8087 math co-processor. Local variables
are used to store temporary results on the 8086 stack.
}
var
i : integer;
function Fib(N : integer) : extended;
{ calculate the fibonacci sequence for N }
var
F1, F2 : extended;
begin
if N = 0 then
Fib := 0.0
else
if N = 1 then
Fib := 1.0
else
begin
(* Use this line instead of the 3 lines that follow this
comment to cause an 8087 stack overflow for values of
N >= 8:
Fib := Fib(N - 1) + Fib(N - 2); { will cause overflow for N > 8 }
*)
F1 := Fib(N - 1); { store results in temporaries on 8086 }
F2 := Fib(N - 2); { stack to avoid 8087 stack overflow }
Fib := F1 + F2;
end;
end; { Fib }
begin
for i := 0 to 15 do
Writeln(i, '. ', Fib(i));
end.


31
Borland Turbo Pascal v5/FONTS.PAS Normal file
View File

@ -0,0 +1,31 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit Fonts;
{ Sample unit to accompany BGILINK.PAS. This unit links all the BGI graphics
fonts into a single TPU file. This makes it easy to incorporate the font
files directly into an .EXE file. See BGILINK.PAS for more information.
}
interface
procedure GothicFontProc;
procedure SansSerifFontProc;
procedure SmallFontProc;
procedure TriplexFontProc;
implementation
procedure GothicFontProc; external;
{$L GOTH.OBJ }
procedure SansSerifFontProc; external;
{$L SANS.OBJ }
procedure SmallFontProc; external;
{$L LITT.OBJ }
procedure TriplexFontProc; external;
{$L TRIP.OBJ }
end.


BIN
Borland Turbo Pascal v5/GOTH.CHR Normal file
View File

Binary file not shown.

340
Borland Turbo Pascal v5/GRAPH.DOC Normal file
View File

@ -0,0 +1,340 @@
{*******************************************************}
{ }
{ Turbo Pascal Version 5.0 }
{ Graph Interface Unit }
{ }
{ Copyright (C) 1987,88 Borland International }
{ }
{*******************************************************}
unit Graph;
interface
const
{ GraphResult error return codes: }
grOk = 0;
grNoInitGraph = -1;
grNotDetected = -2;
grFileNotFound = -3;
grInvalidDriver = -4;
grNoLoadMem = -5;
grNoScanMem = -6;
grNoFloodMem = -7;
grFontNotFound = -8;
grNoFontMem = -9;
grInvalidMode = -10;
grError = -11; { generic error }
grIOerror = -12;
grInvalidFont = -13;
grInvalidFontNum = -14;
{ define graphics drivers }
CurrentDriver = -128; { passed to GetModeRange }
Detect = 0; { requests autodetection }
CGA = 1;
MCGA = 2;
EGA = 3;
EGA64 = 4;
EGAMono = 5;
IBM8514 = 6;
HercMono = 7;
ATT400 = 8;
VGA = 9;
PC3270 = 10;
{ graphics modes for each driver }
CGAC0 = 0; { 320x200 palette 0: LightGreen, LightRed, Yellow; 1 page }
CGAC1 = 1; { 320x200 palette 1: LightCyan, LightMagenta, White; 1 page }
CGAC2 = 2; { 320x200 palette 2: Green, Red, Brown; 1 page }
CGAC3 = 3; { 320x200 palette 3: Cyan, Magenta, LightGray; 1 page }
CGAHi = 4; { 640x200 1 page }
MCGAC0 = 0; { 320x200 palette 0: LightGreen, LightRed, Yellow; 1 page }
MCGAC1 = 1; { 320x200 palette 1: LightCyan, LightMagenta, White; 1 page }
MCGAC2 = 2; { 320x200 palette 2: Green, Red, Brown; 1 page }
MCGAC3 = 3; { 320x200 palette 3: Cyan, Magenta, LightGray; 1 page }
MCGAMed = 4; { 640x200 1 page }
MCGAHi = 5; { 640x480 1 page }
EGALo = 0; { 640x200 16 color 4 page }
EGAHi = 1; { 640x350 16 color 2 page }
EGA64Lo = 0; { 640x200 16 color 1 page }
EGA64Hi = 1; { 640x350 4 color 1 page }
EGAMonoHi = 3; { 640x350 64K on card, 1 page; 256K on card, 2 page }
HercMonoHi = 0; { 720x348 2 page }
ATT400C0 = 0; { 320x200 palette 0: LightGreen, LightRed, Yellow; 1 page }
ATT400C1 = 1; { 320x200 palette 1: LightCyan, LightMagenta, White; 1 page }
ATT400C2 = 2; { 320x200 palette 2: Green, Red, Brown; 1 page }
ATT400C3 = 3; { 320x200 palette 3: Cyan, Magenta, LightGray; 1 page }
ATT400Med = 4; { 640x200 1 page }
ATT400Hi = 5; { 640x400 1 page }
VGALo = 0; { 640x200 16 color 4 page }
VGAMed = 1; { 640x350 16 color 2 page }
VGAHi = 2; { 640x480 16 color 1 page }
PC3270Hi = 0; { 720x350 1 page }
IBM8514LO = 0; { 640x480 256 colors }
IBM8514HI = 1; { 1024x768 256 colors }
{ Colors for SetPalette and SetAllPalette: }
Black = 0;
Blue = 1;
Green = 2;
Cyan = 3;
Red = 4;
Magenta = 5;
Brown = 6;
LightGray = 7;
DarkGray = 8;
LightBlue = 9;
LightGreen = 10;
LightCyan = 11;
LightRed = 12;
LightMagenta = 13;
Yellow = 14;
White = 15;
{ colors for 8514 to set standard EGA colors w/o knowing their values }
EGABlack = 0; { dark colors }
EGABlue = 1;
EGAGreen = 2;
EGACyan = 3;
EGARed = 4;
EGAMagenta = 5;
EGABrown = 20;
EGALightgray = 7;
EGADarkgray = 56; { light colors }
EGALightblue = 57;
EGALightgreen = 58;
EGALightcyan = 59;
EGALightred = 60;
EGALightmagenta = 61;
EGAYellow = 62;
EGAWhite = 63;
{ Line styles and widths for Get/SetLineStyle: }
SolidLn = 0;
DottedLn = 1;
CenterLn = 2;
DashedLn = 3;
UserBitLn = 4; { User-defined line style }
NormWidth = 1;
ThickWidth = 3;
{ Set/GetTextStyle constants: }
DefaultFont = 0; { 8x8 bit mapped font }
TriplexFont = 1; { "Stroked" fonts }
SmallFont = 2;
SansSerifFont = 3;
GothicFont = 4;
HorizDir = 0; { left to right }
VertDir = 1; { bottom to top }
UserCharSize = 0; { user-defined char size }
{ Clipping constants: }
ClipOn = true;
ClipOff = false;
{ Bar3D constants: }
TopOn = true;
TopOff = false;
{ Fill patterns for Get/SetFillStyle: }
EmptyFill = 0; { fills area in background color }
SolidFill = 1; { fills area in solid fill color }
LineFill = 2; { --- fill }
LtSlashFill = 3; { /// fill }
SlashFill = 4; { /// fill with thick lines }
BkSlashFill = 5; { \\\ fill with thick lines }
LtBkSlashFill = 6; { \\\ fill }
HatchFill = 7; { light hatch fill }
XHatchFill = 8; { heavy cross hatch fill }
InterleaveFill = 9; { interleaving line fill }
WideDotFill = 10; { Widely spaced dot fill }
CloseDotFill = 11; { Closely spaced dot fill }
UserFill = 12; { user defined fill }
{ BitBlt operators for PutImage: }
NormalPut = 0; { MOV } { left for 1.0 compatibility }
CopyPut = 0; { MOV }
XORPut = 1; { XOR }
OrPut = 2; { OR }
AndPut = 3; { AND }
NotPut = 4; { NOT }
{ Horizontal and vertical justification for SetTextJustify: }
LeftText = 0;
CenterText = 1;
RightText = 2;
BottomText = 0;
{ CenterText = 1; already defined above }
TopText = 2;
const
MaxColors = 15;
type
PaletteType = record
Size : byte;
Colors : array[0..MaxColors] of shortint;
end;
LineSettingsType = record
LineStyle : word;
Pattern : word;
Thickness : word;
end;
TextSettingsType = record
Font : word;
Direction : word;
CharSize : word;
Horiz : word;
Vert : word;
end;
FillSettingsType = record { Pre-defined fill style }
Pattern : word;
Color : word;
end;
FillPatternType = array[1..8] of byte; { User defined fill style }
PointType = record
X, Y : integer;
end;
ViewPortType = record
x1, y1, x2, y2 : integer;
Clip : boolean;
end;
ArcCoordsType = record
X, Y : integer;
Xstart, Ystart : integer;
Xend, Yend : integer;
end;
var
GraphGetMemPtr : Pointer; { allows user to steal heap allocation }
GraphFreeMemPtr : Pointer; { allows user to steal heap de-allocation }
{ *** high-level error handling *** }
function GraphErrorMsg(ErrorCode : integer) : String;
function GraphResult : integer;
{ *** detection, initialization and crt mode routines *** }
procedure DetectGraph(var GraphDriver, GraphMode : integer);
function GetDriverName : string;
procedure InitGraph(var GraphDriver : integer;
var GraphMode : integer;
PathToDriver : String);
function RegisterBGIfont(Font : pointer) : integer;
function RegisterBGIdriver(Driver : pointer) : integer;
function InstallUserDriver(DriverFileName : string;
AutoDetectPtr : pointer) : integer;
function InstallUserFont(FontFileName : string) : integer;
procedure SetGraphBufSize(BufSize : word);
function GetMaxMode : integer;
procedure GetModeRange(GraphDriver : integer; var LoMode, HiMode : integer);
function GetModeName(GraphMode : integer) : string;
procedure SetGraphMode(Mode : integer);
function GetGraphMode : integer;
procedure GraphDefaults;
procedure RestoreCrtMode;
procedure CloseGraph;
function GetX : integer;
function GetY : integer;
function GetMaxX : integer;
function GetMaxY : integer;
{ *** Screen, viewport, page routines *** }
procedure ClearDevice;
procedure SetViewPort(x1, y1, x2, y2 : integer; Clip : boolean);
procedure GetViewSettings(var ViewPort : ViewPortType);
procedure ClearViewPort;
procedure SetVisualPage(Page : word);
procedure SetActivePage(Page : word);
{ *** point-oriented routines *** }
procedure PutPixel(X, Y : integer; Pixel : word);
function GetPixel(X, Y : integer) : word;
{ *** line-oriented routines *** }
procedure SetWriteMode(WriteMode : integer);
procedure LineTo(X, Y : integer);
procedure LineRel(Dx, Dy : integer);
procedure MoveTo(X, Y : integer);
procedure MoveRel(Dx, Dy : integer);
procedure Line(x1, y1, x2, y2 : integer);
procedure GetLineSettings(var LineInfo : LineSettingsType);
procedure SetLineStyle(LineStyle : word;
Pattern : word;
Thickness : word);
{ *** polygon, fills and figures *** }
procedure Rectangle(x1, y1, x2, y2 : integer);
procedure Bar(x1, y1, x2, y2 : integer);
procedure Bar3D(x1, y1, x2, y2 : integer; Depth : word; Top : boolean);
procedure DrawPoly(NumPoints : word; var PolyPoints);
procedure FillPoly(NumPoints : word; var PolyPoints);
procedure GetFillSettings(var FillInfo : FillSettingsType);
procedure GetFillPattern(var FillPattern : FillPatternType);
procedure SetFillStyle(Pattern : word; Color : word);
procedure SetFillPattern(Pattern : FillPatternType; Color : word);
procedure FloodFill(X, Y : integer; Border : word);
{ *** arc, circle, and other curves *** }
procedure Arc(X, Y : integer; StAngle, EndAngle, Radius : word);
procedure GetArcCoords(var ArcCoords : ArcCoordsType);
procedure Circle(X, Y : integer; Radius : word);
procedure Ellipse(X, Y : integer;
StAngle, EndAngle : word;
XRadius, YRadius : word);
procedure FillEllipse(X, Y : integer;
XRadius, YRadius : word);
procedure GetAspectRatio(var Xasp, Yasp : word);
procedure SetAspectRatio(Xasp, Yasp : word);
procedure PieSlice(X, Y : integer; StAngle, EndAngle, Radius : word);
procedure Sector(X, Y : Integer;
StAngle, EndAngle,
XRadius, YRadius : word);
{ *** color and palette routines *** }
procedure SetBkColor(ColorNum : word);
procedure SetColor(Color : word);
function GetBkColor : word;
function GetColor : word;
procedure SetAllPalette(var Palette);
procedure SetPalette(ColorNum : word; Color : shortint);
procedure GetPalette(var Palette : PaletteType);
function GetPaletteSize : integer;
procedure GetDefaultPalette(var Palette : PaletteType);
function GetMaxColor : word;
procedure SetRGBPalette(ColorNum, RedValue, GreenValue, BlueValue : integer);
{ *** bit-image routines *** }
function ImageSize(x1, y1, x2, y2 : integer) : word;
procedure GetImage(x1, y1, x2, y2 : integer; var BitMap);
procedure PutImage(X, Y : integer; var BitMap; BitBlt : word);
{ *** text routines *** }
procedure GetTextSettings(var TextInfo : TextSettingsType);
procedure OutText(TextString : string);
procedure OutTextXY(X, Y : integer; TextString : string);
procedure SetTextJustify(Horiz, Vert : word);
procedure SetTextStyle(Font, Direction : word; CharSize : word);
procedure SetUserCharSize(MultX, DivX, MultY, DivY : word);
function TextHeight(TextString : string) : word;
function TextWidth(TextString : string) : word;


BIN
Borland Turbo Pascal v5/GRAPH.TPU Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/GREP.COM Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/HERC.BGI Normal file
View File

Binary file not shown.

246
Borland Turbo Pascal v5/HILB.PAS Normal file
View File

@ -0,0 +1,246 @@
{$N-}
program Hilb;
{
The program performs simultaneous solution by Gauss-Jordan
elimination.
--------------------------------------------------
From: Pascal Programs for Scientists and Engineers
Alan R. Miller, Sybex
n x n inverse hilbert matrix
solution is 1 1 1 1 1
double precision version
--------------------------------------------------
INSTRUCTIONS
1. Compile and run the program using the $N- (Numeric Processing :
Software) compiler directive.
2. if you have a math coprocessor in your computer, compile and run the
program using the $N+ (Numeric Processing : Hardware) compiler
directive. Compare the speed and precision of the results to those
of example 1.
}
const
maxr = 10;
maxc = 10;
type
{$IFOPT N+} { use extended type if using 80x87 }
real = extended;
{$ENDIF}
ary = array[1..maxr] of real;
arys = array[1..maxc] of real;
ary2s = array[1..maxr, 1..maxc] of real;
var
y : arys;
coef : arys;
a, b : ary2s;
n, m, i, j : integer;
error : boolean;
procedure gaussj
(var b : ary2s; (* square matrix of coefficients *)
y : arys; (* constant vector *)
var coef : arys; (* solution vector *)
ncol : integer; (* order of matrix *)
var error: boolean); (* true if matrix singular *)
(* Gauss Jordan matrix inversion and solution *)
(* Adapted from McCormick *)
(* Feb 8, 81 *)
(* B(N,N) coefficient matrix, becomes inverse *)
(* Y(N) original constant vector *)
(* W(N,M) constant vector(s) become solution vector *)
(* DETERM is the determinant *)
(* ERROR = 1 if singular *)
(* INDEX(N,3) *)
(* NV is number of constant vectors *)
var
w : array[1..maxc, 1..maxc] of real;
index: array[1..maxc, 1..3] of integer;
i, j, k, l, nv, irow, icol, n, l1 : integer;
determ, pivot, hold, sum, t, ab, big: real;
procedure swap(var a, b: real);
var
hold: real;
begin (* swap *)
hold := a;
a := b;
b := hold
end (* procedure swap *);
begin (* Gauss-Jordan main program *)
error := false;
nv := 1 (* single constant vector *);
n := ncol;
for i := 1 to n do
begin
w[i, 1] := y[i] (* copy constant vector *);
index[i, 3] := 0
end;
determ := 1.0;
for i := 1 to n do
begin
(* search for largest element *)
big := 0.0;
for j := 1 to n do
begin
if index[j, 3] <> 1 then
begin
for k := 1 to n do
begin
if index[k, 3] > 1 then
begin
writeln(' ERROR: matrix singular');
error := true;
exit; (* abort *)
end;
if index[k, 3] < 1 then
if abs(b[j, k]) > big then
begin
irow := j;
icol := k;
big := abs(b[j, k])
end
end (* k loop *)
end
end (* j loop *);
index[icol, 3] := index[icol, 3] + 1;
index[i, 1] := irow;
index[i, 2] := icol;
(* interchange rows to put pivot on diagonal *)
if irow <> icol then
begin
determ := - determ;
for l := 1 to n do
swap(b[irow, l], b[icol, l]);
if nv > 0 then
for l := 1 to nv do
swap(w[irow, l], w[icol, l])
end; (* if irow <> icol *)
(* divide pivot row by pivot column *)
pivot := b[icol, icol];
determ := determ * pivot;
b[icol, icol] := 1.0;
for l := 1 to n do
b[icol, l] := b[icol, l] / pivot;
if nv > 0 then
for l := 1 to nv do
w[icol, l] := w[icol, l] / pivot;
(* reduce nonpivot rows *)
for l1 := 1 to n do
begin
if l1 <> icol then
begin
t := b[l1, icol];
b[l1, icol] := 0.0;
for l := 1 to n do
b[l1, l] := b[l1, l] - b[icol, l] * t;
if nv > 0 then
for l := 1 to nv do
w[l1, l] := w[l1, l] - w[icol, l] * t;
end (* if l1 <> icol *)
end
end (* i loop *);
if error then exit;
(* interchange columns *)
for i := 1 to n do
begin
l := n - i + 1;
if index[l, 1] <> index[l, 2] then
begin
irow := index[l, 1];
icol := index[l, 2];
for k := 1 to n do
swap(b[k, irow], b[k, icol])
end (* if index *)
end (* i loop *);
for k := 1 to n do
if index[k, 3] <> 1 then
begin
writeln(' ERROR: matrix singular');
error := true;
exit; (* abort *)
end;
for i := 1 to n do
coef[i] := w[i, 1];
end (* procedure gaussj *);
procedure get_data(var a : ary2s;
var y : arys;
var n, m : integer);
(* setup n-by-n hilbert matrix *)
var
i, j : integer;
begin
for i := 1 to n do
begin
a[n,i] := 1.0/(n + i - 1);
a[i,n] := a[n,i]
end;
a[n,n] := 1.0/(2*n -1);
for i := 1 to n do
begin
y[i] := 0.0;
for j := 1 to n do
y[i] := y[i] + a[i,j]
end;
writeln;
if n < 7 then
begin
for i:= 1 to n do
begin
for j:= 1 to m do
write( a[i,j] :7:5, ' ');
writeln( ' : ', y[i] :7:5)
end;
writeln
end (* if n<7 *)
end (* procedure get_data *);
procedure write_data;
(* print out the answers *)
var
i : integer;
begin
for i := 1 to m do
write( coef[i] :13:9);
writeln;
end (* write_data *);
begin (* main program *)
a[1,1] := 1.0;
n := 2;
m := n;
repeat
get_data (a, y, n, m);
for i := 1 to n do
for j := 1 to n do
b[i,j] := a[i,j] (* setup work array *);
gaussj (b, y, coef, n, error);
if not error then write_data;
n := n+1;
m := n
until n > maxr;
end.


BIN
Borland Turbo Pascal v5/IBM8514.BGI Normal file
View File

Binary file not shown.

211
Borland Turbo Pascal v5/LISTER.PAS Normal file
View File

@ -0,0 +1,211 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
program SourceLister;
{
SOURCE LISTER DEMONSTRATION PROGRAM
This is a simple program to list your TURBO PASCAL source programs.
PSEUDO CODE
1. Find Pascal source file to be listed
2. Initialize program variables
3. Open main source file
4. Process the file
a. Read a character into line buffer until linebuffer full or eoln;
b. Search line buffer for include file.
c. If line contains include file command:
Then process include file and extract command from line buffer
Else print out the line buffer.
d. Repeat step 4.a thru 4.c until eof(main file);
INSTRUCTIONS
1. Compile and run the program:
a. In the Development Environment load LISTER.PAS and
press ALT-R.
b. From the command line type TPC LISTER.PAS /R
2. Specify the file to print.
}
uses
Printer;
const
PageWidth = 80;
PrintLength = 55;
PathLength = 65;
FormFeed = #12;
VerticalTabLength = 3;
type
WorkString = string[126];
FileName = string[PathLength];
var
CurRow : integer;
MainFileName: FileName;
MainFile: text;
search1,
search2,
search3,
search4: string[5];
procedure Initialize;
begin
CurRow := 0;
search1 := '{$'+'I'; { different forms that the include compiler }
search2 := '{$'+'i'; { directive can take. }
search3 := '(*$'+'I';
search4 := '(*$'+'i';
end {initialize};
function Open(var fp:text; name: Filename): boolean;
begin
Assign(fp,Name);
{$I-}
Reset(fp);
{$I+}
Open := IOResult = 0;
end { Open };
procedure OpenMain;
begin
if ParamCount = 0 then
begin
Write('Enter filename: ');
Readln(MainFileName);
end
else
MainFileName := ParamStr(1);
if (MainFileName = '') or not Open(MainFile,MainFileName) then
begin
Writeln('ERROR: file not found (', MainFileName, ')');
Halt(1);
end;
end {Open Main};
procedure VerticalTab;
var i: integer;
begin
for i := 1 to VerticalTabLength do Writeln(LST);
end {vertical tab};
procedure ProcessLine(PrintStr: WorkString);
begin
CurRow := Succ(CurRow);
if Length(PrintStr) > PageWidth then Inc(CurRow);
if CurRow > PrintLength then
begin
Write(LST,FormFeed);
VerticalTab;
CurRow := 1;
end;
Writeln(LST,PrintStr);
end {Process line};
procedure ProcessFile;
{ This procedure displays the contents of the Turbo Pascal program on the }
{ printer. It recursively processes include files if they are nested. }
var
LineBuffer: WorkString;
function IncludeIn(var CurStr: WorkString): boolean;
var
ChkChar: char;
column: integer;
begin
ChkChar := '-';
column := Pos(search1,CurStr);
if column <> 0 then
chkchar := CurStr[column+3]
else
begin
column := Pos(search3,CurStr);
if column <> 0 then
chkchar := CurStr[column+4]
else
begin
column := Pos(search2,CurStr);
if column <> 0 then
chkchar := CurStr[column+3]
else
begin
column := Pos(search4,CurStr);
if column <> 0 then
chkchar := CurStr[column+4]
end;
end;
end;
if ChkChar in ['+','-'] then IncludeIn := False
else IncludeIn := True;
end { IncludeIn };
procedure ProcessIncludeFile(var IncStr: WorkString);
var NameStart, NameEnd: integer;
IncludeFile: text;
IncludeFileName: Filename;
Function Parse(IncStr: WorkString): WorkString;
begin
NameStart := Pos('$I',IncStr)+2;
while IncStr[NameStart] = ' ' do
NameStart := Succ(NameStart);
NameEnd := NameStart;
while (not (IncStr[NameEnd] in [' ','}','*']))
and ((NameEnd - NameStart) <= PathLength) do
Inc(NameEnd);
Dec(NameEnd);
Parse := Copy(IncStr,NameStart,(NameEnd-NameStart+1));
end {Parse};
begin {Process include file}
IncludeFileName := Parse(IncStr);
if not Open(IncludeFile,IncludeFileName) then
begin
LineBuffer := 'ERROR: include file not found (' +
IncludeFileName + ')';
ProcessLine(LineBuffer);
end
else
begin
while not EOF(IncludeFile) do
begin
Readln(IncludeFile,LineBuffer);
{ Turbo Pascal 5.0 allows nested include files so we must
check for them and do a recursive call if necessary }
if IncludeIn(LineBuffer) then
ProcessIncludeFile(LineBuffer)
else
ProcessLine(LineBuffer);
end;
Close(IncludeFile);
end;
end {Process include file};
begin {Process File}
VerticalTab;
Writeln('Printing . . . ');
while not EOF(mainfile) do
begin
Readln(MainFile,LineBuffer);
if IncludeIn(LineBuffer) then
ProcessIncludeFile(LineBuffer)
else
ProcessLine(LineBuffer);
end;
Close(MainFile);
Write(LST,FormFeed); { move the printer to the beginning of the next }
{ page }
end {Process File};
begin
Initialize; { initialize some global variables }
OpenMain; { open the file to print }
ProcessFile; { print the program }
end.


BIN
Borland Turbo Pascal v5/LITT.CHR Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/MAKE.EXE Normal file
View File

Binary file not shown.

143
Borland Turbo Pascal v5/MCALC.PAS Normal file
View File

@ -0,0 +1,143 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
Program MCalc;
uses Crt, Dos, MCVars, MCUtil, MCDisply, MCParser, MCLib, MCInput, MCommand;
var
Ch : Char;
procedure Run;
{ The main program loop }
var
Input : Char;
begin
Stop := False;
ClearInput;
repeat
DisplayCell(CurCol, CurRow, HIGHLIGHT, NOUPDATE);
CurCell := Cell[CurCol, CurRow];
ShowCellType;
GotoXY(1, 25);
Input := GetKey;
case Input of
'/' : MainMenu;
F1 : Recalc;
F2 : EditCell(CurCell);
DELKEY : begin
DeleteCell(CurCol, CurRow, UPDATE);
PrintFreeMem;
if AutoCalc then
Recalc;
end; { DELKEY }
PGUPKEY : begin
if CurRow <= SCREENROWS then
begin
CurRow := 1;
TopRow := 1;
end
else if TopRow <= SCREENROWS then
begin
CurRow := Succ(CurRow - TopRow);
TopRow := 1;
end
else begin
Dec(TopRow, SCREENROWS);
Dec(CurRow, SCREENROWS);
end;
SetBottomRow;
DisplayScreen(NOUPDATE);
end; {PGUPKEY }
PGDNKEY : begin
Inc(TopRow, SCREENROWS);
Inc(CurRow, SCREENROWS);
if (CurRow > MAXROWS) and (TopRow > MAXROWS) then
begin
CurRow := MAXROWS;
TopRow := Succ(MAXROWS - SCREENROWS);
end
else if TopRow > Succ(MAXROWS - SCREENROWS) then
begin
CurRow := Succ(CurRow) - (TopRow + SCREENROWS - MAXROWS);
TopRow := Succ(MAXROWS - SCREENROWS);
end;
SetBottomRow;
DisplayScreen(NOUPDATE);
end; { PGDNKEY }
CTRLLEFTKEY : begin
DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
if LeftCol = 1 then
CurCol := 1
else begin
CurCol := Pred(LeftCol);
RightCol := CurCol;
SetLeftCol;
SetRightCol;
DisplayScreen(NOUPDATE);
end;
end; { CTRLLEFTKEY }
CTRLRIGHTKEY : begin
DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
if RightCol = MAXCOLS then
CurCol := RightCol
else begin
CurCol := Succ(RightCol);
LeftCol := CurCol;
SetRightCol;
SetLeftCol;
DisplayScreen(NOUPDATE);
end;
end; { CTRLRIGHTKEY }
HOMEKEY : begin
CurRow := 1;
CurCol := 1;
LeftCol := 1;
TopRow := 1;
SetRightCol;
SetBottomRow;
DisplayScreen(NOUPDATE);
end; { HOMEKEY }
ENDKEY : begin
CurCol := LastCol;
RightCol := CurCol;
BottomRow := LastRow;
CurRow := BottomRow;
SetTopRow;
SetLeftCol;
SetRightCol;
DisplayScreen(NOUPDATE);
end; { ENDKEY }
UPKEY : MoveRowUp;
DOWNKEY : MoveRowDown;
LEFTKEY : MoveColLeft;
RIGHTKEY : MoveColRight;
else if Input in [' '..'~'] then
GetInput(Input);
end; { case }
until Stop;
end; { Run }
begin
CheckBreak := False;
SetColor(TXTCOLOR);
ClrScr;
SetColor(MSGHEADERCOLOR);
WriteXY(MSGHEADER, (80 - Length(MSGHEADER)) shr 1, 10);
SetColor(PROMPTCOLOR);
WriteXY(MSGKEYPRESS, (80 - Length(MSGKEYPRESS)) shr 1, 12);
GotoXY(80, 25);
Ch := GetKey;
ClrScr;
InitVars;
Changed := False;
RedrawScreen;
if (ParamCount > 0) then
LoadSheet(ParamStr(1));
ClearInput;
Run;
SetColor(LightGray);
TextMode(OldMode);
SetCursor(OldCursor);
end.


357
Borland Turbo Pascal v5/MCDISPLY.PAS Normal file
View File

@ -0,0 +1,357 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit MCDISPLY;
interface
uses Crt, Dos, MCVars, MCUtil;
var
InsCursor, ULCursor, NoCursor, OldCursor : Word;
procedure MoveToScreen(var Source, Dest; Len : Word);
{ Moves memory to screen memory }
procedure MoveFromScreen(var Source, Dest; Len : Word);
{ Moves memory from screen memory }
procedure WriteXY(S : String; Col, Row : Word);
{ Writes text in a particular location }
procedure MoveText(OldX1, OldY1, OldX2, OldY2, NewX1, NewY1 : Word);
{ Moves text from one location to another }
procedure Scroll(Direction, Lines, X1, Y1, X2, Y2, Attrib : Word);
{ Scrolls an area of the screen }
function GetCursor : Word;
{ Returns the current cursor }
procedure SetCursor(NewCursor : Word);
{ Sets a new cursor }
function GetSetCursor(NewCursor : Word) : Word;
{ Sets a new cursor and returns the current one }
procedure SetColor(Color : Word);
{ Sets the foreground and background color based on a single color }
procedure PrintCol;
{ Prints the column headings }
procedure PrintRow;
{ Prints the row headings }
procedure ClearInput;
{ Clears the input line }
procedure ChangeCursor(InsMode : Boolean);
{ Changes the cursor shape based on the current insert mode }
procedure ShowCellType;
{ Prints the type of cell and what is in it }
procedure PrintFreeMem;
{ Prints the amount of free memory }
procedure ErrorMsg(S : String);
{ Prints an error message at the bottom of the screen }
procedure WritePrompt(Prompt : String);
{ Prints a prompt on the screen }
function EGAInstalled : Boolean;
{ Tests for the presence of an EGA }
implementation
const
MaxLines = 43;
type
ScreenType = array[1..MaxLines, 1..80] of Word;
ScreenPtr = ^ScreenType;
var
DisplayPtr : ScreenPtr;
procedure MoveToScreen; external;
procedure MoveFromScreen; external;
{$L MCMVSMEM.OBJ}
procedure WriteXY;
begin
GotoXY(Col, Row);
Write(S);
end; { WriteXY }
procedure MoveText;
var
Counter, Len : Word;
begin
Len := Succ(OldX2 - OldX1) shl 1;
if NewY1 < OldY1 then
begin
for Counter := 0 to OldY2 - OldY1 do
MoveFromScreen(DisplayPtr^[OldY1 + Counter, OldX1],
DisplayPtr^[NewY1 + Counter, NewX1], Len)
end
else begin
for Counter := OldY2 - OldY1 downto 0 do
MoveFromScreen(DisplayPtr^[OldY1 + Counter, OldX1],
DisplayPtr^[NewY1 + Counter, NewX1], Len)
end;
end; { MoveText }
procedure Scroll;
begin
if Lines = 0 then
Window(X1, Y1, X2, Y2)
else begin
case Direction of
UP : begin
MoveText(X1, Y1 + Lines, X2, Y2, X1, Y1);
Window(X1, Succ(Y2 - Lines), X2, Y2);
end;
DOWN : begin
MoveText(X1, Y1, X2, Y2 - Lines, X1, Y1 + Lines);
Window(X1, Y1, X2, Pred(Y1 + Lines));
end;
LEFT : begin
MoveText(X1 + Lines, Y1, X2, Y2, X1, Y1);
Window(Succ(X2 - Lines), Y1, X2, Y2);
end;
RIGHT : begin
MoveText(X1, Y1, X2 - Lines, Y2, X1 + Lines, Y1);
Window(X1, Y1, Pred(X1 + Lines), Y2);
end;
end; { case }
end;
SetColor(Attrib);
ClrScr;
Window(1, 1, 80, ScreenRows + 5);
end; { Scroll }
function GetCursor;
var
Reg : Registers;
begin
with Reg do
begin
AH := 3;
BH := 0;
Intr($10, Reg);
GetCursor := CX;
end; { Reg }
end; { GetCursor }
procedure SetCursor;
var
Reg : Registers;
begin
with Reg do
begin
AH := 1;
BH := 0;
CX := NewCursor;
Intr($10, Reg);
end; { with }
end; { SetCursor }
function GetSetCursor;
begin
GetSetCursor := GetCursor;
SetCursor(NewCursor);
end; { GetSetCursor }
procedure SetColor;
begin
TextAttr := ColorTable[Color];
end; { SetColor }
procedure InitColorTable(BlackWhite : Boolean);
{ Sets up the color table }
var
Color, FG, BG, FColor, BColor : Word;
begin
if not BlackWhite then
begin
for Color := 0 to 255 do
ColorTable[Color] := Color;
end
else begin
for FG := Black to White do
begin
case FG of
Black : FColor := Black;
Blue..LightGray : FColor := LightGray;
DarkGray..White : FColor := White;
end; { case }
for BG := Black to LightGray do
begin
if BG = Black then
BColor := Black
else begin
if FColor = White then
FColor := Black;
BColor := LightGray;
end;
ColorTable[FG + (BG shl 4)] := FColor + (BColor shl 4);
end;
end;
for FG := 128 to 255 do
ColorTable[FG] := ColorTable[FG - 128] or $80;
end;
end; { InitColorTable }
procedure PrintCol;
var
Col : Word;
begin
Scroll(UP, 0, 1, 2, 80, 2, HEADERCOLOR);
for Col := LeftCol to RightCol do
WriteXY(CenterColString(Col), ColStart[Succ(Col - LeftCol)], 2);
end; { PrintCol }
procedure PrintRow;
var
Row : Word;
begin
SetColor(HEADERCOLOR);
for Row := 0 to Pred(ScreenRows) do
WriteXY(Pad(WordToString(Row + TopRow, 1), LEFTMARGIN), 1, Row + 3);
end; { PrintRow }
procedure ClearInput;
begin
SetColor(TXTCOLOR);
GotoXY(1, ScreenRows + 5);
ClrEol;
end; { ClearInput }
procedure ChangeCursor;
begin
if InsMode then
SetCursor(InsCursor)
else
SetCursor(ULCursor);
end; { ChangeCursor }
procedure ShowCellType;
var
ColStr : String[2];
S : IString;
Color : Word;
begin
FormDisplay := not FormDisplay;
S := CellString(CurCol, CurRow, Color, NOFORMAT);
ColStr := ColString(CurCol);
SetColor(CELLTYPECOLOR);
GotoXY(1, ScreenRows + 3);
if CurCell = Nil then
Write(ColStr, CurRow, ' ', MSGEMPTY, ' ':10)
else begin
case CurCell^.Attrib of
TXT :
Write(ColStr, CurRow, ' ', MSGTEXT, ' ':10);
VALUE :
Write(ColStr, CurRow, ' ', MSGVALUE, ' ':10);
FORMULA :
Write(ColStr, CurRow, ' ', MSGFORMULA, ' ':10);
end; { case }
end;
SetColor(CELLCONTENTSCOLOR);
WriteXY(Pad(S, 80), 1, ScreenRows + 4);
FormDisplay := not FormDisplay;
end; { ShowCellType }
procedure PrintFreeMem;
begin
SetColor(MEMORYCOLOR);
GotoXY(Length(MSGMEMORY) + 2, 1);
Write(MemAvail:6);
end; { PrintFreeMem }
procedure ErrorMsg;
var
Ch : Char;
begin
Sound(1000); { Beeps the speaker }
Delay(500);
NoSound;
SetColor(ERRORCOLOR);
WriteXY(S + ' ' + MSGKEYPRESS, 1, ScreenRows + 5);
GotoXY(Length(S) + Length(MSGKEYPRESS) + 3, ScreenRows + 5);
Ch := ReadKey;
ClearInput;
end; { ErrorMsg }
procedure WritePrompt;
begin
SetColor(PROMPTCOLOR);
GotoXY(1, ScreenRows + 4);
ClrEol;
Write(Prompt);
end; { WritePrompt }
procedure InitDisplay;
{ Initializes various global variables - must be called before using the
above procedures and functions.
}
var
Reg : Registers;
begin
Reg.AH := 15;
Intr($10, Reg);
ColorCard := Reg.AL <> 7;
if ColorCard then
DisplayPtr := Ptr($B800, 0)
else
DisplayPtr := Ptr($B000, 0);
InitColorTable((not ColorCard) or (Reg.AL = 0) or (Reg.AL = 2));
end; { InitDisplay }
function EGAInstalled;
var
Reg : Registers;
begin
Reg.AX := $1200;
Reg.BX := $0010;
Reg.CX := $FFFF;
Intr($10, Reg);
EGAInstalled := Reg.CX <> $FFFF;
end; { EGAInstalled }
begin
InitDisplay;
NoCursor := $2000;
OldCursor := GetSetCursor(NoCursor);
OldMode := LastMode;
if (LastMode and Font8x8) <> 0 then
ScreenRows := 38
else
ScreenRows := 20;
Window(1, 1, 80, ScreenRows + 5);
if ColorCard then
begin
ULCursor := $0607;
InsCursor := $0507;
end
else begin
ULCursor := $0B0C;
InsCursor := $090C;
end;
if EGAInstalled then
begin
UCommandString := UCOMMAND;
UMenuString := UMNU;
end
else begin
UCommandString := Copy(UCOMMAND, 1, 2);
UMenuString := Copy(UMNU, 1, 23);
end;
end.


240
Borland Turbo Pascal v5/MCINPUT.PAS Normal file
View File

@ -0,0 +1,240 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit MCINPUT;
interface
uses Crt, Dos, MCVars, MCUtil, MCDisply, MCParser, MCLib;
function GetKey : Char;
{ Reads the next keyboard character }
function EditString(var S : IString; Legal : IString;
MaxLength : Word) : Boolean;
{ Allows the user to edit a string with only certain characters allowed -
Returns TRUE if ESC was not pressed, FALSE is ESC was pressed.
}
procedure GetInput(C : Char);
{ Reads and acts on an input string from the keyboard that started with C }
function GetWord(var Number : Word; Low, High : Word) : Boolean;
{ Reads in a positive word from low to high }
function GetCell(var Col, Row : Word) : Boolean;
{ Reads in a cell name that was typed in - Returns False if ESC was pressed }
function GetYesNo(var YesNo : Char; Prompt : String) : Boolean;
{ Prints a prompt and gets a yes or no answer - returns TRUE if ESC was
pressed, FALSE if not.
}
function GetCommand(MsgStr, ComStr : String) : Word;
{ Reads in a command and acts on it }
implementation
function GetKey;
var
C : Char;
begin
C := ReadKey;
repeat
if C = NULL then
begin
C := ReadKey;
if Ord(C) > 127 then
C := NULL
else
GetKey := Chr(Ord(C) + 128);
end
else
GetKey := C;
until C <> NULL;
end; { GetKey }
function EditString;
var
CPos : Word;
Ins : Boolean;
Ch : Char;
begin
Ins := True;
ChangeCursor(Ins);
CPos := Succ(Length(S));
SetColor(White);
repeat
GotoXY(1, ScreenRows + 5);
Write(S, '':(79 - Length(S)));
GotoXY(CPos, ScreenRows + 5);
Ch := GetKey;
case Ch of
HOMEKEY : CPos := 1;
ENDKEY : CPos := Succ(Length(S));
INSKEY : begin
Ins := not Ins;
ChangeCursor(Ins);
end;
LEFTKEY : if CPos > 1 then
Dec(CPos);
RIGHTKEY : if CPos <= Length(S) then
Inc(CPos);
BS : if CPos > 1 then
begin
Delete(S, Pred(CPos), 1);
Dec(CPos);
end;
DELKEY : if CPos <= Length(S) then
Delete(S, CPos, 1);
CR : ;
UPKEY, DOWNKEY : Ch := CR;
ESC : S := '';
else begin
if ((Legal = '') or (Pos(Ch, Legal) <> 0)) and
((Ch >= ' ') and (Ch <= '~')) and
(Length(S) < MaxLength) then
begin
if Ins then
Insert(Ch, S, CPos)
else if CPos > Length(S) then
S := S + Ch
else
S[CPos] := Ch;
Inc(CPos);
end;
end;
end; { case }
until (Ch = CR) or (Ch = ESC);
ClearInput;
ChangeCursor(False);
EditString := Ch <> ESC;
SetCursor(NoCursor);
end; { EditString }
procedure GetInput;
var
S : IString;
begin
S := C;
if (not EditString(S, '', MAXINPUT)) or (S = '') then
Exit;
Act(S);
Changed := True;
end; { GetInput }
function GetWord;
var
I, Error : Word;
Good : Boolean;
Num1, Num2 : String[5];
Message : String[80];
S : IString;
begin
GetWord := False;
S := '';
Str(Low, Num1);
Str(High, Num2);
Message := MSGBADNUMBER + ' ' + Num1 + ' to ' + Num2 + '.';
repeat
if not EditString(S, '1234567890', 4) then
Exit;
Val(S, I, Error);
Good := (Error = 0) and (I >= Low) and (I <= High);
if not Good then
ErrorMsg(Message);
until Good;
Number := I;
GetWord := True;
end; { GetWord }
function GetCell;
var
Len, NumLen, OldCol, OldRow, Posit, Error : Word;
Data : IString;
NumString : IString;
First, Good : Boolean;
begin
NumLen := RowWidth(MAXROWS);
OldCol := Col;
OldRow := Row;
First := True;
Good := False;
Data := '';
repeat
if not First then
ErrorMsg(MSGBADCELL);
First := False;
Posit := 1;
if not EditString(Data, '', NumLen + 2) then
begin
Col := OldCol;
Row := OldRow;
GetCell := False;
Exit;
end;
if (Data <> '') and (Data[1] in Letters) then
begin
Col := Succ(Ord(UpCase(Data[1])) - Ord('A'));
Inc(Posit);
if (Posit <= Length(Data)) and (Data[Posit] in LETTERS) then
begin
Col := Col * 26;
Inc(Col, Succ(Ord(UpCase(Data[Posit])) - Ord('A')));
Inc(Posit);
end;
if Col <= MAXCOLS then
begin
NumString := Copy(Data, Posit, Succ(Length(Data) - Posit));
Val(NumString, Row, Error);
if (Row <= MAXROWS) and (Error = 0) then
Good := True;
end;
end;
until Good;
GetCell := True;
end; { GetCell }
function GetYesNo;
begin
SetCursor(ULCursor);
GetYesNo := False;
WritePrompt(Prompt + ' ');
repeat
YesNo := UpCase(GetKey);
if YesNo = ESC then
Exit;
until YesNo in ['Y', 'N'];
SetCursor(NoCursor);
GetYesNo := True;
end; { GetYesNo }
function GetCommand;
var
Counter, Len : Word;
Ch : Char;
begin
Len := Length(MsgStr);
GotoXY(1, ScreenRows + 4);
ClrEol;
for Counter := 1 to Len do
begin
if MsgStr[Counter] in ['A'..'Z'] then
SetColor(COMMANDCOLOR)
else
SetColor(LOWCOMMANDCOLOR);
Write(MsgStr[Counter]);
end;
GotoXY(1, ScreenRows + 5);
repeat
Ch := UpCase(GetKey);
until (Pos(Ch, ComStr) <> 0) or (Ch = ESC);
ClearInput;
if Ch = ESC then
GetCommand := 0
else
GetCommand := Pos(Ch, ComStr);
end; { GetCommand }
end.


503
Borland Turbo Pascal v5/MCLIB.PAS Normal file
View File

@ -0,0 +1,503 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit MCLIB;
interface
uses Crt, Dos, MCVars, MCUtil, MCDisply, MCParser;
procedure DisplayCell(Col, Row : Word; Highlighting, Updating : Boolean);
{ Displays the contents of a cell }
function SetOFlags(Col, Row : Word; Display : Boolean) : Word;
{ Sets the overwrite flag on cells starting at (col + 1, row) - returns
the number of the column after the last column set.
}
procedure ClearOFlags(Col, Row : Word; Display : Boolean);
{ Clears the overwrite flag on cells starting at (col, row) }
procedure UpdateOFlags(Col, Row : Word; Display : Boolean);
{ Starting in col, moves back to the last TEXT cell and updates all flags }
procedure DeleteCell(Col, Row : Word; Display : Boolean);
{ Deletes a cell }
procedure SetLeftCol;
{ Sets the value of LeftCol based on the value of RightCol }
procedure SetRightCol;
{ Sets the value of rightcol based on the value of leftcol }
procedure SetTopRow;
{ Figures out the value of toprow based on the value of bottomrow }
procedure SetBottomRow;
{ Figures out the value of bottomrow based on the value of toprow }
procedure SetLastCol;
{ Sets the value of lastcol based on the current value }
procedure SetLastRow;
{ Sets the value of lastrow based on the current value }
procedure ClearLastCol;
{ Clears any data left in the last column }
procedure DisplayCol(Col : Word; Updating : Boolean);
{ Displays a column on the screen }
procedure DisplayRow(Row : Word; Updating : Boolean);
{ Displays a row on the screen }
procedure DisplayScreen(Updating : Boolean);
{ Displays the current screen of the spreadsheet }
procedure RedrawScreen;
{ Displays the entire screen }
procedure FixFormula(Col, Row, Action, Place : Word);
{ Modifies a formula when its column or row designations need to change }
procedure ChangeAutoCalc(NewMode : Boolean);
{ Changes and prints the current AutoCalc value on the screen }
procedure ChangeFormDisplay(NewMode : Boolean);
{ Changes and prints the current formula display value on the screen }
procedure Recalc;
{ Recalculates all of the numbers in the speadsheet }
procedure Act(S : String);
{ Acts on a particular input }
implementation
procedure DisplayCell;
var
Color : Word;
S : IString;
begin
if Updating and
((Cell[Col, Row] = Nil) or (Cell[Col, Row]^.Attrib <> FORMULA)) then
Exit;
S := CellString(Col, Row, Color, DOFORMAT);
if Highlighting then
begin
if Color = ERRORCOLOR then
Color := HIGHLIGHTERRORCOLOR
else
Color := HIGHLIGHTCOLOR;
end;
SetColor(Color);
WriteXY(S, ColStart[Succ(Col - LeftCol)], Row - TopRow + 3);
end; { DisplayCell }
function SetOFlags;
var
Len : Integer;
begin
Len := Length(Cell[Col, Row]^.T) - ColWidth[Col];
Inc(Col);
while (Col <= MAXCOLS) and (Len > 0) and (Cell[Col, Row] = nil) do
begin
Format[Col, Row] := Format[Col, Row] or OVERWRITE;
Dec(Len, ColWidth[Col]);
if Display and (Col >= LeftCol) and (Col <= RightCol) then
DisplayCell(Col, Row, NOHIGHLIGHT, NOUPDATE);
Inc(Col);
end;
SetOFlags := Col;
end; { SetOFlags }
procedure ClearOFlags;
begin
while (Col <= MAXCOLS) and (Format[Col, Row] >= OVERWRITE) and
(Cell[Col, Row] = nil) do
begin
Format[Col, Row] := Format[Col, Row] and (not OVERWRITE);
if Display and (Col >= LeftCol) and (Col <= RightCol) then
DisplayCell(Col, Row, NOHIGHLIGHT, NOUPDATE);
Inc(Col);
end;
end; { ClearOFlags }
procedure UpdateOFlags;
var
Dummy : Word;
begin
while (Cell[Col, Row] = nil) and (Col > 1) do
Dec(Col);
if (Cell[Col, Row] <> nil) and (Cell[Col, Row]^.Attrib = TXT) and
(Col >= 1) then
Dummy := SetOFlags(Col, Row, Display);
end; { UpdateOFlags }
procedure DeleteCell;
var
CPtr : CellPtr;
Size : Word;
begin
CPtr := Cell[Col, Row];
if CPtr = nil then
Exit;
case CPtr^.Attrib of
TXT : begin
Size := Length(CPtr^.T) + 3;
ClearOFlags(Succ(Col), Row, Display);
end;
VALUE : Size := SizeOf(Real) + 2;
FORMULA : Size := SizeOf(Real) + Length(CPtr^.Formula) + 3;
end; { case }
Format[Col, Row] := Format[Col, Row] and (not OVERWRITE);
FreeMem(CPtr, Size);
Cell[Col, Row] := nil;
if Col = LastCol then
SetLastCol;
if Row = LastRow then
SetLastRow;
UpdateOFlags(Col, Row, Display);
Changed := True;
end; { DeleteCell }
procedure SetLeftCol;
var
Col : Word;
Total : Integer;
begin
Total := 81;
Col := 0;
while (Total > LEFTMARGIN) and (RightCol - Col > 0) do
begin
Dec(Total, ColWidth[RightCol - Col]);
if Total > LEFTMARGIN then
ColStart[SCREENCOLS - Col] := Total;
Inc(Col);
end;
if Total > LEFTMARGIN then
Inc(Col);
Move(ColStart[SCREENCOLS - Col + 2], ColStart, Pred(Col));
LeftCol := RightCol - Col + 2;
Total := Pred(ColStart[1] - LEFTMARGIN);
if Total <> 0 then
begin
for Col := LeftCol to RightCol do
Dec(ColStart[Succ(Col - LeftCol)], Total);
end;
PrintCol;
end; { SetLeftCol }
procedure SetRightCol;
var
Total, Col : Word;
begin
Total := Succ(LEFTMARGIN);
Col := 1;
repeat
begin
ColStart[Col] := Total;
Inc(Total, ColWidth[Pred(LeftCol + Col)]);
Inc(Col);
end;
until (Total > 81) or (Pred(LeftCol + Col) > MAXCOLS);
if Total > 81 then
Dec(Col);
RightCol := LeftCol + Col - 2;
PrintCol;
end; { SetRightCol }
procedure SetTopRow;
begin
if BottomRow < ScreenRows then
BottomRow := ScreenRows;
TopRow := Succ(BottomRow - ScreenRows);
PrintRow;
end; { SetTopRow }
procedure SetBottomRow;
begin
if TopRow + ScreenRows > Succ(MAXROWS) then
TopRow := Succ(MAXROWS - ScreenRows);
BottomRow := Pred(TopRow + ScreenRows);
PrintRow;
end; { SetBottomRow }
procedure SetLastCol;
var
Row, Col : Word;
begin
for Col := LastCol downto 1 do
begin
for Row := 1 to LastRow do
begin
if Cell[Col, Row] <> nil then
begin
LastCol := Col;
Exit;
end;
end;
end;
LastCol := 1;
end; { SetLastCol }
procedure SetLastRow;
var
Row, Col : Word;
begin
for Row := LastRow downto 1 do
begin
for Col := 1 to LastCol do
begin
if Cell[Col, Row] <> nil then
begin
LastRow := Row;
Exit;
end;
end;
end;
LastRow := 1;
end; { SetLastRow }
procedure ClearLastCol;
var
Col : Word;
begin
Col := ColStart[Succ(RightCol - LeftCol)] + ColWidth[RightCol];
if (Col < 80) then
Scroll(UP, 0, Col, 3, 80, ScreenRows + 2, White);
end; { ClearLastCol }
procedure DisplayCol;
var
Row : Word;
begin
for Row := TopRow to BottomRow do
DisplayCell(Col, Row, NOHIGHLIGHT, Updating);
end; { DisplayCol }
procedure DisplayRow;
var
Col : Word;
begin
for Col := LeftCol to RightCol do
DisplayCell(Col, Row, NOHIGHLIGHT, Updating);
end; { DisplayRow }
procedure DisplayScreen;
var
Row : Word;
begin
for Row := TopRow to BottomRow do
DisplayRow(Row, Updating);
ClearLastCol;
end; { DisplayScreen }
procedure RedrawScreen;
begin
CurRow := 1;
CurCol := 1;
LeftCol := 1;
TopRow := 1;
SetRightCol;
SetBottomRow;
GotoXY(1, 1);
SetColor(MSGMEMORYCOLOR);
Write(MSGMEMORY);
GotoXY(29, 1);
SetColor(PROMPTCOLOR);
Write(MSGCOMMAND);
ChangeAutocalc(Autocalc);
ChangeFormDisplay(FormDisplay);
PrintFreeMem;
DisplayScreen(NOUPDATE);
end; { RedrawScreen }
procedure FixFormula;
var
FormLen, ColStart, RowStart, CurPos, FCol, FRow : Word;
CPtr : CellPtr;
Value : Real;
S : String[5];
NewFormula : IString;
Good : Boolean;
begin
CPtr := Cell[Col, Row];
CurPos := 1;
NewFormula := CPtr^.Formula;
while CurPos < Length(NewFormula) do
begin
if FormulaStart(NewFormula, CurPos, FCol, FRow, FormLen) then
begin
if FCol > 26 then
begin
RowStart := CurPos + 2;
ColStart := RowStart - 2;
end
else begin
RowStart := Succ(CurPos);
ColStart := Pred(RowStart);
end;
case Action of
COLADD : begin
if FCol >= Place then
begin
if FCol = 26 then
begin
if Length(NewFormula) = MAXINPUT then
begin
DeleteCell(Col, Row, NOUPDATE);
Good := AllocText(Col, Row, NewFormula);
Exit;
end;
end;
S := ColString(FCol);
Delete(NewFormula, ColStart, Length(S));
S := ColString(Succ(FCol));
Insert(S, NewFormula, ColStart);
end;
end;
ROWADD : begin
if FRow >= Place then
begin
if RowWidth(Succ(FRow)) <> RowWidth(FRow) then
begin
if Length(NewFormula) = MAXINPUT then
begin
DeleteCell(Col, Row, NOUPDATE);
Good := AllocText(Col, Row, NewFormula);
Exit;
end;
end;
S := WordToString(FRow, 1);
Delete(NewFormula, RowStart, Length(S));
S := WordToString(Succ(FRow), 1);
Insert(S, NewFormula, RowStart);
end;
end;
COLDEL : begin
if FCol > Place then
begin
S := ColString(FCol);
Delete(NewFormula, ColStart, Length(S));
S := ColString(Pred(FCol));
Insert(S, NewFormula, ColStart);
end;
end;
ROWDEL : begin
if FRow > Place then
begin
S := WordToString(FRow, 1);
Delete(NewFormula, RowStart, Length(S));
S := WordToString(Pred(FRow), 1);
Insert(S, NewFormula, RowStart);
end;
end;
end; { case }
Inc(CurPos, FormLen);
end
else
Inc(CurPos);
end;
if Length(NewFormula) <> Length(CPtr^.Formula) then
begin
Value := CPtr^.FValue;
DeleteCell(Col, Row, NOUPDATE);
Good := AllocFormula(Col, Row, NewFormula, Value);
end
else
CPtr^.Formula := NewFormula;
end; { FixFormula }
procedure ChangeAutoCalc;
var
S : String[15];
begin
if (not AutoCalc) and NewMode then
Recalc;
AutoCalc := NewMode;
if AutoCalc then
S := MSGAUTOCALC
else
S := '';
SetColor(MSGAUTOCALCCOLOR);
GotoXY(73, 1);
Write(S:Length(MSGAUTOCALC));
end; { ChangeAutoCalc }
procedure ChangeFormDisplay;
var
S : String[15];
begin
FormDisplay := NewMode;
if FormDisplay then
S := MSGFORMDISPLAY
else
S := '';
SetColor(MSGFORMDISPLAYCOLOR);
GotoXY(65, 1);
Write(S:Length(MSGFORMDISPLAY));
end; { ChangeFormDisplay }
procedure Recalc;
var
Col, Row, Attrib : Word;
begin
for Col := 1 to LastCol do
begin
for Row := 1 to LastRow do
begin
if ((Cell[Col, Row] <> nil) and (Cell[Col, Row]^.Attrib = FORMULA)) then
begin
Cell[Col, Row]^.FValue := Parse(Cell[Col, Row]^.Formula, Attrib);
Cell[Col, Row]^.Error := Attrib >= 4;
end;
end;
end;
DisplayScreen(UPDATE);
end; { Recalc }
procedure Act;
var
Attrib, Dummy : Word;
Allocated : Boolean;
V : Real;
begin
DeleteCell(CurCol, CurRow, UPDATE);
V := Parse(S, Attrib);
case (Attrib and 3) of
TXT : begin
Allocated := AllocText(CurCol, CurRow, S);
if Allocated then
DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
end;
VALUE : Allocated := AllocValue(CurCol, CurRow, V);
FORMULA : Allocated := AllocFormula(CurCol, CurRow, UpperCase(S), V);
end; { case }
if Allocated then
begin
if Attrib >= 4 then
begin
Cell[CurCol, CurRow]^.Error := True;
Dec(Attrib, 4);
end
else
Cell[CurCol, CurRow]^.Error := False;
Format[CurCol, CurRow] := Format[CurCol, CurRow] and (not OVERWRITE);
ClearOFlags(Succ(CurCol), CurRow, UPDATE);
if Attrib = TXT then
Dummy := SetOFlags(CurCol, CurRow, UPDATE);
if CurCol > LastCol then
LastCol := CurCol;
if CurRow > LastRow then
LastRow := CurRow;
if AutoCalc then
Recalc;
end
else
ErrorMsg(MSGLOMEM);
PrintFreeMem;
end; { Act }
end.


149
Borland Turbo Pascal v5/MCMVSMEM.ASM Normal file
View File

@ -0,0 +1,149 @@
; Copyright (c) 1985, 87 by Borland International, Inc.
TITLE MCMVSMEM
DATA SEGMENT WORD PUBLIC
ASSUME DS:DATA
EXTRN CheckSnow : BYTE
DATA ENDS
CODE SEGMENT BYTE PUBLIC
ASSUME CS:CODE
PUBLIC MoveToScreen, MoveFromScreen
; procedure MoveToScreen(var Source, Dest; Len : Word);
MoveToScreen PROC FAR
push bp
mov bp,sp
push bp ; Save Turbo's BP
push ds ; and DS
mov bh,ds:CheckSnow ; Load CheckSnow value
lds si,dword ptr [bp+12] ; Source pointer into DS:SI
les di,dword ptr [bp+8] ; Dest pointer into ES:DI
mov cx,[bp+6] ; Len value into CX
cmp cx,0 ; Quit if Len = 0
je x0
cmp si,di
jle x1
cld ; Set string direction to forward
jmp short x2
x1:
add si,cx
sub si,2
add di,cx
sub di,2
std
x2:
cmp bh,0
je x7
x3:
shr cx,1 ; Change bytes to words
mov dx,3DAh ; Point DX to CGA status port
mov bl,9 ; Move horiz. + vertical retrace mask to bl
x4:
lodsw ; Grab a video word
mov bp,ax ; Save it in BP
x5:
in al,dx ; Get 6845 status
rcr al,1 ; Check horizontal retrace
jb x5 ; Loop if in horizontal retrace: this prevents
; starting in mid-retrace, since there is
; exactly enough time for 1 and only 1 STOSW
; during horizontal retrace
cli ; No ints during critical section
x6:
in al,dx ; Get 6845 status
and al,bl ; Check for both kinds of retrace: IF the
; video board does not report horizontal
; retrace while in vertical retrace, this
; will allow several characters to be
; stuffed in during vertical retrace
jz x6 ; Loop if equal to zero
mov ax,bp ; Get the video word
stosw ; Store the video word
sti ; Allow interrupts
loop x4 ; Go do next word
jmp short x0
x7:
shr cx,1 ; Change bytes to words
rep movsw
x0:
pop ds ; Restore DS
pop bp ; and BP
mov sp,bp
pop bp
ret 10
MoveToScreen ENDP
; procedure MoveFromScreen(var Source, Dest; Len : Word);
MoveFromScreen PROC FAR
push bp
mov bp,sp
push bp ; Save Turbo's BP
push ds ; and DS
mov bh,ds:CheckSnow ; Load CheckSnow value
lds si,dword ptr [bp+12] ; Source pointer into DS:SI
les di,dword ptr [bp+8] ; Dest pointer into ES:DI
mov cx,[bp+6] ; Len value into CX
cmp cx,0 ; Quit if Len = 0
je y0
cmp si,di
jle y1
cld ; Set string direction to forward
jmp short y2
y1:
add si,cx
sub si,2
add di,cx
sub di,2
std
y2:
cmp bh,0
je y6
y3:
shr cx,1 ; Change bytes to words
mov dx,3DAh ; Point DX to CGA status port
y4:
in al,dx ; Get 6845 status
rcr al,1 ; Check horizontal retrace
jb y4 ; Loop if in horizontal retrace: this prevents
; starting in mid-retrace, since there is
; exactly enough time for 1 and only 1 LODSW
; during horizontal retrace
cli ; No ints during critical section
y5:
in al,dx ; Get 6845 status
rcr al,1 ; Check for horizontal retrace: LODSW is 1
; clock cycle slower than STOSW; because of
; this, the vertical retrace trick can't be
; used because it causes flicker! (RCR AL,1
; is 1 cycle faster than AND AL,AH)
jnb y5 ; Loop if not in retrace
lodsw ; Load the video word
sti ; Allow interrupts
stosw ; Store the video word
loop y4 ; Go do next word
jmp short y0
y6:
shr cx,1 ; Change bytes to words
rep movsw
y0:
pop ds ; Restore DS
pop bp ; and BP
mov sp,bp
pop bp
ret 10
MoveFromScreen ENDP
CODE ENDS
END


BIN
Borland Turbo Pascal v5/MCMVSMEM.OBJ Normal file
View File

Binary file not shown.

873
Borland Turbo Pascal v5/MCOMMAND.PAS Normal file
View File

@ -0,0 +1,873 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit MCOMMAND;
interface
uses Crt, Dos, MCVars, MCUtil, MCDisply, MCParser, MCLib, MCInput;
procedure CheckForSave;
{ If the spreadsheet has been changed, will ask the user if they want to
save it.
}
procedure MoveRowUp;
{ Moves up 1 row }
procedure MoveRowDown;
{ Moves down one row }
procedure MoveColLeft;
{ Moves left one column }
procedure MoveColRight;
{ Moves right one column }
procedure EditCell(ECell : CellPtr);
{ Edits a selected cell }
procedure ClearSheet;
{ Clears the current spreadsheet }
procedure LoadSheet(FileName : IString);
{ Loads a new spreadsheet }
procedure SaveSheet;
{ Saves the current spreadsheet }
function PageRows(Row : Word; TopPage, Border : Boolean) : Word;
{ Returns the number of rows to print }
function PageCols(Col, Columns : Word; Border : Boolean) : Word;
{ Returns the number of columns to print starting at col }
procedure PrintSheet;
{ Prints a copy of the spreadsheet to a file or to the printer }
procedure SetColWidth(Col : Word);
{ Sets the new column width for a selected column }
procedure GotoCell;
{ Moves to a selected cell }
procedure FormatCells;
{ Prompts the user for a selected format and range of cells }
procedure DeleteCol(Col : Word);
{ Deletes a column }
procedure InsertCol(Col : Word);
{ Inserts a column }
procedure DeleteRow(Row : Word);
{ Deletes a row }
procedure InsertRow(Row : Word);
{ Inserts a row }
procedure SMenu;
{ Executes the commands in the spreadsheet menu }
procedure CMenu;
{ Executes the commands in the column menu }
procedure RMenu;
{ Executes the commands in the row menu }
procedure UMenu;
{ Executes the commands in the utility menu }
procedure MainMenu;
{ Executes the commands in the main menu }
implementation
const
Name : String[80] = MSGNAME;
var
Rec : CellRec;
procedure CheckForSave;
var
Save : Char;
begin
if Changed and GetYesNo(Save, MSGSAVESHEET) and (Save = 'Y') then
SaveSheet;
end; { CheckForSave }
procedure MoveRowUp;
begin
DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
if CurRow > TopRow then
Dec(CurRow)
else if TopRow > 1 then
begin
Scroll(DOWN, 1, Succ(LEFTMARGIN), 3, 80, ScreenRows + 2, WHITE);
Dec(TopRow);
DisplayRow(TopRow, NOUPDATE);
Dec(CurRow);
SetBottomRow;
end;
end; { MoveRowUp }
procedure MoveRowDown;
begin
DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
if CurRow < BottomRow then
Inc(CurRow)
else if BottomRow < MAXROWS then
begin
Scroll(UP, 1, Succ(LEFTMARGIN), 3, 80, ScreenRows + 2, WHITE);
Inc(TopRow);
Inc(CurRow);
SetBottomRow;
DisplayRow(BottomRow, NOUPDATE);
end;
end; { MoveRowDown }
procedure MoveColLeft;
var
Col, OldLeftCol : Word;
OldColStart : array[1..SCREENCOLS] of Byte;
begin
OldLeftCol := LeftCol;
Move(ColStart, OldColStart, Sizeof(ColStart));
DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
if (CurCol > LeftCol) then
Dec(CurCol)
else if (LeftCol <> 1) then
begin
Dec(CurCol);
Dec(LeftCol);
SetRightCol;
SetLeftCol;
if OldLeftCol <= RightCol then
Scroll(RIGHT, Pred(ColStart[Succ(OldLeftCol - LeftCol)] - LEFTMARGIN),
Succ(LEFTMARGIN), 3, 80, ScreenRows + 2, WHITE);
ClearLastCol;
for Col := LeftCol to Pred(OldLeftCol) do
DisplayCol(Col, NOUPDATE);
end;
end; { MoveColLeft }
procedure MoveColRight;
var
Col, OldLeftCol, OldRightCol : Word;
OldColStart : array[1..SCREENCOLS] of Byte;
begin
OldLeftCol := LeftCol;
Move(ColStart, OldColStart, Sizeof(ColStart));
OldRightCol := RightCol;
DisplayCell(CurCol, CurRow, NOHIGHLIGHT, NOUPDATE);
if CurCol < RightCol then
Inc(CurCol)
else if RightCol < MAXCOLS then
begin
Inc(CurCol);
Inc(RightCol);
SetLeftCol;
SetRightCol;
if OldRightCol >= LeftCol then
Scroll(LEFT, Pred(OldColStart[Succ(LeftCol - OldLeftCol)] - LEFTMARGIN),
Succ(LEFTMARGIN), 3, 80, ScreenRows + 2, WHITE);
ClearLastCol;
for Col := Succ(OldRightCol) to RightCol do
DisplayCol(Col, NOUPDATE);
end;
end; { MoveColRight }
procedure EditCell;
var
S : IString;
begin
if ECell = nil then
Exit;
case ECell^.Attrib of
TXT : S := ECell^.T;
VALUE : Str(ECell^.Value:1:MAXPLACES, S);
FORMULA : S := ECell^.Formula;
end; { case }
if (not EditString(S, '', MAXINPUT)) or (S = '') then
Exit;
Act(S);
Changed := True;
end; { EditCell }
procedure ClearSheet;
var
Col, Row : Word;
begin
for Row := 1 to LastRow do
begin
for Col := 1 to LastCol do
DeleteCell(Col, Row, NOUPDATE);
end;
InitVars;
SetRightCol;
SetBottomRow;
DisplayScreen(NOUPDATE);
PrintFreeMem;
Changed := False;
end; { ClearSheet }
procedure LoadSheet;
var
Dummy, Size, RealLastCol, RealLastRow : Word;
F : File;
Check : String[80];
Allocated : Boolean;
Blocks : Word;
RealSize : Byte;
begin
RealLastCol := 1;
RealLastRow := 1;
if FileName = '' then
begin
WritePrompt(MSGFILENAME);
if not EditString(FileName, '', MAXINPUT) then
Exit;
end;
if not Exists(FileName) then
begin
ErrorMsg(MSGNOEXIST);
Exit;
end;
Assign(F, FileName);
Reset(F, 1);
if IOResult <> 0 then
begin
ErrorMsg(MSGNOOPEN);
Exit;
end;
BlockRead(F, Check[1], Length(Name), Blocks);
Check[0] := Chr(Length(Name));
if Check <> Name then
begin
ErrorMsg(MSGNOMICROCALC);
Close(F);
Exit;
end;
BlockRead(F, Size, 1, Blocks);
BlockRead(F, RealSize, 1, Blocks);
if RealSize <> SizeOf(Real) then
begin
ErrorMsg(MSGBADREALS);
Close(F);
Exit;
end;
SetColor(PROMPTCOLOR);
GotoXY(1, ScreenRows + 5);
Write(MSGLOADING);
GotoXY(Succ(Length(MSGLOADING)), ScreenRows + 5);
ClearSheet;
BlockRead(F, LastCol, SizeOf(LastCol), Blocks);
BlockRead(F, LastRow, SizeOf(LastRow), Blocks);
BlockRead(F, Size, SizeOf(Size), Blocks);
BlockRead(F, ColWidth, Sizeof(ColWidth), Blocks);
repeat
BlockRead(F, CurCol, SizeOf(CurCol), Blocks);
BlockRead(F, CurRow, SizeOf(CurRow), Blocks);
BlockRead(F, Format[CurCol, CurRow], 1, Blocks);
BlockRead(F, Size, SizeOf(Size), Blocks);
BlockRead(F, Rec, Size, Blocks);
case Rec.Attrib of
TXT : begin
Allocated := AllocText(CurCol, CurRow, Rec.T);
if Allocated then
Dummy := SetOFlags(CurCol, CurRow, NOUPDATE);
end;
VALUE : Allocated := AllocValue(CurCol, CurRow, Rec.Value);
FORMULA : Allocated := AllocFormula(CurCol, CurRow, Rec.Formula,
Rec.Fvalue);
end; { case }
if not Allocated then
begin
ErrorMsg(MSGFILELOMEM);
LastRow := RealLastRow;
LastCol := RealLastCol;
Format[CurCol, CurRow] := DEFAULTFORMAT;
end
else begin
Cell[CurCol, CurRow]^.Error := Rec.Error;
if CurCol > RealLastCol then
RealLastCol := CurCol;
if CurRow > RealLastRow then
RealLastRow := CurRow;
end;
until (not Allocated) or (EOF(F));
PrintFreeMem;
Close(F);
CurCol := 1;
CurRow := 1;
SetRightCol;
DisplayScreen(NOUPDATE);
SetColor(White);
GotoXY(1, ScreenRows + 5);
ClrEol;
Changed := False;
end; { LoadSheet }
procedure SaveSheet;
var
FileName : IString;
EndOfFile, Overwrite : Char;
Size, Col, Row : Word;
F : File;
CPtr : CellPtr;
Blocks : Word;
RealSize : Byte;
begin
EndOfFile := #26;
FileName := '';
RealSize := SizeOf(Real);
WritePrompt(MSGFILENAME);
if not EditString(FileName, '', MAXINPUT) then
Exit;
Assign(F, FileName);
if Exists(FileName) then
begin
if (not GetYesNo(Overwrite, MSGOVERWRITE)) or (Overwrite = 'N') then
Exit;
Reset(F, 1);
end
else
Rewrite(F, 1);
if IOResult <> 0 then
begin
ErrorMsg(MSGNOOPEN);
Exit;
end;
SetColor(PROMPTCOLOR);
GotoXY(1, ScreenRows + 5);
Write(MSGSAVING);
GotoXY(Length(MSGSAVING) + 1, ScreenRows + 5);
BlockWrite(F, Name[1], Length(Name), Blocks);
BlockWrite(F, EndOfFile, 1, Blocks);
BlockWrite(F, RealSize, 1, Blocks);
BlockWrite(F, LastCol, SizeOf(LastCol), Blocks);
BlockWrite(F, LastRow, SizeOf(LastRow), Blocks);
Size := MAXCOLS;
BlockWrite(F, Size, SizeOf(Size), Blocks);
BlockWrite(F, ColWidth, Sizeof(ColWidth), Blocks);
for Row := 1 to LastRow do
begin
for Col := LastCol downto 1 do
begin
if Cell[Col, Row] <> nil then
begin
CPtr := Cell[Col, Row];
case CPtr^.Attrib of
TXT : Size := Length(CPtr^.T) + 3;
VALUE : Size := Sizeof(Real) + 2;
FORMULA : Size := Length(CPtr^.Formula) + Sizeof(Real) + 3;
end; { case }
BlockWrite(F, Col, SizeOf(Col), Blocks);
BlockWrite(F, Row, SizeOf(Row), Blocks);
BlockWrite(F, Format[Col, Row], 1, Blocks);
BlockWrite(F, Size, SizeOf(Size), Blocks);
BlockWrite(F, CPtr^, Size, Blocks);
end;
end;
end;
Close(F);
SetColor(White);
GotoXY(1, ScreenRows + 5);
ClrEol;
Changed := False;
end; { SaveSheet }
function PageRows;
var
Rows : Word;
begin
if TopPage then
Rows := 66 - TOPMARGIN
else
Rows := 66;
if Border then
Dec(Rows);
if Pred(Row + Rows) > LastRow then
PageRows := Succ(LastRow - Row)
else
PageRows := Rows;
end; { PageRows }
function PageCols;
var
Len : Integer;
FirstCol : Word;
begin
if (Col = 1) and Border then
Len := Columns - LEFTMARGIN
else
Len := Columns;
FirstCol := Col;
while (Len > 0) and (Col <= LastCol) do
begin
Dec(Len, ColWidth[Col]);
Inc(Col);
end;
if Len < 0 then
Dec(Col);
PageCols := Col - FirstCol;
end; { PageCols }
procedure PrintSheet;
var
FileName : IString;
S : String[132];
ColStr : String[MAXCOLWIDTH];
F : Text;
Columns, Counter1, Counter2, Counter3, Col, Row, LCol, LRow, Dummy,
Printed, OldLastCol : Word;
Answer : Char;
Border, TopPage : Boolean;
begin
Col := 1;
WritePrompt(MSGPRINT);
FileName := '';
if not EditString(FileName, '', MAXINPUT) then
Exit;
if FileName = '' then
FileName := 'PRN';
Assign(F, FileName);
{$I-}
Rewrite(F);
if IOResult <> 0 then
begin
ErrorMsg(MSGNOOPEN);
Exit;
end;
{$I+}
OldLastCol := LastCol;
for Counter1 := 1 to LastRow do
begin
for Counter2 := LastCol to MAXCOLS do
begin
if Format[Counter2, Counter1] >= OVERWRITE then
LastCol := Counter2;
end;
end;
if not GetYesNo(Answer, MSGCOLUMNS) then
Exit;
if Answer = 'Y' then
Columns := 132
else
Columns := 80;
if not GetYesNo(Answer, MSGBORDER) then
Exit;
Border := Answer = 'Y';
while Col <= LastCol do
begin
Row := 1;
TopPage := True;
LCol := PageCols(Col, Columns, Border) + Col;
while Row <= LastRow do
begin
LRow := PageRows(Row, TopPage, Border) + Row;
Printed := 0;
if TopPage then
begin
for Counter1 := 1 to TOPMARGIN do
begin
Writeln(F);
Inc(Printed);
end;
end;
for Counter1 := Row to Pred(LRow) do
begin
if Border and (Counter1 = Row) and (TopPage) then
begin
if (Col = 1) and Border then
begin
S[0] := Chr(LEFTMARGIN);
FillChar(S[1], LEFTMARGIN, ' ');
end
else
S := '';
for Counter3 := Col to Pred(LCol) do
begin
ColStr := CenterColString(Counter3);
S := S + ColStr;
end;
Writeln(F, S);
Printed := Succ(Printed);
end;
if (Col = 1) and Border then
S := Pad(WordToString(Counter1, 1), LEFTMARGIN)
else
S := '';
for Counter2 := Col to Pred(LCol) do
S := S + CellString(Counter2, Counter1, Dummy, DOFORMAT);
Writeln(F, S);
Inc(Printed);
end;
Row := LRow;
TopPage := False;
if Printed < 66 then
Write(F, FORMFEED);
end;
Col := LCol;
end;
Close(F);
LastCol := OldLastCol;
end; { PrintSheet }
procedure SetColWidth;
var
Width, Row : Word;
begin
WritePrompt(MSGCOLWIDTH);
if not GetWord(Width, MINCOLWIDTH, MAXCOLWIDTH) then
Exit;
ColWidth[Col] := Width;
SetRightCol;
if RightCol < Col then
begin
RightCol := Col;
SetLeftCol;
SetRightCol;
end;
for Row := 1 to LastRow do
begin
if (Cell[Col, Row] <> nil) and (Cell[Col, Row]^.Attrib = TXT) then
ClearOFlags(Succ(Col), Row, NOUPDATE)
else
ClearOFlags(Col, Row, NOUPDATE);
UpdateOFlags(Col, Row, NOUPDATE);
end;
DisplayScreen(NOUPDATE);
Changed := True;
end; { SetColWidth }
procedure GotoCell;
begin
WritePrompt(MSGGOTO);
if not GetCell(CurCol, CurRow) then
Exit;
LeftCol := CurCol;
TopRow := CurRow;
SetBottomRow;
SetRightCol;
SetLeftCol;
DisplayScreen(NOUPDATE);
end; { GotoCell }
procedure FormatCells;
var
Col, Row, Col1, Col2, Row1, Row2, NewFormat, ITemp : Word;
Temp : Char;
begin
NewFormat := 0;
WritePrompt(MSGCELL1);
if not GetCell(Col1, Row1) then
Exit;
WritePrompt(MSGCELL2);
if not GetCell(Col2, Row2) then
Exit;
if (Col1 <> Col2) and (Row1 <> Row2) then
ErrorMsg(MSGDIFFCOLROW)
else begin
if Col1 > Col2 then
Switch(Col1, Col2);
if Row1 > Row2 then
Switch(Row1, Row2);
if not GetYesNo(Temp, MSGRIGHTJUST) then
Exit;
NewFormat := NewFormat + (Ord(Temp = 'Y') * RJUSTIFY);
if not GetYesNo(Temp, MSGDOLLAR) then
Exit;
NewFormat := NewFormat + (Ord(Temp = 'Y') * DOLLAR);
if not GetYesNo(Temp, MSGCOMMAS) then
Exit;
NewFormat := NewFormat + (Ord(Temp = 'Y') * COMMAS);
if (NewFormat and DOLLAR) <> 0 then
NewFormat := NewFormat + 2
else begin
WritePrompt(MSGPLACES);
if not GetWord(ITemp, 0, MAXPLACES) then
Exit;
NewFormat := NewFormat + ITemp;
end;
for Col := Col1 to Col2 do
begin
for Row := Row1 to Row2 do
begin
Format[Col, Row] := (Format[Col, Row] and OVERWRITE) or NewFormat;
if (Col >= LeftCol) and (Col <= RightCol) and
(Row >= TopRow) and (Row <= BottomRow) then
DisplayCell(Col, Row, NOHIGHLIGHT, NOUPDATE);
end;
end;
end;
Changed := True;
end; { FormatCells }
procedure DeleteCol;
var
OldLastCol, Counter, Row : Word;
begin
if Col > LastCol then
Exit;
OldLastCol := LastCol;
for Counter := 1 to LastRow do
DeleteCell(Col, Counter, NOUPDATE);
PrintFreeMem;
if Col <> OldLastCol then
begin
Move(Cell[Succ(Col), 1], Cell[Col, 1], MAXROWS * Sizeof(CellPtr) *
(OldLastCol - Col));
Move(Format[Succ(Col), 1], Format[Col, 1], MAXROWS * (OldLastCol - Col));
Move(ColWidth[Succ(Col)], ColWidth[Col], OldLastCol - Col);
end;
FillChar(Cell[OldLastCol, 1], MAXROWS * Sizeof(CellPtr), 0);
FillChar(Format[OldLastCol, 1], MAXROWS, DEFAULTFORMAT);
ColWidth[OldLastCol] := DEFAULTWIDTH;
SetRightCol;
if CurCol > RightCol then
begin
Inc(RightCol);
SetLeftCol;
end;
ClearLastCol;
if OldLastCol = LastCol then
Dec(LastCol);
for Counter := 1 to LastCol do
begin
for Row := 1 to LastRow do
begin
if (Cell[Counter, Row] <> nil) and
(Cell[Counter, Row]^.Attrib = FORMULA) then
FixFormula(Counter, Row, COLDEL, Col);
UpdateOFlags(Col, Row, NOUPDATE);
end;
end;
for Counter := Col to RightCol do
DisplayCol(Counter, NOUPDATE);
LastCol := MAXCOLS;
SetLastCol;
Changed := True;
Recalc;
end; { DeleteCol }
procedure InsertCol;
var
Counter, Row : Word;
begin
if (LastCol = MAXCOLS) or (Col > LastCol) then
Exit;
if Col <> LastCol then
begin
Move(Cell[Col, 1], Cell[Col + 1, 1], MAXROWS * Sizeof(CellPtr) *
Succ(LastCol - Col));
Move(Format[Col, 1], Format[Col + 1, 1], MAXROWS * Succ(LastCol - Col));
Move(ColWidth[Col], ColWidth[Col + 1], Succ(LastCol - Col));
end;
if LastCol < MAXCOLS then
Inc(LastCol);
FillChar(Cell[Col, 1], MAXROWS * Sizeof(CellPtr), 0);
FillChar(Format[Col, 1], MAXROWS, DEFAULTFORMAT);
ColWidth[Col] := DEFAULTWIDTH;
SetRightCol;
if CurCol > RightCol then
begin
Inc(RightCol);
SetLeftCol;
end;
for Counter := 1 to LastCol do
begin
for Row := 1 to LastRow do
begin
if (Cell[Counter, Row] <> nil) and
(Cell[Counter, Row]^.Attrib = FORMULA) then
FixFormula(Counter, Row, COLADD, Col);
UpdateOFlags(Col, Row, NOUPDATE);
end;
end;
for Counter := Col to RightCol do
DisplayCol(Counter, NOUPDATE);
LastCol := MAXCOLS;
SetLastCol;
Changed := True;
Recalc;
end; { InsertCol }
procedure DeleteRow;
var
OldLastRow, Counter, RowC : Word;
begin
if Row > LastRow then
Exit;
OldLastRow := LastRow;
for Counter := 1 to LastCol do
DeleteCell(Counter, Row, NOUPDATE);
PrintFreeMem;
if Row <> OldLastRow then
begin
for Counter := 1 to MAXCOLS do
begin
Move(Cell[Counter, Succ(Row)], Cell[Counter, Row],
Sizeof(CellPtr) * (OldLastRow - Row));
Move(Format[Counter, Succ(Row)], Format[Counter, Row],
OldLastRow - Row);
end;
end;
for Counter := 1 to LastCol do
begin
Cell[Counter, OldLastRow] := nil;
Format[Counter, OldLastRow] := DEFAULTFORMAT;
end;
if OldLastRow = LastRow then
Dec(LastRow);
for Counter := 1 to LastCol do
begin
for RowC := 1 to LastRow do
begin
if (Cell[Counter, RowC] <> nil) and
(Cell[Counter, RowC]^.Attrib = FORMULA) then
FixFormula(Counter, RowC, ROWDEL, Row);
end;
end;
for Counter := Row to BottomRow do
DisplayRow(Counter, NOUPDATE);
LastRow := MAXROWS;
SetLastRow;
Changed := True;
Recalc;
end; { DeleteRow }
procedure InsertRow;
var
Counter, RowC : Word;
begin
if (LastRow = MAXROWS) or (Row > LastRow) then
Exit;
if Row <> LastRow then
begin
for Counter := 1 to MAXCOLS do
begin
Move(Cell[Counter, Row], Cell[Counter, Succ(Row)],
Sizeof(CellPtr) * Succ(LastRow - Row));
Move(Format[Counter, Row], Format[Counter, Succ(Row)],
Succ(LastRow - Row));
end;
end;
Inc(LastRow);
for Counter := 1 to LastCol do
begin
Cell[Counter, Row] := nil;
Format[Counter, Row] := DEFAULTFORMAT;
end;
for Counter := 1 to LastCol do
begin
for RowC := 1 to LastRow do
begin
if (Cell[Counter, RowC] <> nil) and
(Cell[Counter, RowC]^.Attrib = FORMULA) then
FixFormula(Counter, RowC, ROWADD, Row);
end;
end;
for Counter := Row to BottomRow do
DisplayRow(Counter, NOUPDATE);
LastRow := MAXROWS;
SetLastRow;
Changed := True;
Recalc;
end; { InsertRow }
procedure SMenu;
var
FileName : IString;
X : Word;
begin
FileName := '';
case GetCommand(SMNU, SCOMMAND) of
1 : begin
CheckForSave;
LoadSheet(FileName);
end;
2 : SaveSheet;
3 : PrintSheet;
4 : begin
CheckForSave;
ClearSheet;
end;
end; { case }
end; { SMenu }
procedure CMenu;
begin
case GetCommand(CMNU, CCOMMAND) of
1 : InsertCol(CurCol);
2 : DeleteCol(CurCol);
3 : SetColWidth(CurCol);
end; { case }
end; { CMenu }
procedure RMenu;
begin
case GetCommand(RMNU, RCOMMAND) of
1 : InsertRow(CurRow);
2 : DeleteRow(CurRow);
end; { case }
end; { CMenu }
procedure UMenu;
begin
case GetCommand(UMenuString, UCommandString) of
1 : Recalc;
2 : begin
ChangeFormDisplay(not FormDisplay);
DisplayScreen(UPDATE);
end;
3 : begin
if ScreenRows = 38 then
begin
ScreenRows := 20;
TextMode(Lo(LastMode));
SetCursor(NoCursor);
RedrawScreen;
end
else begin
TextMode(Lo(LastMode) + Font8x8);
if (LastMode and Font8x8) <> 0 then
begin
ScreenRows := 38;
SetCursor(NoCursor);
RedrawScreen;
end;
end;
end;
end; { case }
end; { UMenu }
procedure MainMenu;
begin
case GetCommand(MNU, COMMAND) of
1 : SMenu;
2 : FormatCells;
3 : begin
DeleteCell(CurCol, CurRow, UPDATE);
PrintFreeMem;
if AutoCalc then
Recalc;
end;
4 : GotoCell;
5 : CMenu;
6 : RMenu;
7 : EditCell(CurCell);
8 : UMenu;
9 : ChangeAutoCalc(not AutoCalc);
10 : begin
CheckForSave;
Stop := True;
end;
end; { case }
GotoXY(1, ScreenRows + 4);
ClrEol;
end; { MainMenu }
end.


579
Borland Turbo Pascal v5/MCPARSER.PAS Normal file
View File

@ -0,0 +1,579 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit MCPARSER;
interface
uses Crt, Dos, MCVars, MCUtil, MCDisply;
function CellValue(Col, Row : Word) : Real;
{ Finds the Value of a particular cell }
function Parse(S : String; var Att : Word) : Real;
{ Parses the string s - returns the Value of the evaluated string, and puts
the attribute in Att: TXT = 0, CONSTANT = 1, FORMULA = 2, +4 = ERROR.
}
implementation
const
PLUS = 0;
MINUS = 1;
TIMES = 2;
DIVIDE = 3;
EXPO = 4;
COLON = 5;
OPAREN = 6;
CPAREN = 7;
NUM = 8;
CELLT = 9;
FUNC = 10;
EOL = 11;
BAD = 12;
MAXFUNCNAMELEN = 5;
type
TokenRec = record
State : Byte;
case Byte of
0 : (Value : Real);
1 : (Row, Col : Word);
2 : (FuncName : String[MAXFUNCNAMELEN]);
end;
var
Stack : array [1..PARSERSTACKSIZE] of TokenRec;
CurToken : TokenRec;
StackTop, TokenType : Word;
MathError, TokenError, IsFormula : Boolean;
Input : IString;
function IsFunc(S : String) : Boolean;
{ Checks to see if the start of the Input string is a legal function.
Returns TRUE if it is, FALSE otherwise.
}
var
Len : Word;
begin
Len := Length(S);
if Pos(S, Input) = 1 then
begin
CurToken.FuncName := Copy(Input, 1, Len);
Delete(Input, 1, Len);
IsFunc := True;
end
else
IsFunc := False;
end; { IsFunc }
function NextToken : Word;
{ Gets the next Token from the Input stream }
var
NumString : String[80];
FormLen, Place, Len, NumLen, Check : Word;
FirstChar : Char;
Decimal : Boolean;
begin
if Input = '' then
begin
NextToken := EOL;
Exit;
end;
while (Input <> '') and (Input[1] = ' ') do
Delete(Input, 1, 1);
if Input[1] in ['0'..'9', '.'] then
begin
NumString := '';
Len := 1;
Decimal := False;
while (Len <= Length(Input)) and
((Input[Len] in ['0'..'9']) or
((Input[Len] = '.') and (not Decimal))) do
begin
NumString := NumString + Input[Len];
if Input[1] = '.' then
Decimal := True;
Inc(Len);
end;
if (Len = 2) and (Input[1] = '.') then
begin
NextToken := BAD;
Exit;
end;
if (Len <= Length(Input)) and (Input[Len] = 'E') then
begin
NumString := NumString + 'E';
Inc(Len);
if Input[Len] in ['+', '-'] then
begin
NumString := NumString + Input[Len];
Inc(Len);
end;
NumLen := 1;
while (Len <= Length(Input)) and (Input[Len] in ['0'..'9']) and
(NumLen <= MAXEXPLEN) do
begin
NumString := NumString + Input[Len];
Inc(NumLen);
Inc(Len);
end;
end;
if NumString[1] = '.' then
NumString := '0' + NumString;
Val(NumString, CurToken.Value, Check);
if Check <> 0 then
MathError := True;
NextToken := NUM;
Delete(Input, 1, Length(NumString));
Exit;
end
else if Input[1] in LETTERS then
begin
if IsFunc('ABS') or
IsFunc('ATAN') or
IsFunc('COS') or
IsFunc('EXP') or
IsFunc('LN') or
IsFunc('ROUND') or
IsFunc('SIN') or
IsFunc('SQRT') or
IsFunc('SQR') or
IsFunc('TRUNC') then
begin
NextToken := FUNC;
Exit;
end;
if FormulaStart(Input, 1, CurToken.Col, CurToken.Row, FormLen) then
begin
Delete(Input, 1, FormLen);
IsFormula := True;
NextToken := CELLT;
Exit;
end
else begin
NextToken := BAD;
Exit;
end;
end
else begin
case Input[1] of
'+' : NextToken := PLUS;
'-' : NextToken := MINUS;
'*' : NextToken := TIMES;
'/' : NextToken := DIVIDE;
'^' : NextToken := EXPO;
':' : NextToken := COLON;
'(' : NextToken := OPAREN;
')' : NextToken := CPAREN;
else
NextToken := BAD;
end;
Delete(Input, 1, 1);
Exit;
end; { case }
end; { NextToken }
procedure Push(Token : TokenRec);
{ Pushes a new Token onto the stack }
begin
if StackTop = PARSERSTACKSIZE then
begin
ErrorMsg(MSGSTACKERROR);
TokenError := True;
end
else begin
Inc(StackTop);
Stack[StackTop] := Token;
end;
end; { Push }
procedure Pop(var Token : TokenRec);
{ Pops the top Token off of the stack }
begin
Token := Stack[StackTop];
Dec(StackTop);
end; { Pop }
function GotoState(Production : Word) : Word;
{ Finds the new state based on the just-completed production and the
top state.
}
var
State : Word;
begin
State := Stack[StackTop].State;
if (Production <= 3) then
begin
case State of
0 : GotoState := 1;
9 : GotoState := 19;
20 : GotoState := 28;
end; { case }
end
else if Production <= 6 then
begin
case State of
0, 9, 20 : GotoState := 2;
12 : GotoState := 21;
13 : GotoState := 22;
end; { case }
end
else if Production <= 8 then
begin
case State of
0, 9, 12, 13, 20 : GotoState := 3;
14 : GotoState := 23;
15 : GotoState := 24;
16 : GotoState := 25;
end; { case }
end
else if Production <= 10 then
begin
case State of
0, 9, 12..16, 20 : GotoState := 4;
end; { case }
end
else if Production <= 12 then
begin
case State of
0, 9, 12..16, 20 : GotoState := 6;
5 : GotoState := 17;
end; { case }
end
else begin
case State of
0, 5, 9, 12..16, 20 : GotoState := 8;
end; { case }
end;
end; { GotoState }
function CellValue;
var
CPtr : CellPtr;
begin
CPtr := Cell[Col, Row];
if (CPtr = nil) then
CellValue := 0
else begin
if (CPtr^.Error) or (CPtr^.Attrib = TXT) then
MathError := True;
if CPtr^.Attrib = FORMULA then
CellValue := CPtr^.FValue
else
CellValue := CPtr^.Value;
end;
end; { CellValue }
procedure Shift(State : Word);
{ Shifts a Token onto the stack }
begin
CurToken.State := State;
Push(CurToken);
TokenType := NextToken;
end; { Shift }
procedure Reduce(Reduction : Word);
{ Completes a reduction }
var
Token1, Token2 : TokenRec;
Counter : Word;
begin
case Reduction of
1 : begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
CurToken.Value := Token1.Value + Token2.Value;
end;
2 : begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
CurToken.Value := Token2.Value - Token1.Value;
end;
4 : begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
CurToken.Value := Token1.Value * Token2.Value;
end;
5 : begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
if Token1.Value = 0 then
MathError := True
else
CurToken.Value := Token2.Value / Token1.Value;
end;
7 : begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
if Token2.Value <= 0 then
MathError := True
else if (Token1.Value * Ln(Token2.Value) < -EXPLIMIT) or
(Token1.Value * Ln(Token2.Value) > EXPLIMIT) then
MathError := True
else
CurToken.Value := Exp(Token1.Value * Ln(Token2.Value));
end;
9 : begin
Pop(Token1);
Pop(Token2);
CurToken.Value := -Token1.Value;
end;
11 : begin
Pop(Token1);
Pop(Token2);
Pop(Token2);
CurToken.Value := 0;
if Token1.Row = Token2.Row then
begin
if Token1.Col < Token2.Col then
TokenError := True
else begin
for Counter := Token2.Col to Token1.Col do
CurToken.Value := CurToken.Value + CellValue(Counter, Token1.Row);
end;
end
else if Token1.Col = Token2.Col then
begin
if Token1.Row < Token2.Row then
TokenError := True
else begin
for Counter := Token2.Row to Token1.Row do
CurToken.Value := CurToken.Value + CellValue(Token1.Col, Counter);
end;
end
else
TokenError := True;
end;
13 : begin
Pop(CurToken);
CurToken.Value := CellValue(CurToken.Col, CurToken.Row);
end;
14 : begin
Pop(Token1);
Pop(CurToken);
Pop(Token1);
end;
16 : begin
Pop(Token1);
Pop(CurToken);
Pop(Token1);
Pop(Token1);
if Token1.FuncName = 'ABS' then
CurToken.Value := Abs(CurToken.Value)
else if Token1.FuncName = 'ATAN' then
CurToken.Value := ArcTan(CurToken.Value)
else if Token1.FuncName = 'COS' then
CurToken.Value := Cos(CurToken.Value)
else if Token1.FuncName = 'EXP' then
begin
if (CurToken.Value < -EXPLIMIT) or (CurToken.Value > EXPLIMIT) then
MathError := True
else
CurToken.Value := Exp(CurToken.Value);
end
else if Token1.FuncName = 'LN' then
begin
if CurToken.Value <= 0 then
MathError := True
else
CurToken.Value := Ln(CurToken.Value);
end
else if Token1.FuncName = 'ROUND' then
begin
if (CurToken.Value < -1E9) or (CurToken.Value > 1E9) then
MathError := True
else
CurToken.Value := Round(CurToken.Value);
end
else if Token1.FuncName = 'SIN' then
CurToken.Value := Sin(CurToken.Value)
else if Token1.FuncName = 'SQRT' then
begin
if CurToken.Value < 0 then
MathError := True
else
CurToken.Value := Sqrt(CurToken.Value);
end
else if Token1.FuncName = 'SQR' then
begin
if (CurToken.Value < -SQRLIMIT) or (CurToken.Value > SQRLIMIT) then
MathError := True
else
CurToken.Value := Sqr(CurToken.Value);
end
else if Token1.FuncName = 'TRUNC' then
begin
if (CurToken.Value < -1E9) or (CurToken.Value > 1E9) then
MathError := True
else
CurToken.Value := Trunc(CurToken.Value);
end;
end;
3, 6, 8, 10, 12, 15 : Pop(CurToken);
end; { case }
CurToken.State := GotoState(Reduction);
Push(CurToken);
end; { Reduce }
function Parse;
var
FirstToken : TokenRec;
Accepted : Boolean;
Counter : Word;
begin
Accepted := False;
TokenError := False;
MathError := False;
IsFormula := False;
Input := UpperCase(S);
StackTop := 0;
FirstToken.State := 0;
FirstToken.Value := 0;
Push(FirstToken);
TokenType := NextToken;
repeat
case Stack[StackTop].State of
0, 9, 12..16, 20 : begin
if TokenType = NUM then
Shift(10)
else if TokenType = CELLT then
Shift(7)
else if TokenType = FUNC then
Shift(11)
else if TokenType = MINUS then
Shift(5)
else if TokenType = OPAREN then
Shift(9)
else
TokenError := True;
end;
1 : begin
if TokenType = EOL then
Accepted := True
else if TokenType = PLUS then
Shift(12)
else if TokenType = MINUS then
Shift(13)
else
TokenError := True;
end;
2 : begin
if TokenType = TIMES then
Shift(14)
else if TokenType = DIVIDE then
Shift(15)
else
Reduce(3);
end;
3 : Reduce(6);
4 : begin
if TokenType = EXPO then
Shift(16)
else
Reduce(8);
end;
5 : begin
if TokenType = NUM then
Shift(10)
else if TokenType = CELLT then
Shift(7)
else if TokenType = FUNC then
Shift(11)
else if TokenType = OPAREN then
Shift(9)
else
TokenError := True;
end;
6 : Reduce(10);
7 : begin
if TokenType = COLON then
Shift(18)
else
Reduce(13);
end;
8 : Reduce(12);
10 : Reduce(15);
11 : begin
if TokenType = OPAREN then
Shift(20)
else
TokenError := True;
end;
17 : Reduce(9);
18 : begin
if TokenType = CELLT then
Shift(26)
else
TokenError := True;
end;
19 : begin
if TokenType = PLUS then
Shift(12)
else if TokenType = MINUS then
Shift(13)
else if TokenType = CPAREN then
Shift(27)
else
TokenError := True;
end;
21 : begin
if TokenType = TIMES then
Shift(14)
else if TokenType = DIVIDE then
Shift(15)
else
Reduce(1);
end;
22 : begin
if TokenType = TIMES then
Shift(14)
else if TokenType = DIVIDE then
Shift(15)
else
Reduce(2);
end;
23 : Reduce(4);
24 : Reduce(5);
25 : Reduce(7);
26 : Reduce(11);
27 : Reduce(14);
28 : begin
if TokenType = PLUS then
Shift(12)
else if TokenType = MINUS then
Shift(13)
else if TokenType = CPAREN then
Shift(29)
else
TokenError := True;
end;
29 : Reduce(16);
end; { case }
until Accepted or TokenError;
if TokenError then
begin
Att := TXT;
Parse := 0;
Exit;
end;
if IsFormula then
Att := FORMULA
else
Att := VALUE;
if MathError then
begin
Inc(Att, 4);
Parse := 0;
Exit;
end;
Parse := Stack[StackTop].Value;
end; { Parse }
end.


417
Borland Turbo Pascal v5/MCUTIL.PAS Normal file
View File

@ -0,0 +1,417 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit MCUTIL;
interface
uses Crt, Dos, MCVars;
function Pad(S : String; Len : Word) : String;
{ Pads a string on the right with spaces to a specified length }
function Spaces(Num : Word) : String;
{ Returns a string of the specified number of spaces }
function UpperCase(S : String) : String;
{ Returns a string of all upper case letters }
function WordToString(Num, Len : Word) : String;
{ Changes a word to a string }
function RealToString(Num : Real; Len, Places : Word) : String;
{ Changes a real to a string }
function AllocText(Col, Row : Word; S : String) : Boolean;
{ Allocates space for a text cell }
function AllocValue(Col, Row : Word; Amt : Real) : Boolean;
{ Allocates space for a value cell }
function AllocFormula(Col, Row : Word; S : String; Amt : Real) : Boolean;
{ Allocates space for a formula cell }
function RowWidth(Row : Word) : Word;
{ Returns the width in spaces of row }
function FormulaStart(Input : String; Place : Word;
var Col, Row, FormLen : Word) : Boolean;
{ Returns TRUE if the string is the start of a formula, FALSE otherwise.
Also returns the column, row, and length of the formula.
}
function ColString(Col : Word) : String;
{ Changes a column number to a string }
function CenterColString(Col : Word) : String;
{ Changes a column to a centered string }
function TextString(InString : String; Col, FValue : Word;
Formatting : Boolean) : String;
{ Sets the string representation of text }
function ValueString(CPtr : CellPtr; Value : Real; Col, FValue : Word;
var Color : Word; Formatting : Boolean) : String;
{ Sets the string representation of a value }
function CellString(Col, Row : Word; var Color : Word;
Formatting : Boolean) : String;
{ Creates an output string for the data in the cell in (col, row), and
also returns the color of the cell }
procedure Switch(var Val1, Val2 : Word);
{ Swaps the first and second values }
procedure InitVars;
{ Initializes various global variables }
function Exists(FileName : String) : Boolean;
{ Returns True if the file FileName exists, False otherwise }
implementation
{$F+}
function HeapFunc(Size : Word) : Word;
{ Used to handle heap errors }
begin
HeapFunc := 1; { Forces New or GetMem to return a nil pointer }
end; { HeapFunc }
{$F-}
function Pad;
begin
if Length(S) < Len then
FillChar(S[Succ(Length(S))], Len - Length(S), ' ');
S[0] := Chr(Len);
Pad := S;
end; { Pad }
function Spaces;
var
S : String;
begin
S[0] := Chr(Num);
FillChar(S[1], Num, ' ');
Spaces := S;
end; { Spaces }
function UpperCase;
var
Counter : Word;
begin
for Counter := 1 to Length(S) do
S[Counter] := UpCase(S[Counter]);
UpperCase := S;
end; { UpperCase }
function WordToString;
var
S : String[5];
begin
Str(Num:Len, S);
WordToString := S;
end; { WordToString }
function RealToString;
var
S : String[80];
begin
Str(Num:Len:Places, S);
RealToString := S;
end; { RealToString }
function AllocText;
var
CPtr : CellPtr;
begin
AllocText := False;
GetMem(CPtr, Length(S) + 3);
if CPtr = nil then
Exit;
CPtr^.Attrib := TXT;
CPtr^.Error := False;
CPtr^.T := S;
Cell[Col, Row] := CPtr;
AllocText := True;
end; { AllocText }
function AllocValue;
var
CPtr : CellPtr;
begin
AllocValue := False;
GetMem(CPtr, SizeOf(Real) + 2);
if CPtr = nil then
Exit;
CPtr^.Attrib := VALUE;
CPtr^.Error := False;
CPtr^.Value := Amt;
Cell[Col, Row] := CPtr;
AllocValue := True;
end; { AllocValue }
function AllocFormula;
var
CPtr : CellPtr;
begin
AllocFormula := False;
GetMem(CPtr, Length(S) + SizeOf(Real) + 3);
if CPtr = nil then
Exit;
CPtr^.Attrib := FORMULA;
CPtr^.Error := False;
CPtr^.Formula := S;
CPtr^.FValue := Amt;
Cell[Col, Row] := CPtr;
AllocFormula := True;
end; { AllocFormula }
function RowWidth;
begin
RowWidth := Succ(Trunc(Ln(Row) / Ln(10)));
end; { RowWidth }
function FormulaStart;
var
OldPlace, Len, MaxLen : Word;
Start : IString;
NumString : String[10];
begin
FormulaStart := False;
OldPlace := Place;
MaxLen := RowWidth(MAXROWS);
if not (Input[Place] in LETTERS) then
Exit;
Col := Succ(Ord(Input[Place]) - Ord('A'));
Inc(Place);
if Input[Place] in LETTERS then
begin
Col := Col * 26;
Col := Succ(Col + Ord(Input[Place]) - Ord('A'));
Inc(Place);
end;
if Col > MAXCOLS then
Exit;
Start := Copy(Input, Place, MaxLen);
Len := 0;
while (Place <= Length(Input)) and
(Input[Place] in ['0'..'9']) and (Len < MaxLen) do
begin
Inc(Len);
Inc(Place);
end;
if Len = 0 then
Exit;
NumString := Copy(Start, 1, Len);
Val(NumString, Row, Len);
if Row > MAXROWS then
Exit;
FormLen := Place - OldPlace;
FormulaStart := True;
end; { FormulaStart }
function ColString;
begin
if Col <= 26 then
ColString := Chr(Pred(Col) + Ord('A'))
else
ColString := Chr((Pred(Col) div 26) + Pred(Ord('A'))) +
Chr((Pred(Col) mod 26) + Ord('A'));
end; { ColString }
function CenterColString;
var
S : String[2];
Spaces1, Spaces2 : Word;
begin
S := ColString(Col);
Spaces1 := (ColWidth[Col] - Length(S)) shr 1;
Spaces2 := ColWidth[Col] - Length(S) - Spaces1;
CenterColString := Spaces(Spaces1) + S + Spaces(Spaces2);
end; { CenterColString }
function TextString;
var
OutString : String[80];
begin
if ((FValue and RJUSTIFY) <> 0) and Formatting then
begin
OutString := InString;
if Length(OutString) < ColWidth[Col] then
begin
while Length(OutString) < ColWidth[Col] do
OutString := ' ' + OutString;
end
else
OutString[0] := Chr(ColWidth[Col]);
end
else begin
if Formatting then
OutString := Pad(InString, ColWidth[Col])
else
OutString := InString;
end;
TextString := OutString;
end; { TextString }
function ValueString;
var
VString : String[MAXCOLWIDTH];
FString : String[3];
Width, P : Word;
begin
if Formatting then
begin
Str(CPtr^.Value:1:(FValue and 15), VString);
if (FValue and COMMAS) <> 0 then
begin
P := Pos('.', VString);
if P = 0 then
P := Succ(Length(VString));
while P > 4 do
begin
P := P - 3;
if VString[Pred(P)] <> '-' then
Insert(',', VString, P);
end;
end;
if (FValue and DOLLAR) <> 0 then
begin
if VString[1] = '-' then
begin
FString := ' $';
Width := ColWidth[Col] - 2;
end
else begin
FString := ' $ ';
Width := ColWidth[Col] - 3;
end;
end
else begin
Width := ColWidth[Col];
FString := '';
end;
if (FValue and RJUSTIFY) <> 0 then
begin
if Length(VString) > Width then
Delete(VString, Succ(Width), Length(VString) - Width)
else begin
while Length(VString) < Width do
VString := ' ' + VString;
end;
end
else
VString := Pad(VString, Width);
VString := FString + VString;
end
else
Str(Value:1:MAXPLACES, VString);
Color := VALUECOLOR;
ValueString := VString;
end; { ValueString }
function CellString;
var
CPtr : CellPtr;
OldCol, P, NewCol, FormatValue : Word;
S : String[80];
V : Real;
begin
CPtr := Cell[Col, Row];
if CPtr = nil then
begin
if (not Formatting) or (Format[Col, Row] < OVERWRITE) then
begin
S := Spaces(ColWidth[Col]);
Color := BLANKCOLOR;
end
else begin
NewCol := Col;
Dec(NewCol);
while Cell[NewCol, Row] = nil do
Dec(NewCol);
OldCol := NewCol;
P := 1;
while (NewCol < Col) do
begin
Inc(P, ColWidth[NewCol]);
Inc(NewCol);
end;
S := Copy(Cell[OldCol, Row]^.T, P, ColWidth[Col]);
S := S + Spaces(ColWidth[Col] - Length(S));
Color := TXTCOLOR;
end;
end
else begin
FormatValue := Format[Col, Row];
if CPtr^.Error and (Formatting or (CPtr^.Attrib = VALUE)) then
begin
S := Pad(MSGERRORTXT, ColWidth[Col]);
Color := ERRORCOLOR;
end
else begin
case CPtr^.Attrib of
TXT : begin
S := TextString(CPtr^.T, Col, FormatValue, Formatting);
Color := TXTCOLOR;
end;
FORMULA : begin
if FormDisplay then
begin
S := TextString(CPtr^.Formula, Col, FormatValue, Formatting);
Color := FORMULACOLOR;
end
else begin
V := CPtr^.FValue;
S := ValueString(CPtr, V, Col, FormatValue, Color, Formatting);
end;
end;
VALUE : begin
V := CPtr^.Value;
S := ValueString(CPtr, V, Col, FormatValue, Color, Formatting);
end;
end; { case }
end;
end;
CellString := S;
end; { CellString }
procedure Switch;
var
Temp : Word;
begin
Temp := Val1;
Val1 := Val2;
Val2 := Temp;
end; { Switch }
procedure InitVars;
begin
LeftCol := 1;
TopRow := 1;
CurCol := 1;
Currow := 1;
LastCol := 1;
LastRow := 1;
AutoCalc := True;
FormDisplay := False;
FillChar(ColWidth, SizeOf(ColWidth), DEFAULTWIDTH);
FillChar(Cell, SizeOf(Cell), 0);
FillChar(Format, SizeOf(Format), DEFAULTFORMAT);
end; { InitVars }
function Exists;
var
SR : SearchRec;
begin
FindFirst(FileName, ReadOnly + Hidden + SysFile, SR);
Exists := (DosError = 0) and (Pos('?', FileName) = 0) and
(Pos('*', FileName) = 0);
end; { Exists }
begin
HeapError := @HeapFunc;
end.


194
Borland Turbo Pascal v5/MCVARS.PAS Normal file
View File

@ -0,0 +1,194 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit MCVARS;
interface
uses Crt;
{$IFOPT N+}
type
Real = Extended;
const
EXPLIMIT = 11356;
SQRLIMIT = 1E2466;
MAXPLACES = 8;
MAXEXPLEN = 4;
{$ELSE}
const
EXPLIMIT = 88;
SQRLIMIT = 1E18;
MAXPLACES = 4;
MAXEXPLEN = 3;
{$ENDIF}
const
MSGHEADER = 'MICROCALC - A Turbo Pascal Demonstration Program';
MSGKEYPRESS = 'Press any key to continue.';
MSGCOMMAND = 'Press / for the list of commands';
MSGMEMORY = 'Memory Available:';
MSGLOMEM = 'Not enough memory to allocate cell.';
MSGERRORTXT = 'ERROR';
MSGEMPTY = 'Empty';
MSGTEXT = 'Text';
MSGVALUE = 'Value';
MSGFORMULA = 'Formula';
MSGAUTOCALC = 'AutoCalc';
MSGFORMDISPLAY = 'Form';
MSGFILENAME = 'Enter the file name of the spreadsheet:';
MSGNAME = 'Turbo Pascal MicroCalc Spreadsheet';
MSGCOLWIDTH = 'Enter the new column width:';
MSGNOOPEN = 'Can''t open the file.';
MSGOVERWRITE = 'The file exists. Do you want to overwrite it?';
MSGFILELOMEM = 'Not enough memory for entire spreadsheet.';
MSGNOMICROCALC = 'That is not a Turbo Pascal MicroCalc spreadsheet.';
MSGBADREALS = 'The reals in the file are in a different format.';
MSGNOEXIST = 'The file does not exist.';
MSGGOTO = 'Enter the cell to go to:';
MSGBADNUMBER = 'You must enter a number from';
MSGBADCELL = 'That is not a legal cell.';
MSGCELL1 = 'Enter the first cell to format:';
MSGCELL2 = 'Enter the last cell to format:';
MSGDIFFCOLROW = 'The row or the column must be the same.';
MSGRIGHTJUST = 'Do you want the cell right-justified?';
MSGDOLLAR = 'Do you want numbers in a dollar format?';
MSGCOMMAS = 'Do you want commas in numbers?';
MSGPLACES = 'How many decimal places should the number be rounded to?';
MSGCOLUMNS = 'Do you want to print in 132 columns?';
MSGPRINT = 'Enter the file name to print to, or press ENTER to print on the printer.';
MSGBORDER = 'Print the border?';
MSGLOADING = 'Loading...';
MSGSAVING = 'Saving...';
MSGSAVESHEET = 'Save current spreadsheet?';
MSGSTACKERROR = 'Parser stack overflow.';
MNU = 'Spreadsheet, Format, Delete, Goto, Col, Row, Edit, Utility, Auto, Quit';
COMMAND = 'SFDGCREUAQ';
SMNU = 'Load, Save, Print, Clear';
SCOMMAND = 'LSPC';
CMNU = 'Insert, Delete, Width';
CCOMMAND = 'IDW';
RMNU = 'Insert, Delete';
RCOMMAND = 'ID';
UMNU = 'Recalc, Formula display, Toggle 43-line mode';
UCOMMAND = 'RFT';
MAXCOLS = 100; { Maximum is 702 }
MAXROWS = 100;
LEFTMARGIN = 3;
MINCOLWIDTH = 3;
MAXCOLWIDTH = 77;
SCREENCOLS = 26;
DEFAULTWIDTH = 10;
DEFAULTFORMAT = $42;
MAXINPUT = 79;
TOPMARGIN = 5;
PARSERSTACKSIZE = 20;
TXTCOLOR = White;
ERRORCOLOR = 140; { LightRed + Blink }
VALUECOLOR = LightCyan;
FORMULACOLOR = LightMagenta;
BLANKCOLOR = Black;
HEADERCOLOR = 79; { White on Red }
HIGHLIGHTCOLOR = 31; { White on Blue }
HIGHLIGHTERRORCOLOR = 159; { White + Blink on Blue }
MSGAUTOCALCCOLOR = LightCyan;
MSGFORMDISPLAYCOLOR = LightMagenta;
MSGMEMORYCOLOR = LightGreen;
MSGHEADERCOLOR = LightCyan;
PROMPTCOLOR = Yellow;
COMMANDCOLOR = LightCyan;
LOWCOMMANDCOLOR = White;
MEMORYCOLOR = LightRed;
CELLTYPECOLOR = LightGreen;
CELLCONTENTSCOLOR = Yellow;
HIGHLIGHT = True;
NOHIGHLIGHT = False;
UPDATE = True;
NOUPDATE = False;
DOFORMAT = True;
NOFORMAT = False;
LEFT = 0;
RIGHT = 1;
UP = 2;
DOWN = 3;
TXT = 0;
VALUE = 1;
FORMULA = 2;
COLADD = 0;
COLDEL = 1;
ROWADD = 2;
ROWDEL = 3;
OVERWRITE = $80;
RJUSTIFY = $40;
COMMAS = $20;
DOLLAR = $10;
LETTERS : set of Char = ['A'..'Z', 'a'..'z'];
NULL = #0;
BS = #8;
FORMFEED = #12;
CR = #13;
ESC = #27;
HOMEKEY = #199;
ENDKEY = #207;
UPKEY = #200;
DOWNKEY = #208;
PGUPKEY = #201;
PGDNKEY = #209;
LEFTKEY = #203;
INSKEY = #210;
RIGHTKEY = #205;
DELKEY = #211;
CTRLLEFTKEY = #243;
CTRLRIGHTKEY = #244;
F1 = #187;
F2 = #188;
F3 = #189;
F4 = #190;
F5 = #191;
F6 = #192;
F7 = #193;
F8 = #194;
F9 = #195;
F10 = #196;
type
IString = String[MAXINPUT];
CellRec = record
Error : Boolean;
case Attrib : Byte of
TXT : (T : IString);
VALUE : (Value : Real);
FORMULA : (Fvalue : Real;
Formula : IString);
end;
CellPtr = ^CellRec;
var
Cell : array [1..MAXCOLS, 1..MAXROWS] of CellPtr;
CurCell : CellPtr;
Format : array [1..MAXCOLS, 1..MAXROWS] of Byte;
ColWidth : array [1..MAXCOLS] of Byte;
ColStart : array [1..SCREENCOLS] of Byte;
LeftCol, RightCol, TopRow, BottomRow, CurCol, CurRow, LastCol,
LastRow : Word;
Changed, FormDisplay, AutoCalc, Stop, ColorCard : Boolean;
ColorTable : array [0..255] of Byte;
ScreenRows : Byte;
OldMode : Word;
UMenuString : String[80];
UCommandString : String[3];
implementation
end.


52
Borland Turbo Pascal v5/OVRDEMO.PAS Normal file
View File

@ -0,0 +1,52 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
{$F+,O+}
program OvrDemo;
(*
This is a simple example of how to use the new overlay system. For
more complete documentation, refer to the overlay chapter in the
Turbo Pascal manual. Here's a quick checklist:
1. Turn "far calls" on {$F+} (to be safe, in all overlaid units and
the main program).
2. Turn "Overlays allowed" on {$O+}
3. Use Overlay unit in main program.
4. Issue separate {$O} directives for each overlaid unit.
5. Make sure to call OvrInit and pass the name of the .OVR file.
6. Test OvrResult after OvrInit calls (optional).
7. Compile to disk (cannot run in memory).
Here the overlay error returns for quick reference:
const
ovrOk = 0; { Success }
ovrError = -1; { Overlay manager error }
ovrNotFound = -2; { Overlay file not found }
ovrNoMemory = -3; { Not enough memory for overlay buffer }
ovrIOError = -4; { Overlay file I/O error }
ovrNoEMSDriver = -5; { EMS driver not installed }
ovrNoEMSMemory = -6; { Not enough EMS memory }
*)
uses
Overlay, Crt, OvrDemo1, OvrDemo2;
{$O OvrDemo1} { overlay 'em }
{$O OvrDemo2}
begin
TextAttr := White;
ClrScr;
OvrInit('OVRDEMO.OVR'); { init overlay system, reserve heap space }
if OvrResult <> 0 then
begin
Writeln('Overlay error: ', OvrResult);
Halt(1);
end;
repeat
Write1;
Write2;
until KeyPressed;
end.


20
Borland Turbo Pascal v5/OVRDEMO1.PAS Normal file
View File

@ -0,0 +1,20 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
{$O+,F+}
unit OvrDemo1;
{ This unit is used by OVRDEMO.PAS }
interface
procedure Write1;
implementation
procedure Write1;
begin
Writeln('One...');
end;
end.


20
Borland Turbo Pascal v5/OVRDEMO2.PAS Normal file
View File

@ -0,0 +1,20 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
{$O+,F+}
unit OvrDemo2;
{ This unit is used by OVRDEMO.PAS }
interface
procedure Write2;
implementation
procedure Write2;
begin
Writeln('Two...');
end;
end.


BIN
Borland Turbo Pascal v5/PC3270.BGI Normal file
View File

Binary file not shown.

43
Borland Turbo Pascal v5/PROCVAR.PAS Normal file
View File

@ -0,0 +1,43 @@
{ Copyright (c) 1988 by Borland International, Inc. }
{$F+}
program ProcVar;
{ For an extensive discussion of procedural types, variables and
parameters, refer to Chapter 8 in the Turbo Pascal 5.0 Reference
Guide (or Chapter 7 in the Turbo Pascal 5.0 Update manual).
}
type
IntFuncType = function (x, y : integer) : integer; { No func. identifier }
var
IntFuncVar : IntFuncType;
procedure DoSomething(Func : IntFuncType; x, y : integer);
begin
Writeln(Func(x, y):5); { call the function parameter }
end;
function AddEm(x, y : integer) : integer;
begin
AddEm := x + y;
end;
function SubEm(x, y : integer) : integer;
begin
SubEm := x - y;
end;
begin
{ Directly: }
DoSomething(AddEm, 1, 2);
DoSomething(SubEm, 1, 2);
{ Indirectly: }
IntFuncVar := AddEm; { an assignment, not a call }
DoSomething(IntFuncVar, 3, 4); { a call }
IntFuncVar := SubEm; { an assignment, not a call }
DoSomething(IntFuncVar, 3, 4); { a call }
end.


66
Borland Turbo Pascal v5/QSORT.PAS Normal file
View File

@ -0,0 +1,66 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
program qsort;
{$R-,S-}
uses Crt;
{ This program demonstrates the quicksort algorithm, which }
{ provides an extremely efficient method of sorting arrays in }
{ memory. The program generates a list of 1000 random numbers }
{ between 0 and 29999, and then sorts them using the QUICKSORT }
{ procedure. Finally, the sorted list is output on the screen. }
{ Note that stack and range checks are turned off (through the }
{ compiler directive above) to optimize execution speed. }
const
max = 1000;
type
list = array[1..max] of integer;
var
data: list;
i: integer;
{ QUICKSORT sorts elements in the array A with indices between }
{ LO and HI (both inclusive). Note that the QUICKSORT proce- }
{ dure provides only an "interface" to the program. The actual }
{ processing takes place in the SORT procedure, which executes }
{ itself recursively. }
procedure quicksort(var a: list; Lo,Hi: integer);
procedure sort(l,r: integer);
var
i,j,x,y: integer;
begin
i:=l; j:=r; x:=a[(l+r) DIV 2];
repeat
while a[i]<x do i:=i+1;
while x<a[j] do j:=j-1;
if i<=j then
begin
y:=a[i]; a[i]:=a[j]; a[j]:=y;
i:=i+1; j:=j-1;
end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;
begin {quicksort};
sort(Lo,Hi);
end;
begin {qsort}
Write('Now generating 1000 random numbers...');
Randomize;
for i:=1 to max do data[i]:=Random(30000);
Writeln;
Write('Now sorting random numbers...');
quicksort(data,1,max);
Writeln;
for i:=1 to 1000 do Write(data[i]:8);
end.


503
Borland Turbo Pascal v5/README Normal file
View File

@ -0,0 +1,503 @@
WELCOME TO TURBO PASCAL 5.0
---------------------------
This README file contains important, last minute information
about Turbo Pascal 5.0. The HELPME!.DOC file also answers many
common Technical Support questions.
TABLE OF CONTENTS
-----------------
1. Installation
2. New Utilities
2.1 THELP gives you Turbo Pascal help from ANY program
2.2 TINSTXFR transfers your 4.0 customizations to 5.0
3. Important Additions
4. Notes and Restrictions
5. Turbo Pascal 5.0 and the Toolboxes
6. Listing of Files on the Disks
1. INSTALLATION
---------------
A new program, INSTALL.EXE, sets up Turbo Pascal on your system.
INSTALL works on both floppy-based and hard disk systems. To use
INSTALL on Drive A, for example, place the disk labeled
INSTALL/COMPILER in Drive A and type
A:INSTALL
If you are using a hard disk, INSTALL will copy all Turbo Pascal
files onto your hard disk and put them into subdirectories. The
default subdirectories are:
Turbo Pascal Directory: C:\TP
Graphics Subdirectory: C:\TP
Documentation Subdirectory: C:\TP\DOC
Example Subdirectory: C:\TP
Turbo Pascal 3.0 Compatibility Subdirectory: C:\TP\TURBO3
By default, separate subdirectories are created for the
documentation files (*.DOC and HELPME!.DOC), and the Turbo3
compatibility files (UPGRADE, TURBO3.TPU, GRAPH3.TPU, TURBO3.DOC,
etc.). All other files from the distribution disks are placed in
the Turbo Pascal Directory. If you would rather separate graphics
and example programs into their own subdirectories as well, edit
the default paths for those files before selecting START
INSTALLATION.
The BGI/DEMOS/DOC/TURBO3 disk contains several files with an .ARC
file extension: BGI.ARC, DEMOS.ARC, DOC.ARC, MCALC.ARC, and
TURBO3.ARC. These files actually contain several other files that
have been compressed and placed inside an archive. You can
dearchive them yourself by using the UNPACK.COM utility.
For example:
unpack demos
unpacks all the files stored in the DEMOS.ARC archive into the
current directory.
INSTALL gives you a choice of copying the .ARC files intact, or
dearchiving and copying all of the individual files onto your
hard disk during the installation process. Note that INSTALL does
not unpack the BGIEXAMP.ARC file stored in BGI.ARC. BGIEXAMP.ARC
contains all of the BGI examples from the reference chapter in
the manual. If you want to unpack the examples from this file, go
to the directory that contains both UNPACK.COM and BGIEXAMP.ARC
and type:
unpack bgiexamp
This will unpack all 69 examples from BGIEXAMP.ARC.
Special Notes
-------------
o If you use INSTALL's Upgrade option, 5.0 files will overwrite
any version 4.0 files that have the same names. If you have
INSTALL copy 5.0 files into your 4.0 subdirectory, some 4.0
files may still be left on disk and will not be overwritten.
In this case, you should delete any obsolete 4.0 files after
running INSTALL. This is especially important if you have
INSTALL build separate subdirectories for 5.0 file groups
(DOC, BGI, TURBO3, etc.).
Note that INSTALL's Upgrade option will run TINSTXFR.EXE for
you.
o If you install the graphics files into a separate
subdirectory (C:\TP\BGI, for example), remember to specify
the full path to the driver and font files when calling
InitGraph
InitGraph(Driver, Mode, 'C:\TP\BGI');
If GRAPH.TPU is not in the current directory, you'll need to
add its location to the Unit Directories in order to compile
a BGI program.
o If you have difficulty reading the text displayed by the
INSTALL or TINST programs, they will both accept an optional
command-line parameter that forces them to use black and
white colors:
a:install /B - Forces INSTALL into BW80 mode
a:tinst /B - Forces TINST into BW80 mode
Specifying the /B parameter may be necessary if you are using
an LCD screen or a system that has a color graphics adapter
and a monochrome or composite monitor. See the comments on
LCD screens in section (4) below.
2. NEW UTILITIES
----------------
2.1 THELP
----------
THELP is a memory-resident utility program that gives you
access to Turbo Pascal's context-sensitive help system from any
program. You don't need to use THELP if you're in the
Integrated Development Environment, but it is especially useful
if you use the command-line compiler and your own text editor,
or if you are debugging with the standalone Turbo Debugger. To
use THELP, load THELP.COM into memory by typing at the DOS
command line
thelp
You activate ("pop-up") THELP by typing its hot key -- by
default numeric keypad <5>. All Turbo Pascal help commands
apply (F1, Ctrl-F1, Alt-F1). For a complete description of
THELP, refer to THELP.DOC in the Documentation Subdirectory.
2.2 TINSTXFR
-------------
The TINSTXFR (Tinst Transfer) utility copies installation data
from Turbo Pascal 4.0 to 5.0. TINSTXFR is especially useful if
you used TINST to customize your 4.0 colors or editor commands
and you do not wish to reinstall them in 5.0. TINSTXFR takes
two parameters
tinstxfr \tp4\turbo \tp\turbo
The first is the path to your version 4.0 TURBO.EXE. The second
is the path to your version 5.0 TURBO.EXE.
Note that it is not necessary to use TINSTXFR; it is provided
as a convenience for programmers upgrading from 4.0 to 5.0. In
fact, if you use the INSTALL program's UPGRADE option, it will
run TINSTXFR for you.
3. IMPORTANT ADDITIONS
----------------------
The following features were added after the manual went to print:
o {$A} COMPILER DIRECTIVE. A new compiler directive, {$A}, has
been added that switches between byte and word alignment of
variables and typed constants. Word alignment, {$A+}, is the
default. When you choose word alignment, all variables and
typed constants larger than 1 byte are aligned on a
machine-word boundary (an even numbered address). If required,
unused bytes are inserted between variables to achieve word
alignment. When you choose byte alignment, no alignment
measures are taken, and variables and typed constants are
placed at the next available address, regardless of their size.
This compiler directive is equivalent to the
Options/Compiler/Align Data menu command (in the Integrated
Environment) and the /$A command-line parameter (for use with
TPC.EXE). Note that if you are recompiling programs using the
Editor Toolbox, make sure to compile all programs that use the
toolbox with {$A-}.
o /P PARAMETER FOR TURBO.EXE. A new command-line switch controls
palette swapping on EGA video adapters. Using this switch
turbo /p myprog
is only recommended when the user program modifies the EGA
palette registers. When /P is specified, the EGA palette is
restored each time the screen is swapped. In general, you don't
need to use this switch unless your program modifies the EGA
palette registers, or unless your program uses BGI to change
the palette.
o NEW LIBRARY ROUTINES. The following table lists functions and
procedures that have been modified or added to Turbo Pascal's
run-time library. Refer to the reference section of your manual
for more information:
Name Unit
---- ----
DosVersion function Dos
EnvCount function Dos
EnvStr function Dos
FExpand function Dos
FillEllipse procedure Graph
FSearch function Dos
FSplit procedure Dos
GetCBreak procedure Dos
GetDefaultPalette function Graph
GetDriverName function Graph
GetEnv function Dos
GetMaxMode function Graph
GetModeName function Graph
GetPaletteSize function Graph
GetVerify procedure Dos
InstallUserDriver function Graph
InstallUserFont function Graph
OvrClearBuf procedure Overlay
OvrGetBuf function Overlay
OvrInit procedure Overlay
OvrInitEMS procedure Overlay
OvrSetBuf procedure Overlay
RunError procedure System
Sector procedure Graph
SetAspectRatio procedure Graph
SetCBreak procedure Dos
SetRGBPalette procedure Graph
SetUserCharSize procedure Graph (modified)
SetVerify procedure Dos
SetWriteMode procedure Graph
SwapVectors procedure Dos
o NEW COMPILER ERROR MESSAGES. The following compiler error
messages are no longer reported or have been replaced by new
error messages: 108, 109, 110, 111, 115, 119, and 125. The
following new compiler error messages have been added:
133 Cannot evaluate this expression
134 Expression incorrectly terminated
135 Invalid format specifier
136 Invalid indirect reference
137 Structured variables are not allowed here
138 Cannot evaluate without System unit
139 Cannot access this symbol
140 Invalid floating-point operation
141 Cannot compile overlays to memory
142 Procedure or function variable expected
143 Invalid procedure or function reference
144 Cannot overlay this unit
145 Too many nested scopes (not in manual)
For detailed descriptions, please refer to the reference
section of the manual. Compiler error message 145 is a late
addition and is not in the manual.
145 Too many nested scopes
Your program has too many nested scopes. Each project can
have no more than 512 nested scopes with no more than 128
nested scopes in each module. Each unit in a uses clause,
each nested record type declaration, and each nested "with"
context count toward the total number of nested scopes.
o NEW RUN-TIME ERROR MESSAGES. The following new run-time error
messages have been added:
208 Overlay manager not installed
209 Overlay file read error
For detailed descriptions, please refer to the reference
section of the manual.
o STRING OPTIMIZATION. Two optimizations to string code
generation were made. When assigning or testing for a null
string value, optimal code is now generated for the following:
(1) StringVar := '';
(2) if StringVar = '' then...
Note that some 4.0 programmers used tricks to have the compiler
generate optimized code in place of the above:
(1) StringVar[0] := #0;
Length(StringVar) := 0;
(2) if Length(StringVar) = 0 then ...
These tricks are now unnecessary. (In fact, a function call on
the left-hand side of an assignment now--correctly--generates a
syntax error.)
4. NOTES AND RESTRICTIONS
-------------------------
o REBUILD 4.0 TPUs. The TPUs from all 4.0 programs must be
rebuilt in order to use them with Turbo Pascal 5.0. You'll need
all the source code in order to rebuild a program. If you are
using the Integrated Development Environment, load the main
program and select the Compile/Build menu command. If you are
using the command-line compiler, type:
tpc /b ProgramName
Appendix A in the manual discusses 3.0 and 4.0 compatibility
issues.
o LCD SCREENS. If you are using a laptop computer and have
difficulty reading the text displayed by the Integrated
Environment, use TINST and change MODE FOR DISPLAY to LCD OR
COMPOSITE. This will force the Integrated Environment to use
black and white colors. The same advice applies if your system
has a color graphics adapter and a monochrome or composite
monitor. In all cases, you can use TINST to customize the
colors for your system.
o DEBUGGING INT 9 HANDLERS. A program that takes over interrupt
9 cannot be debugged in the Integrated Environment (use the
standalone Turbo Debugger instead).
o EMS 3.2 SUPPORT. If your system has EMS and you want Turbo
Pascal to take advantage of it, both the Integrated Environment
and the overlay manager require EMS 3.2 or later.
o BGI & ZENITH Z-449. When using the BGI on a Zenith Z-449 card,
the 640x480 enhanced EGA mode will always be selected by the
autodetection code. If you are using the Z-449 with a monitor
that is not compatible with this mode, select a different mode
in the InitGraph call.
o CAN'T FIND RUN-TIME ERRORS. Turning Debug/Integrated Debugging
OFF also disables finding run-time errors in the Integrated
Environment.
o USER SCREEN. The Integrated Development Environment no longer
displays the message "Press any key to return to Turbo
Pascal..." when your program terminates. Instead, at the end of
your program, the User Screen is replaced by the Integrated
Development Environment. To view the User Screen, press Alt-
F5 or select the Run/User Screen menu command. Then, you can
press any key to return to the Integrated Development
Environment.
Note that you can toggle between the Output and Watch windows
by switching to the "lower" window and pressing Alt-F6.
o EXEC WITH NOVELL NETWORK. Versions of the Novell network system
software earlier than 2.01-2 do not support a DOS call used by
the Exec procedure (from the Dos unit). If you are using the
Integrated Development Environment to run a program that does
an Exec, and you have early Novell system software, set
Compile\Destination to Disk and run your program from DOS (you
can use File\OS Shell).
5. TURBO PASCAL 5.0 AND THE TOOLBOXES
-------------------------------------
The source code from the Turbo Pascal Tutor and all the Turbo
Pascal toolboxes is fully compatible with 5.0. Version 5.0
changes some compiler directives, however, and these should be
modified in the source code before recompiling the following
toolboxes:
o Database Toolbox files:
TAINST.PAS and TABUILD.PAS
Add {$A-} to the top of the file.
o Editor Toolbox files:
EDDIRECT.INC & MSDIRECT.INC
Add {$A-} to the top of the file.
Delete {$T+} from the file.
Add {$L+} after the line that contains {$D+}.
EDINST.PAS, MSINST.PAS, & INSTALL.PAS
Add {$A-} before the line {$V-}.
BINED.PAS
Add {$A-} before the line {$I-}.
The TPUs from all toolboxes must be rebuilt in order to use them
with Turbo Pascal 5.0.
6. LISTING OF FILES ON THE DISKS
--------------------------------
INSTALL/COMPILER
----------------
INSTALL EXE - Installs Turbo Pascal on your system
README COM - Program to display README file
TURBO EXE - Turbo Pascal Integrated Development Environment
TURBO TPL - Resident units for Turbo Pascal
TPC EXE - Command-line version of Turbo Pascal
THELP COM - Memory-resident help utility
README - This file!
HELP/UTILITIES
--------------
TURBO HLP - Turbo Pascal Help File
TINST EXE - Customization program for TURBO.EXE
TPUMOVER EXE - Unit mover utility
MAKE EXE - Utility for managing projects
GREP COM - Utility to search text files for strings
TOUCH COM - Utility to change the dates and times of files
BINOBJ EXE - Utility to convert a binary file to an .OBJ
TPCONFIG EXE - .TP to .CFG conversion utility
TINSTXFR EXE - Utility to transfer 4.0 options to 5.0
BGI/DEMOS/DOC/TURBO3
--------------------
UNPACK COM - Utility to unpack .ARC files
BGI ARC - Packed file that contains graphics documentation,
drivers, fonts, and examples
GRAPH DOC - Interface section listing for the Graph unit
GRAPH TPU - Borland Graphics Interface (BGI) Graph unit
ATT BGI - Graphics device driver for AT&T 6300
CGA BGI - Graphics device driver for CGA and MCGA
EGAVGA BGI - Graphics device driver for EGA and VGA
HERC BGI - Graphics device driver for Hercules mono
PC3270 BGI - Graphics device driver for 3270 PC
IBM8514 BGI - Graphics device driver for IBM 8514
GOTH CHR - Gothic font character set
LITT CHR - Small font character set
SANS CHR - Sans serif font character set
TRIP CHR - Triplex font character set
BGIDEMO PAS - Graph unit demo
ARTY PAS - Graph unit demo
BGILINK PAS - Graph unit demo that shows how to link font and
driver files into an .EXE file
DRIVERS PAS - Example unit for use with BGILINK.PAS
FONTS PAS - Example unit for use with BGILINK.PAS
BGILINK MAK - Make file for use with BGILINK.PAS
BGIEXAMP ARC - Packed file that contains all of the graphics
examples listed in the manual's reference chapter.
DEMOS ARC - Packed file that contains example programs
EXECDEMO PAS - Executes a child program (DOS unit)
DIRDEMO PAS - Displays directory, uses procedural types
CRTDEMO PAS - Crt unit demo
OVRDEMO PAS - Overlay unit demo
OVRDEMO1 PAS - Example unit for OVRDEMO.PAS
OVRDEMO2 PAS - Example unit for OVRDEMO.PAS
CIRCULAR PAS - Demos the USES clause in implementation section
DISPLAY PAS - Example unit for CIRCULAR.PAS
ERROR PAS - Example unit for CIRCULAR.PAS
QSORT PAS - QuickSort example
LISTER PAS - Printer unit demo
HILB PAS - Floating-point demo
FIB8087 PAS - Recursive example that uses the 8087 math
coprocessor and avoids 8087 stack overflow
PROCVAR PAS - Simple procedural types demo
EMS PAS - Example program that shows how to use expanded
memory from your programs
CPASDEMO PAS - Example program that shows how to link TURBO C .OBJ
files into Turbo Pascal programs
CPASDEMO C - C program for use with CPASDEMO.PAS
CTOPAS TC - Turbo C configuration file to use with TC.EXE
for producing .OBJ files that can be linked with
Turbo Pascal (see CPASDEMO.PAS)
TURBOC CFG - Turbo C configuration file to use with TCC.EXE for
producing .OBJ files that can be linked with Turbo
Pascal (see CPASDEMO.PAS)
DOC ARC - Interface section listings for system units
THELP DOC - Documentation for memory-resident help utility
SYSTEM DOC - Interface section listing for the System unit
DOS DOC - Interface section listing for the Dos unit
CRT DOC - Interface section listing for the Crt unit
PRINTER DOC - Interface section listing for the Printer unit
OVERLAY DOC - Interface section listing for the Overlay unit
MCALC ARC - Packed file with complete source code to
MicroCalc example program
TURBO3 ARC - Turbo 3.0 compatibility files
UPGRADE EXE - Program that converts 3.0 programs to 5.0
UPGRADE DTA - Data file for UPGRADE.EXE
TURBO3 TPU - TURBO3 compatibility unit
GRAPH3 TPU - GRAPH3 compatibility unit (turtle graphics)
TURBO3 DOC - Interface section listing for the Turbo3 unit
GRAPH3 DOC - Interface section listing for the Graph3 unit
BCD PAS - Unit to convert Turbo Pascal 3.0 BCD reals to
Turbo Pascal 5.0 floating point numbers
HELPME! DOC - Text file with the answers to many common
questions. Please read HELPME!.DOC before
contacting Technical Support.


BIN
Borland Turbo Pascal v5/README.COM Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/SANS.CHR Normal file
View File

Binary file not shown.

31
Borland Turbo Pascal v5/SIEVE.PAS Normal file
View File

@ -0,0 +1,31 @@
program sieve;
const
size = 8190;
type
flagType = array[ 0..size ] of boolean;
var
i, k, prime, count, iter : integer;
flags : flagType;
begin
for iter := 1 to 10 do begin
count := 0;
for i := 0 to size do flags[ i ] := true;
for i := 0 to size do begin
if flags[ i ] then begin
prime := i + i + 3;
k := i + prime;
while k <= size do begin
flags[ k ] := false;
k := k + prime;
end;
count := count + 1;
end;
end;
end;
writeln( 'count of primes: ', count );
end.

BIN
Borland Turbo Pascal v5/THELP.COM Normal file
View File

Binary file not shown.

66
Borland Turbo Pascal v5/TIMEUTIL.PAS Normal file
View File

@ -0,0 +1,66 @@
type
timetype = record h, m, s, l : integer; end;
procedure time_difference( var tStart, tEnd, tDiff : timetype );
var
startSecond, startMinute, startHour : integer;
begin { time_difference }
startSecond := tStart.s;
startMinute := tStart.m;
startHour := tStart.h;
tDiff.l := tEnd.l - tStart.l;
if ( tDiff.l < 0 ) then
begin
tDiff.l := tDiff.l + 100;
startSecond := startSecond + 1;
end;
tDiff.s := tEnd.s - startSecond;
if ( tDiff.s < 0 ) then
begin
tDiff.s := tDiff.s + 60;
startMinute := startMinute + 1;
end;
tDiff.m := tEnd.m - startMinute;
if ( tDiff.m < 0 ) then
begin
tDiff.m := tDiff.m + 60;
startHour := startHour + 1;
end;
tDiff.h := tEnd.h - startHour;
if ( tDiff.h < 0 ) then
tDiff.h := tDiff.h + 12;
end;
procedure print_time_part( num : integer );
begin
if ( num < 10 ) then write( '0' );
write( num );
end;
procedure print_time( var t: timetype );
begin
print_time_part( t.h );
write( ':' );
print_time_part( t.m );
write( ':' );
print_time_part( t.s );
write( '.' );
print_time_part( t.l );
end;
procedure print_elapsed_time( var timeStart, timeEnd: timetype );
var
timeDiff: timetype;
begin
time_difference( timeStart, timeEnd, timeDiff );
write( 'elapsed time: ' );
print_time( timeDiff );
writeln;
end;


BIN
Borland Turbo Pascal v5/TINST.EXE Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/TINSTXFR.EXE Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/TOUCH.COM Normal file
View File

Binary file not shown.

1
Borland Turbo Pascal v5/TPC.CFG Normal file
View File

@ -0,0 +1 @@
/UC:\NTVDM\TP_50;C:\NTVDM\TP_50\TURBO3

BIN
Borland Turbo Pascal v5/TPC.EXE Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/TPCONFIG.EXE Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/TPUMOVER.EXE Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/TRIP.CHR Normal file
View File

Binary file not shown.

315
Borland Turbo Pascal v5/TTT.PAS Normal file
View File

@ -0,0 +1,315 @@
{ App to prove you can't win at Tic-Tac-Toe }
{ use of byte instead of integer should be faster, but it's not }
program ttt;
uses Dos;
{$I timeutil.pas}
{$I dos_gt.pas}
type TScoreFunc = function : integer;
const
scoreWin = 6;
scoreTie = 5;
scoreLose = 4;
scoreMax = 9;
scoreMin = 2;
scoreInvalid = 0;
pieceBlank = 0;
pieceX = 1;
pieceO = 2;
iterations = 100;
type
boardType = array[ 0..8 ] of integer;
funcArrayType = array[ 0..8 ] of pointer;
var
evaluated: longint;
board: boardType;
timeStart, timeEnd: timetype;
scoreFuncs : funcArrayType;
procedure dumpBoard;
var
i : integer;
begin
Write( '{' );
for i := 0 to 8 do
Write( board[i] );
Write( '}' );
end;
function func0 : integer;
var x : integer;
begin
x := board[0];
if ( ( ( x = board[1] ) and ( x = board[2] ) ) or
( ( x = board[3] ) and ( x = board[6] ) ) or
( ( x = board[4] ) and ( x = board[8] ) ) ) then
func0 := x
else
func0 := pieceBlank;
end;
function func1 : integer;
var x : integer;
begin
x := board[1];
if ( ( ( x = board[0] ) and ( x = board[2] ) ) or
( ( x = board[4] ) and ( x = board[7] ) ) ) then
func1 := x
else
func1 := pieceBlank;
end;
function func2 : integer;
var x : integer;
begin
x := board[2];
if ( ( ( x = board[0] ) and ( x = board[1] ) ) or
( ( x = board[5] ) and ( x = board[8] ) ) or
( ( x = board[4] ) and ( x = board[6] ) ) ) then
func2 := x
else
func2 := pieceBlank;
end;
function func3 : integer;
var x : integer;
begin
x := board[3];
if ( ( ( x = board[4] ) and ( x = board[5] ) ) or
( ( x = board[0] ) and ( x = board[6] ) ) ) then
func3 := x
else
func3 := pieceBlank;
end;
function func4 : integer;
var x : integer;
begin
x := board[4];
if ( ( ( x = board[0] ) and ( x = board[8] ) ) or
( ( x = board[2] ) and ( x = board[6] ) ) or
( ( x = board[1] ) and ( x = board[7] ) ) or
( ( x = board[3] ) and ( x = board[5] ) ) ) then
func4 := x
else
func4 := pieceBlank;
end;
function func5 : integer;
var x : integer;
begin
x := board[5];
if ( ( ( x = board[3] ) and ( x = board[4] ) ) or
( ( x = board[2] ) and ( x = board[8] ) ) ) then
func5 := x
else
func5 := pieceBlank;
end;
function func6 : integer;
var x : integer;
begin
x := board[6];
if ( ( ( x = board[7] ) and ( x = board[8] ) ) or
( ( x = board[0] ) and ( x = board[3] ) ) or
( ( x = board[4] ) and ( x = board[2] ) ) ) then
func6 := x
else
func6 := pieceBlank;
end;
function func7 : integer;
var x : integer;
begin
x := board[7];
if ( ( ( x = board[6] ) and ( x = board[8] ) ) or
( ( x = board[1] ) and ( x = board[4] ) ) ) then
func7 := x
else
func7 := pieceBlank;
end;
function func8 : integer;
var x : integer;
begin
x := board[8];
if ( ( ( x = board[6] ) and ( x = board[7] ) ) or
( ( x = board[2] ) and ( x = board[5] ) ) or
( ( x = board[0] ) and ( x = board[4] ) ) ) then
func8 := x
else
func8 := pieceBlank;
end;
function lookForWinner : integer;
var
t, p : integer;
begin
{dumpBoard;}
p := pieceBlank;
t := board[ 0 ];
if pieceBlank <> t then
begin
if ( ( ( t = board[1] ) and ( t = board[2] ) ) or
( ( t = board[3] ) and ( t = board[6] ) ) ) then
p := t;
end;
if pieceBlank = p then
begin
t := board[1];
if ( t = board[4] ) and ( t = board[7] ) then
p := t
else
begin
t := board[2];
if ( t = board[5] ) and ( t = board[8] ) then
p := t
else
begin
t := board[3];
if ( t = board[4] ) and ( t = board[5] ) then
p := t
else
begin
t := board[6];
if ( t = board[7] ) and ( t = board[8] ) then
p := t
else
begin
t := board[4];
if ( ( ( t = board[0] ) and ( t = board[8] ) ) or
( ( t = board[2] ) and ( t = board[6] ) ) ) then
p := t
end;
end;
end;
end;
end;
lookForWinner := p;
end;
function minmax( alpha: integer; beta: integer; depth: integer; move : integer ): integer;
var
p, value, pieceMove, score : integer;
begin
evaluated := evaluated + 1;
value := scoreInvalid;
if depth >= 4 then
begin
p := TScoreFunc( scoreFuncs[ move ] );
{ p := LookForWinner; this is 10% slower than using function pointers }
if p <> pieceBlank then
begin
if p = pieceX then
value := scoreWin
else
value := scoreLose
end
else if depth = 8 then
value := scoreTie;
end;
if value = scoreInvalid then
begin
if Odd( depth ) then
begin
value := scoreMin;
pieceMove := pieceX;
end
else
begin
value := scoreMax;
pieceMove := pieceO;
end;
p := 0;
repeat
if board[ p ] = pieceBlank then
begin
board[ p ] := pieceMove;
score := minmax( alpha, beta, depth + 1, p );
board[ p ] := pieceBlank;
if Odd( depth ) then
begin
if ( score > value ) then
begin
value := score;
if ( value = scoreWin ) or ( value >= beta ) then p := 10
else if ( value > alpha ) then alpha := value;
end;
end
else
begin
if ( score < value ) then
begin
value := score;
if ( value = scoreLose ) or ( value <= alpha ) then p := 10
else if ( value < beta ) then beta := value;
end;
end;
end;
p := p + 1;
until p > 8;
end;
minmax := value;
end;
procedure runit( move : integer );
var score : integer;
begin
board[move] := pieceX;
score := minmax( scoreMin, scoreMax, 0, move );
board[move] := pieceBlank;
end;
var
i, errpos, loops: integer;
begin
loops := Iterations;
if 0 <> Length( ParamStr( 1 ) ) then
Val( ParamStr( 1 ), loops, errpos );
for i := 0 to 8 do
board[i] := pieceBlank;
scoreFuncs[0] := @func0;
scoreFuncs[1] := @func1;
scoreFuncs[2] := @func2;
scoreFuncs[3] := @func3;
scoreFuncs[4] := @func4;
scoreFuncs[5] := @func5;
scoreFuncs[6] := @func6;
scoreFuncs[7] := @func7;
scoreFuncs[8] := @func8;
evaluated := 0;
get_time( timeStart );
for i := 1 to loops do
begin
runit( 0 );
runit( 1 );
runit( 4 );
end;
get_time( timeEnd );
print_elapsed_time( timeStart, timeEnd );
WriteLn( 'moves evaluated: ', evaluated );
WriteLn( 'iterations: ', loops );
end.


BIN
Borland Turbo Pascal v5/TURBO.EXE Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/TURBO.HLP Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/TURBO.TPL Normal file
View File

Binary file not shown.

157
Borland Turbo Pascal v5/TURBO3/BCD.PAS Normal file
View File

@ -0,0 +1,157 @@
{ Copyright (c) 1985, 88 by Borland International, Inc. }
unit BCD;
{ The BCD version of Turbo Pascal 3.0 (TURBOBCD.COM) supports
10-byte binary coded decimal reals with 18 significant digits
and a range of 1E-63 to 1E+63. The BCD real data type is not
supported by Turbo Pascal 5.0, and this unit provides a routine
for converting 3.0 BCD reals to 6-byte reals (software reals)
or 10-byte 8087 extended reals.
Before you convert a Turbo Pascal 3.0 BCD program to run under
5.0, you need to select a 5.0 real data type for your floating
point values. If you do not have an 8087, or if your program is
to run on machines without an 8087, your only option is to use
the familiar 6-byte Real, which provides 11-12 significant digits
with a range of 2.9E-39 to 1.7E+38. This type is also supported by
the standard version of Turbo Pascal 3.0. If you are planning to
use the 8087, we suggest you select the 10-byte Extended type,
which provides 19-20 significant digits with a range of 1.9E-4951
to 1.1E+4932. Once you have selected a data type, you need to write
a conversion program that translates your old data files using the
conversion routine provided here.
The Decimal type defined by this unit corresponds to the 3.0 BCD
Real, and the DecToFloat routine converts a Decimal variable to a
6-byte Real or to a 10-byte Extended.
The BCD unit uses conditional compilation constructs to define a
type Float which is equivalent to either Real or Extended,
depending on the kind of numeric processing you select (software
or hardware). To compile a program that uses the BCD unit, first
select software or hardware floating point, using the Options/
Compiler/Numeric processing menu, and then do a Compile/Build,
which automatically recompiles BCD.PAS.
The following program shows how to convert a 3.0 data file that
contains records with BCD fields. The program defines an equivalent
of the 3.0 record (OldDataRec) using the Decimal type for fields
that contain BCD reals. In the corresponding 5.0 record (NewDataRec),
floating point fields are declared using the Float type, which is
either Real or Extended depending on the floating point model
selected. During the conversion, all Decimal fields are converted
to Float using the DecToFloat function, whereas all non-real fields
are copied directly.
program ConvertBCD;
uses BCD;
type
OldDataRec = record
Name: string[15];
InPrice,OutPrice: Decimal;
InStock,MinStock: Integer;
end;
NewDataRec = record
Name: string[15];
InPrice,OutPrice: Float;
InStock,MinStock: Integer;
end;
var
OldFile: file of OldDataRec;
NewFile: file of NewDataRec;
Old: OldDataRec;
New: NewDataRec;
begin
Assign(OldFile,'OLDFILE.DTA'); Reset(F);
Assign(NewFile,'NEWFILE.DTA'); Rewrite(F);
while not Eof(OldFile) do
begin
Read(OldFile,Old);
New.Name := Old.Name;
New.InPrice := DecToFloat(Old.InPrice);
New.OutPrice := DecToFloat(Old.OutPrice);
New.InStock := Old.InStock;
New.MinStock := Old.MinStock;
Write(NewFile,New);
end;
Close(OldFile);
Close(NewFile);
end.
The range of a BCD real is larger than that of a 6-byte software
real. Therefore, when converting to 6-byte reals, BCD values larger
than 1E+38 are converted to 1E+38, and BCD values less than 2.9E-39
are converted to zero.
}
interface
type
Decimal = array[0..9] of Byte;
{$IFOPT N-}
Float = Real;
{$ELSE}
Float = Extended;
{$ENDIF}
function DecToFloat(var D: Decimal): Float;
implementation
function DecToFloat(var D: Decimal): Float;
var
E,L,P: Integer;
V: Float;
function Power10(E: Integer): Float;
var
I: Integer;
P: Float;
begin
I:=0; P:=1.0;
repeat
if Odd(E) then
case I of
0: P:=P*1E1;
1: P:=P*1E2;
2: P:=P*1E4;
3: P:=P*1E8;
4: P:=P*1E16;
5: P:=P*1E32;
end;
E:=E shr 1; Inc(I);
until E=0;
Power10:=P;
end;
begin
{$IFOPT N-}
if D[0] and $7F>38+$3F then V:=10E37 else
{$ENDIF}
begin
V:=0.0; L:=1;
while (L<=9) and (D[L]=0) do Inc(L);
if L<=9 then
begin
for P:=9 downto L do
begin
V:=V*100.0+((D[P] shr 4)*10+D[P] and $0F);
end;
E:=D[0] and $7F-($3F+(10-L)*2);
if E>=0 then V:=V*Power10(E) else
begin
if E<-32 then
begin
V:=V/1E32; E:=E+32;
end;
V:=V/Power10(-E);
end;
end;
end;
if D[0] and $80=0 then DecToFloat:=V else DecToFloat:=-V;
end;
end.


65
Borland Turbo Pascal v5/TURBO3/GRAPH3.DOC Normal file
View File

@ -0,0 +1,65 @@
{*******************************************************}
{ }
{ Turbo Pascal Version 5.0 }
{ 3.0 Graphics Compatibility Unit }
{ }
{ Copyright (C) 1988 Borland International }
{ }
{*******************************************************}
unit Graph3;
{$D-,I-,S-}
interface
uses Crt;
const
North = 0;
East = 90;
South = 180;
West = 270;
procedure GraphMode;
procedure GraphColorMode;
procedure HiRes;
procedure HiResColor(Color: Integer);
procedure Palette(N: Integer);
procedure GraphBackground(Color: Integer);
procedure GraphWindow(X1,Y1,X2,Y2: Integer);
procedure Plot(X,Y,Color: Integer);
procedure Draw(X1,Y1,X2,Y2,Color: Integer);
procedure ColorTable(C1,C2,C3,C4: Integer);
procedure Arc(X,Y,Angle,Radius,Color: Integer);
procedure Circle(X,Y,Radius,Color: Integer);
procedure GetPic(var Buffer; X1,Y1,X2,Y2: Integer);
procedure PutPic(var Buffer; X,Y: Integer);
function GetDotColor(X,Y: Integer): Integer;
procedure FillScreen(Color: Integer);
procedure FillShape(X,Y,FillCol,BorderCol: Integer);
procedure FillPattern(X1,Y1,X2,Y2,Color: Integer);
procedure Pattern(var P);
procedure Back(Dist: Integer);
procedure ClearScreen;
procedure Forwd(Dist: Integer);
function Heading: Integer;
procedure HideTurtle;
procedure Home;
procedure NoWrap;
procedure PenDown;
procedure PenUp;
procedure SetHeading(Angle: Integer);
procedure SetPenColor(Color: Integer);
procedure SetPosition(X,Y: Integer);
procedure ShowTurtle;
procedure TurnLeft(Angle: Integer);
procedure TurnRight(Angle: Integer);
procedure TurtleDelay(Delay: integer);
procedure TurtleWindow(X,Y,W,H: Integer);
function TurtleThere: Boolean;
procedure Wrap;
function Xcor: Integer;
function Ycor: Integer;

BIN
Borland Turbo Pascal v5/TURBO3/GRAPH3.TPU Normal file
View File

Binary file not shown.

33
Borland Turbo Pascal v5/TURBO3/TURBO3.DOC Normal file
View File

@ -0,0 +1,33 @@
{*******************************************************}
{ }
{ Turbo Pascal Version 5.0 }
{ 3.0 Compatibility Unit }
{ }
{ Copyright (C) 1987,88 Borland International }
{ }
{*******************************************************}
unit Turbo3;
{$D-,I-,S-}
interface
uses Crt;
var
Kbd: Text;
CBreak: Boolean absolute CheckBreak;
procedure AssignKbd(var F: Text);
function MemAvail: Integer;
function MaxAvail: Integer;
function LongFileSize(var F): Real;
function LongFilePos(var F): Real;
procedure LongSeek(var F; Pos: Real);
procedure NormVideo;
procedure HighVideo;
procedure LowVideo;
function IOresult: Integer;

BIN
Borland Turbo Pascal v5/TURBO3/TURBO3.TPU Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/TURBO3/UPGRADE.DTA Normal file
View File

Binary file not shown.

BIN
Borland Turbo Pascal v5/TURBO3/UPGRADE.EXE Normal file
View File

Binary file not shown.

13
Borland Turbo Pascal v5/TURBOC.CFG Normal file
View File

@ -0,0 +1,13 @@
-c
-p
-r-
-u-
-zCCODE
-zP
-zA
-zRCONST
-zS
-zT
-zDDATA
-zG
-zB

68685
Borland Turbo Pascal v5/Turbo_Pascal_Version_5.0_Reference_Guide_1989.pdf Normal file
View File

File diff suppressed because one or more lines are too long

60732
Borland Turbo Pascal v5/Turbo_Pascal_Version_5.0_Users_Guide_1989.pdf Normal file
View File

File diff suppressed because one or more lines are too long

BIN
Borland Turbo Pascal v5/UNPACK.COM Normal file
View File

Binary file not shown.

3
Borland Turbo Pascal v5/m.bat Normal file
View File

@ -0,0 +1,3 @@
ntvdm -r:. -c tpc %1.pas /$S- /GD