Mike is a technical editor for DDJ and can be contacted at 501 Galveston Drive, Redwood City, CA 94063. On CompuServe 76703,4057, or on MCI Mail as MFLOYD.
If artificial intelligence was the buzzword for the mid-1980s, then its equivalent for the late 1980s (and early 1990s) must be object-oriented programming (OOP). But instead of the distant promises offered by AI, OOP represents a superior method for the design and construction of today's software.
Because OOP's approach encourages good programming practices that complement structured programming, combining Pascal and OOP seems a natural evolutionary step, one that Borland has taken with its most recent release of Turbo Pascal. In this article, I'll explore the major features that have been added to Turbo Pascal (TP) 5.5, including object-oriented extensions to the language and to the debugger. We'll also examine TP's overlay manager and take a look at the new capabilities of the Smart Linker. Finally, we'll provide a full-blown example that demonstrates most of TP 5.5's object-oriented features.
Turbo Pascal has added only four new keywords to the language set: object, virtual, constructor, and destructor. With these four keywords, you can declare objects statically within your program or create them dynamically at run time. These objects can inherit code and data from a parent (or ancestor) object type, and you can override any inherited method. Constructors and destructors provide automated initialization and cleanup of objects. In addition, constructors and destructors can be used in conjunction with the expanded New and Dispose procedures to allocate and deallocate heap storage for dynamic objects.
TP 5.5 supports the notion of virtual methods (as does C++). Virtual methods allow you to implement polymorphism. Both TP's Integrated Debugger and Turbo Debugger 1.5 provide object support. Additionally, as previously mentioned, enhancements have been made to TP's overlay manager and the Smart Linker and improvements have been made to speed up the compiler.
In Turbo Pascal, objects can be thought of as records that have the ability to inherit code and data from ancestor object types. The generalized form for an object definition is shown in Example 1. Defining an object is similar to defining a record. The object keyword replaces the record keyword, and object takes an optional argument -- the ancestor that this new object will inherit from.
type
ObjectName = object (Ancestor)
variable definitions;
method definitions; {virtual}
end;
Methods in TP are simply procedure and function headers placed directly in the object definition. The virtual keyword (which is optional) is used to define a virtual method. Methods not using the virtual keyword are static methods.
As an example, consider a windowing environment that contains a menu bar, pull-down menus and a text window that, in turn, contains other windows such as scroll bars and resize boxes. Window systems are a natural for an object-oriented programming approach.
First, let's create the basic window object type like that coded in Example 2. From this basic window, we can create an object hierarchy of more specialized windows like the MenuBar and PullDown object types shown in Example 3 .
type
Window = object
WindowNo: Integer;
X1, Y1, X2, Y2: Integer;
...
constructor Init (XA, YA, XB, YB: Integer);
destructor Done; virtual;
procedure Show; virtual;
procedure Hide; virtual;
...
end;
type
MenuList = string [80];
MenuBar = object (Window)
Menus: MenuList;
...
constructor Init (M: MenuList);
procedure Show; virtual;
procedure Hide; virtual;
procedure Highlight (Item: Integer);
procedure Select (Item: Integer);
...
end;
PullDown = object (Window)
...
end;
Notice that MenuBar inherits three virtual methods (Done, Show, and Hide) and then adds two static methods (Highlight and Select). Also notice that the constructors for each of these object types are different as well. Each method is like a forward declared procedure that must be defined in the same unit or program module. The syntax for defining a method is ObjectType.Method and is illustrated in Example 4.
...
procedure Window.Show;
begin
{ Draw the window }
end;
var
AWin : Window;
begin
AWin.Show;
...
end.
You invoke an object's method in the same manner that you would reference the fields of a record using the familiar dot syntax. Refer to Example 4 for an example of how to call the Window object's Show method.
TP objects are just like any other variable -- they can be declared statically in a VAR declaration or dynamically allocated on the heap and referenced via pointers.
I've left out a lot of the details in this example so that you can easily see the overall structure and calling sequence. I've also provided an example program that highlights the creation and use of objects in TP 5.5. FDEMO.PAS (see Listing One) implements a simple forms editor.
The fact that objects can be used across units is important, particularly as you begin developing your own libraries. Therefore, the example consists of two units and a main. FDEMO, as previously mentioned, contains the main program. FORMS.PAS (see Listing Two) is a unit that implements a Form object and its associated Fields, and SLIDERS.PAS (see Listing Three) adds a graphic counter feature.
Because of space considerations, I won't go into detail on the example. You should, however, find the forms demo instructive as you read through the next section.
There are two required features for any object-oriented programming language and TP 5.5 has both. The first, which you've already seen, is inheritance. The other is support for late binding of virtual methods and polymorphism.
From an implementation standpoint, the major difference between static and virtual methods is simple when they are bound: A static method call is just a special procedure call that can be resolved at compile-time for maximum efficiency (early binding).
A virtual method call, on the other hand, requires a table lookup based on the RUN-TIME identity of the object. This table lookup gives an object the ability to respond appropriately to a requested action (late binding).
To illustrate this important idea, consider an example where a linked list of windows can contain either menu windows or text windows. This allows a display routine to traverse the linked list and send a "display message" to each window:
NextWin := Head;
while NextWin <> nil do
begin
NextWin^.Show;
NextWin := NextWin^.Next;
end;To resolve a virtual method call at runtime, TP creates one Virtual Method Table (VMT) in the data segment for each object type. The VMT contains the size of an object type, and a pointer to the code of each of the methods for that object. An instance of an object is linked to the VMT through a constructor call.
Defining a method as virtual is a simple matter of appending the virtual keyword to the method's header. However, there are a few rules to keep in mind.
If you declare a method as virtual in an ancestor type, you must also declare any overriding methods as virtual. In addition, the parameters for overriding methods must be exactly the same, including the number of parameters and the parameter types. This is different than the case for static methods, which can vary, both the number of parameters and the parameter type.
Also, as mentioned earlier, each instance of an object must be linked to its VMT so every newly instantiated object must be initialized by a constructor call. Failure to make the constructor call can result in a system crash. You can detect this error by setting the $R+ compiler directive. This compiler directive provides range checking for all virtual methods called in your program, and issues a run-time error if the object's VMT pointer has not been initialized.
Objects are structured types that generally require some initialization before they are used and some cleanup before they are disposed of. A typical sequence of instructions would be
The standard procedures New and Dispose already perform the first and last operations described above. TP's new constructor and destructor are intended to perform steps 2 and 4 respectively. Because the ordering of these steps is important, New has been extended to take a constructor method call as an optional second parameter. Similarly, Dispose accepts a destructor method call as a second parameter.
Turbo Pascal provides support for debugging objects as well. The integrated debugger, for instance, allows you to either step over or trace through method calls. Because the debugger is actually executing the code in your program, there's no difference between tracing a static or virtual method.
The Integrated Debugger allows you to view objects using the Evaluate Window. You can view just the object's data fields or you can view the address of the method's code. In addition, an object can be added to the Watch window. In both the Watch and the Evaluate windows, all expressions that are valid for records are also valid for objects.
Finally, the Integrated Debugger allows you to enter expressions into the Find Procedure command (available from the Debug menu). A legal expression must evaluate to an address in the code segment.
The stand-alone debugger, Turbo Debugger (TD) 1.5, has everything in the Integrated Debugger plus an object inspector (for both object types and instances) and a hierarchy browser. Again, there's no difference between tracing a static or virtual method because the debugger is actually executing the code in your program. This brings up another important point. Methods can be executed from within the Turbo Debugger environment.
The best way to get a feel for the objects in your program and explore the features of TD 1.5 at the same time is to load your program up into TD and crank up the hierarchy browser. The hierarchy browser brings up a two-paned window that displays an alphabetical list of objects used in the left pane, and the ancestor/descendent relationships between objects in the right pane. The hierarchy browser is shown in Figure 1.
The hierarchy browser allows you to scroll through a graphical representation of the hierarchy and highlight object types. TD also provides an incremental search feature that allows you to quickly locate object types in a complex hierarchy. Once you've highlighted an object type, you can select it by pressing Enter, which brings up the Object Type Inspector.
The Object Type Inspector (see Figure2) is also a two-paned window that displays the data fields of an object type in the upper pane and its associated methods in the lower pane. Highlighting and selecting a data field brings up another Object Type Inspector for browsing complex or nested object structures. Highlighting and selecting a method, on the other hand, brings up a Method Inspector.
This Method Inspector displays the method's code address, the names and types of the method's parameters, and whether it is a procedure or a function. Pressing Enter anywhere in the Method Inspector takes you to the source code for that method.
TD also provides an Object Instance Inspector that allows you to examine the data of object instances. The Object Instance Inspector, which is similar to the record inspector, adds a new feature that displays an instance's methods along with their associated code addresses. Of course, these addresses take polymorphic objects and their VMT into account.
One of the more interesting parts of TP is the overlay manager. Until now, the internals of the overlay manager have largely been undocumented. TP's optimized Least Recently Used (LRU) algorithm provides a major step in optimizing the way overlays are loaded into memory. Before describing this new optimization, however, let's take a look at how TP 5.0's overlay manager works.
When an overlay is called, it is loaded into a section of memory between the stack segment and the heap called the overlay buffer. This buffer can be thought of as a "ring" buffer that has two pointers -- one pointing to the beginning of the buffer (head pointer) and the other pointing to the end (tail pointer). Figure 3 illustrates the behavior of the ring buffer and should be referred to in the following discussion.
Initially, the head and tail pointers point to the same address. When an overlay is loaded into the overlay buffer, the head pointer advances into the free memory area and marks the beginning of the overlay. As more overlays are loaded the free area is eventually taken up. Typically, some free space remains, but not enough to accommodate the size of the overlay.
At this point, when another overlay is called, the head pointer wraps around to the bottom of the overlay buffer keeping the free area between the head and tail pointers. The new overlay is then loaded at the head, which slides everything up in the buffer and bumps the first overlay off the ring. This is referred to as the least recently loaded method.
One possible problem with the least recently loaded method is that the ring buffer doesn't take frequency of use into account. So, it is possible for a less frequently used overlay to replace one that is used more often simply because it was loaded last. TP 5.5 provides an option to optimize the loading of overlays by intelligently selecting which overlay gets bumped off the ring.
TP accomplishes this selection by placing on "probation" overlays nearing the tail. While on probation, the overlay manager monitors and traps any calls made to the overlay. If a call is made, the overlay is placed at the head of the overlay buffer and is given a free ride around the ring.
The overlay manager adds two new routines to get and set the size of the probation area. The size of the probation area will depend largely on your application. Therefore, the OvrLoadCount and OvrTrapCount variables are provided to monitor how often an overlay has been loaded or trapped. By placing these variables in the Watch window of the debugger, for instance, you can monitor the effect of different probation sizes on your program.
The overlay manager provides a couple of other goodies, such as OvrFileMode, to get and set an overlay's file mode. This is particularly useful in a network environment. Another variable, OvrReadBuf, allows you to intercept overlay load operations for error handling, or to check for a removable disk. Finally, TP 5.5 allows you to append overlays to the end of your.EXE files.
TP 5.0 included a built-in linker that removes code and data not actually referenced in the program. In building an .EXE file, the smart linker removed code on a per procedure basis, and removed data on a per declaration basis.
TP 5.5 extends this capability to objects. In particular, the smart linker removes code for static methods on a per method basis, meaning that if your program never calls a particular static method, the code for that method will not be included in the .EXE file. Virtual methods of a given object type, however, are treated as a single group by the linker. If your program ever instantiates an object of a type that contains any virtual methods, all of them will be linked into the .EXE.
The benefits of the smart linker with objects will become particularly apparent as you build your own libraries of standard objects. You'll be able to link these object libraries (as units) with your programs knowing that the smart linker will strip out any unused objects.
One of the difficulties with AI was the tremendous learning curve that programmers had to go through. First you had to learn a language like Lisp or Prolog. Next, you had to become familiar with concepts like expert system design, neural networks, natural language processing, and the like.
TP 5.5, on the other hand, provides an excellent migration path to OOP. Old code runs fine under the new compiler, and the OOP approach works well with structured concepts. You can, therefore, add objects as you need them and alleviate the need to learn everything at once. Ultimately, you'll gain the benefits of objects including flexibility, reusability, and extensibility.
[LISTING ONE]
Copyright © 1989, Dr. Dobb's Journal
program FDemo;
uses Crt, Forms, Sliders;
type
Person = record
Firstname: string[30];
Lastname: string[30];
Address: string[32];
City: string[16];
State: string[2];
Zipcode: Longint;
Counter: array[1..3] of Longint;
Slider: array[1..2] of Integer;
end;
const
Frank: Person = (
Firstname: 'Frank';
Lastname: 'Borland';
Address: '1800 Green Hills Road';
City: 'Scotts Valley';
State: 'CA';
Zipcode: 95066;
Counter: (10, 1000, 65536);
Slider: (85, 25));
var
F: Form;
P: Person;
begin
Color(BackColor);
ClrScr;
Color(ForeColor);
GotoXY(1, 1); ClrEol;
Write(' Turbo Pascal 5.5 Object Oriented Forms Editor');
GotoXY(1, 25); ClrEol;
Write(' F2-Save Esc-Quit');
F.Init(10, 5, 54, 16);
F.Add(New(FStrPtr, Init(3, 2, ' Firstname ', 30)));
F.Add(New(FStrPtr, Init(3, 3, ' Lastname ', 30)));
F.Add(New(FStrPtr, Init(3, 5, ' Address ', 32)));
F.Add(New(FStrPtr, Init(3, 6, ' City ', 16)));
F.Add(New(FStrPtr, Init(25, 6, ' State ', 2)));
F.Add(New(FZipPtr, Init(34, 6, ' Zip ')));
F.Add(New(FIntPtr, Init(3, 8, ' Counter 1 ', 0, 99999999)));
F.Add(New(FIntPtr, Init(22, 8, ' 2 ', 0, 99999999)));
F.Add(New(FIntPtr, Init(33, 8, ' 3 ', 0, 99999999)));
F.Add(New(FSliderPtr, Init(3, 10, ' Slider One ', 0, 100, 5)));
F.Add(New(FSliderPtr, Init(3, 11, ' Slider Two ', 0, 100, 5)));
P := Frank;
F.Put(P);
F.Show;
if F.Edit = CSave then F.Get(P);
F.Done;
NormVideo;
ClrScr;
WriteLn('Resulting Person record:');
WriteLn;
with P do
begin
WriteLn('Firstname: ', Firstname);
WriteLn(' Lastname: ', Lastname);
WriteLn(' Address: ', Address);
WriteLn(' City: ', City);
WriteLn(' State: ', State);
WriteLn(' Zipcode: ', Zipcode);
WriteLn(' Counters: ', Counter[1], ' ', Counter[2], ' ', Counter[3]);
WriteLn(' Sliders: ', Slider[1], ' ', Slider[2]);
end;
end.
[LISTING TWO]
unit Forms;
{$S-}
interface
uses Crt;
const
CSkip = ^@;
CHome = ^A;
CRight = ^D;
CPrev = ^E;
CEnd = ^F;
CDel = ^G;
CBack = ^H;
CSave = ^J;
CUndo = ^R;
CLeft = ^S;
CClear = ^Y;
CNext = ^X;
CQuit = ^[;
type
FStringPtr = ^FString;
FString = string[79];
FieldPtr = ^Field;
Field = object
Next: FieldPtr;
X, Y, Size: Integer;
Title: FStringPtr;
Value: Pointer;
constructor Init(PX, PY, PSize: Integer; PTitle: FString);
destructor Done; virtual;
procedure Beep; virtual;
function Edit: Char; virtual;
function ReadChar: Char; virtual;
procedure Show; virtual;
function Prev: FieldPtr;
end;
FTextPtr = ^FText;
FText = object(Field)
Len: Integer;
constructor Init(PX, PY, PSize: Integer; PTitle: FString;
PLen: Integer);
function Edit: Char; virtual;
procedure GetStr(var S: FString); virtual;
function PutStr(var S: FString): Boolean; virtual;
procedure Show; virtual;
procedure Display(var S: FString);
end;
FStrPtr = ^FStr;
FStr = object(FText)
constructor Init(PX, PY: Integer; PTitle: FString; PLen: Integer);
procedure GetStr(var S: FString); virtual;
function PutStr(var S: FString): Boolean; virtual;
end;
FIntPtr = ^FInt;
FInt = object(FText)
Min, Max: Longint;
constructor Init(PX, PY: Integer; PTitle: FString;
PMin, PMax: Longint);
procedure GetStr(var S: FString); virtual;
function PutStr(var S: FString): Boolean; virtual;
end;
FZipPtr = ^FZip;
FZip = object(FInt)
constructor Init(PX, PY: Integer; PTitle: FString);
procedure GetStr(var S: FString); virtual;
function PutStr(var S: FString): Boolean; virtual;
end;
FormPtr = ^Form;
Form = object
X1, Y1, X2, Y2: Integer;
Last: FieldPtr;
constructor Init(PX1, PY1, PX2, PY2: Integer);
destructor Done; virtual;
function Edit: Char; virtual;
procedure Show; virtual;
procedure Add(P: FieldPtr);
function First: FieldPtr;
procedure Get(var FormBuf);
procedure Put(var FormBuf);
end;
ColorIndex = (BackColor, ForeColor, TitleColor, ValueColor);
procedure Color(C: ColorIndex);
implementation
type
Bytes = array[0..32767] of Byte;
procedure Abstract(Method: String);
begin
WriteLn('Error: Call to abstract method ', Method);
Halt(1);
end;
{ Field }
constructor Field.Init(PX, PY, PSize: Integer; PTitle: FString);
begin
X := PX;
Y := PY;
Size := PSize;
GetMem(Title, Length(PTitle) + 1);
Title^ := PTitle;
GetMem(Value, Size);
FillChar(Value^, Size, 0);
end;
destructor Field.Done;
begin
FreeMem(Value, Size);
FreeMem(Title, Length(Title^) + 1);
end;
procedure Field.Beep;
begin
Sound(500); Delay(25); NoSound;
end;
function Field.Edit: Char;
begin
Abstract('Field.Edit');
end;
function Field.ReadChar: Char;
var
Ch: Char;
begin
Ch := ReadKey;
case Ch of
#0:
case ReadKey of
#15, #72: Ch := CPrev; { Shift-Tab, Up }
#60: Ch := CSave; { F2 }
#71: Ch := CHome; { Home }
#75: Ch := CLeft; { Left }
#77: Ch := CRight; { Right }
#79: Ch := CEnd; { End }
#80: Ch := CNext; { Down }
#83: Ch := CDel; { Del }
else
Ch := CSkip;
end;
#9, #13: Ch := CNext; { Tab, Enter }
end;
ReadChar := Ch;
end;
procedure Field.Show;
begin
Abstract('Field.Show');
end;
function Field.Prev: FieldPtr;
var
P: FieldPtr;
begin
P := @Self;
while P^.Next <> @Self do P := P^.Next;
Prev := P;
end;
{ FText }
constructor FText.Init(PX, PY, PSize: Integer; PTitle: FString;
PLen: Integer);
begin
Field.Init(PX, PY, PSize, PTitle);
Len := PLen;
end;
function FText.Edit: Char;
var
P: Integer;
Ch: Char;
Start, Stop: Boolean;
S: FString;
begin
P := 0;
Start := True;
Stop := False;
GetStr(S);
repeat
Display(S);
GotoXY(X + Length(Title^) + P, Y);
Ch := ReadChar;
case Ch of
#32..#255:
begin
if Start then S := '';
if Length(S) < Len then
begin
Inc(P);
Insert(Ch, S, P);
end;
end;
CLeft: if P > 0 then Dec(P);
CRight: if P < Length(S) then Inc(P) else;
CHome: P := 0;
CEnd: P := Length(S);
CDel: Delete(S, P + 1, 1);
CBack:
if P > 0 then
begin
Delete(S, P, 1);
Dec(P);
end;
CClear:
begin
S := '';
P := 0;
end;
CUndo:
begin
GetStr(S);
P := 0;
end;
CSave, CNext, CPrev:
if PutStr(S) then
begin
Show;
Stop := True;
end else
begin
Beep;
P := 0;
end;
CQuit: Stop := True;
else
Beep;
end;
Start := False;
until Stop;
Edit := Ch;
end;
procedure FText.GetStr(var S: FString);
begin
Abstract('FText.GetStr');
end;
function FText.PutStr(var S: FString): Boolean;
begin
Abstract('FText.PutStr');
end;
procedure FText.Show;
var
S: FString;
begin
GetStr(S);
Display(S);
end;
procedure FText.Display(var S: FString);
begin
GotoXY(X, Y);
Color(TitleColor);
Write(Title^);
Color(ValueColor);
Write(S, '': Len - Length(S));
end;
{ FStr }
constructor FStr.Init(PX, PY: Integer; PTitle: FString; PLen: Integer);
begin
FText.Init(PX, PY, PLen + 1, PTitle, PLen);
end;
procedure FStr.GetStr(var S: FString);
begin
S := FString(Value^);
end;
function FStr.PutStr(var S: FString): Boolean;
begin
FString(Value^) := S;
PutStr := True;
end;
{ FInt }
constructor FInt.Init(PX, PY: Integer; PTitle: FString;
PMin, PMax: Longint);
var
L: Integer;
S: string[15];
begin
Str(PMin, S); L := Length(S);
Str(PMax, S); if L < Length(S) then L := Length(S);
FText.Init(PX, PY, 4, PTitle, L);
Min := PMin;
Max := PMax;
end;
procedure FInt.GetStr(var S: FString);
begin
Str(Longint(Value^), S);
end;
function FInt.PutStr(var S: FString): Boolean;
var
N: Longint;
E: Integer;
begin
Val(S, N, E);
if (E = 0) and (N >= Min) and (N <= Max) then
begin
Longint(Value^) := N;
PutStr := True;
end else PutStr := False;
end;
{ FZip }
constructor FZip.Init(PX, PY: Integer; PTitle: FString);
begin
FInt.Init(PX, PY, PTitle, 0, 99999);
end;
procedure FZip.GetStr(var S: FString);
begin
FInt.GetStr(S);
Insert(Copy('0000', 1, 5 - Length(S)), S, 1);
end;
function FZip.PutStr(var S: FString): Boolean;
begin
PutStr := (Length(S) = 5) and FInt.PutStr(S);
end;
{ Form }
constructor Form.Init(PX1, PY1, PX2, PY2: Integer);
begin
X1 := PX1;
Y1 := PY1;
X2 := PX2;
Y2 := PY2;
Last := nil;
end;
destructor Form.Done;
var
P: FieldPtr;
begin
while Last <> nil do
begin
P := Last^.Next;
if Last = P then Last := nil else Last^.Next := P^.Next;
Dispose(P, Done);
end;
end;
function Form.Edit: Char;
var
P: FieldPtr;
Ch: Char;
begin
Window(X1, Y1, X2, Y2);
P := First;
repeat
Ch := P^.Edit;
case Ch of
CNext: P := P^.Next;
CPrev: P := P^.Prev;
end;
until (Ch = CSave) or (Ch = CQuit);
Edit := Ch;
Window(1, 1, 80, 25);
end;
procedure Form.Show;
var
P: FieldPtr;
begin
Window(X1, Y1, X2, Y2);
Color(ForeColor);
ClrScr;
P := First;
repeat
P^.Show;
P := P^.Next;
until P = First;
Window(1, 1, 80, 25);
end;
procedure Form.Add(P: FieldPtr);
begin
if Last = nil then Last := P else P^.Next := Last^.Next;
Last^.Next := P;
Last := P;
end;
function Form.First: FieldPtr;
begin
First := Last^.Next;
end;
procedure Form.Get(var FormBuf);
var
I: Integer;
P: FieldPtr;
begin
I := 0;
P := First;
repeat
Move(P^.Value^, Bytes(FormBuf)[I], P^.Size);
Inc(I, P^.Size);
P := P^.Next;
until P = First;
end;
procedure Form.Put(var FormBuf);
var
I: Integer;
P: FieldPtr;
begin
I := 0;
P := First;
repeat
Move(Bytes(FormBuf)[I], P^.Value^, P^.Size);
Inc(I, P^.Size);
P := P^.Next;
until P = First;
end;
procedure Color(C: ColorIndex);
type
Palette = array[ColorIndex] of Byte;
const
CP: Palette = ($17, $70, $30, $5E);
MP: Palette = ($07, $70, $70, $07);
begin
if LastMode = CO80 then TextAttr := CP[C] else TextAttr := MP[C];
end;
end.
[LISTING THREE]
unit Sliders;
{$S-}
interface
uses Crt, Forms;
type
FSliderPtr = ^FSlider;
FSlider = object(Field)
Min, Max, Delta: Integer;
constructor Init(PX, PY: Integer; PTitle: FString;
PMin, PMax, PDelta: Integer);
function Edit: Char; virtual;
procedure Show; virtual;
procedure Display(I: Integer);
end;
implementation
constructor FSlider.Init(PX, PY: Integer; PTitle: FString;
PMin, PMax, PDelta: Integer);
begin
Field.Init(PX, PY, 2, PTitle);
Min := PMin;
Max := PMax;
Delta := PDelta;
end;
function FSlider.Edit: Char;
var
I: Integer;
Ch: Char;
Stop: Boolean;
begin
I := Integer(Value^);
Stop := False;
repeat
Display(I);
GotoXY(X + Length(Title^) + 1, Y);
Ch := ReadChar;
case Ch of
CLeft: if I > Min then Dec(I, Delta);
CRight: if I < Max then Inc(I, Delta);
CHome: I := Min;
CEnd: I := Max;
CUndo: I := Integer(Value^);
CSave, CQuit, CNext, CPrev: Stop := True;
else
Beep;
end;
until Stop;
if Ch <> CQuit then Integer(Value^) := I;
Edit := Ch;
end;
procedure FSlider.Show;
begin
Display(Integer(Value^));
end;
procedure FSlider.Display(I: Integer);
var
Steps: Integer;
S: FString;
begin
Steps := (Max - Min) div Delta + 1;
S[0] := Chr(Steps);
FillChar(S[1], Steps, #176);
S[(I - Min) div Delta + 1] := #219;
GotoXY(X, Y);
Color(TitleColor);
Write(Title^);
Color(ValueColor);
Write(' ', Min, ' ', S, ' ', Max, ' ');
end;
end.